Output from 1 pickerInput in Shiny automatically updates when I do changes in the dataframe

Question

Recently I asked that I had a problem with pickerInput. The question was solved, but I was wondering how to do it just having the data in one reactive function without creating another one + two columns which are not numerical.

In this post, I used mtcars inside a reactive function (simulating what I usually do when I upload a file) and then, in another reactive function, I was doing the changes in the dataframe (log and sqrt). However, I wanted to add two non-numerical columns and this must be done after the transformation.

dat <- mtcars
dat$Brands <- rownames(dat)
str(dat$Brands)

> chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive"
> "Hornet Sportabout" "Valiant" "Duster 360" "Merc 240D" ...

dat$Info <- rep("Info", length(rownames(mtcars)))
str(dat$Info)

>  chr [1:32] "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info"
> "Info" "Info" "Info" "Info" "Info" "Info" "Info" "Info" ...

In that post, if I add the two non numerical columns in data1() and I leave pickerInput with data() as they answered me, the non numerical columns will not appear to select. For that reason, I put all the information in one single reactive function... However, now the solution doesn't work.

Everytime that I click in one checkboxInput the selected columns change automatically.

This is the code:

library(shiny)
library(shinyWidgets)
library(dplyr)

ui <- fluidPage(
  
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      
      uiOutput("picker"),
      
      checkboxInput("play", strong("I want to play with my data"), value = FALSE),
      
      conditionalPanel(
        condition = "input.play == 1",
        checkboxInput("change_log2", "Log2 transformation", value = FALSE),
        checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
      
      
      actionButton("view", "View Selection")
      
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      h2('Mydata'),
      DT::dataTableOutput("table"),
    )
  )
)

library(shiny)
library(DT)

server <- function(session, input, output) {
  
  data <- reactive({
    dat <- mtcars
    if(input$change_log2){
      dat <- log2(dat)
    }
    
    if(input$run_sqrt){
      dat <- sqrt(dat)
    }
    
    dat$Brands <- rownames(dat)
    dat$Info <- rep("Info", length(rownames(mtcars)))
    
    return(dat)
  })
  
  
  observeEvent(input$play, {
    
    if(!input$play) {
      updateCheckboxInput(session, "change_log2", value = FALSE)
      updateCheckboxInput(session, "run_sqrt", value = FALSE)
    }
    
  })
  
  
  output$picker <- renderUI({
    pickerInput(inputId = 'pick', 
                label = 'Choose', 
                choices = colnames(data()),
                options = list(`actions-box` = TRUE),
                multiple = T,
                selected = colnames(data())
    )
  })
  
  datasetInput <- eventReactive(input$view,{
    
    datasetInput <- data() %>% 
      select(input$pick)
    
    return(datasetInput)
    
  })
  
  output$table <- renderDT({
    
    datatable(
      datasetInput(),
      filter="top", 
      rownames = FALSE,
      extensions = 'Buttons',
      
      options = list(
        dom = 'Blfrtip',
        buttons =
          list('copy', 'print', list(
            extend = 'collection',
            buttons = list(
              list(extend = 'csv', filename = "File", title = NULL),
              list(extend = 'excel', filename = "File", title = NULL)),
            text = 'Download'
          ))
      ),
      class = "display"
    )
  })
}


# Run the application 
shinyApp(ui = ui, server = server)

I suppose it has to be something related to updatepickerInput (I saw similar problems like this but I don't know how to do it in a unique pickerInput.

Does anyone know how to solve it?

Thanks in advance

Regards

Answer 1

You may use reactiveValues to save the dataset and apply the function to only numeric columns of the selected columns from pickerInput.

library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)

dat <- mtcars
dat$Brands <- rownames(dat)
dat$Info <- rep("Info", length(rownames(mtcars)))


ui <- fluidPage(
  
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      
      uiOutput("picker"),
      
      checkboxInput("play", strong("I want to play with my data"), value = FALSE),
      
      conditionalPanel(
        condition = "input.play == 1",
        checkboxInput("change_log2", "Log2 transformation", value = FALSE),
        checkboxInput("run_sqrt", "sqrt option", value = FALSE)),
      
      
      actionButton("view", "View Selection")
      
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      h2('Mydata'),
      DT::dataTableOutput("table"),
    )
  )
)


server <- function(session, input, output) {
  
  rv <- reactiveValues(data = dat)
  
  observeEvent(input$play, {
    
    if(!input$play) {
      updateCheckboxInput(session, "change_log2", value = FALSE)
      updateCheckboxInput(session, "run_sqrt", value = FALSE)
    }
    
  })
  
  
  output$picker <- renderUI({
    cols <- names(rv$data)
    
    pickerInput(inputId = 'pick', 
                label = 'Choose', 
                choices = cols,
                options = list(`actions-box` = TRUE),
                multiple = T,
                selected = cols)
  })
  
  datasetInput <- eventReactive(input$view,{
    
    datasetInput <- rv$data %>% select(input$pick)
    if(input$change_log2){
      datasetInput <- datasetInput %>% mutate(across(where(is.numeric), log2))
    }
    
    if(input$run_sqrt){
      datasetInput <- datasetInput %>% mutate(across(where(is.numeric), sqrt))
    }

    return(datasetInput)
    
  })
  
  output$table <- renderDT({
    
    datatable(
      datasetInput(),
      filter="top", 
      rownames = FALSE,
      extensions = 'Buttons',
      
      options = list(
        dom = 'Blfrtip',
        buttons =
          list('copy', 'print', list(
            extend = 'collection',
            buttons = list(
              list(extend = 'csv', filename = "File", title = NULL),
              list(extend = 'excel', filename = "File", title = NULL)),
            text = 'Download'
          ))
      ),
      class = "display"
    )
  })
}


# Run the application 
shinyApp(ui = ui, server = server)