当我对数据框进行更改时，Shiny 中 1 个选择器输入的输出会自动更新

Posted 2023-03-24

【中文标题】当我对数据框进行更改时，Shiny 中 1 个选择器输入的输出会自动更新

【英文标题】：Output from 1 pickerInput in Shiny automatically updates when I do changes in the dataframe

【发布时间】：2021-10-14 16:29:18

【问题描述】：

最近我问我pickerInput 有问题。问题是solved，但我想知道如何在一个反应​​函数中只包含数据而不创建另一个 + 两个非数字列。

在这个post 中，我在反应函数中使用了 mtcars（模拟我在上传文件时通常会做的事情），然后在另一个反应函数中，我正在对数据帧（日志和 sqrt）进行更改。 但是，我想添加两个非数字列，这必须在转换后完成。

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" ...

在那篇文章中，如果我在 data1() 中添加两个非数字列，并在他们回答我时将 pickerInput 与 data() 一起留下，则非数字列将不会出现选择。 出于这个原因，我将所有信息放在一个反应​​函数中......但是，现在解决方案不起作用。

每次我点击一个checkboxInput 时，选定的列都会自动更改。

这是代码：

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)

我想它必须与updatepickerInput 相关（我看到类似的问题，如this，但我不知道如何在独特的pickerInput 中做到这一点。

有人知道怎么解决吗？

提前致谢

问候

【参考方案1】：

您可以使用reactiveValues 保存数据集，并将函数仅应用于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)

【讨论】：

非常感谢您的回答...但是...是否可以在PickerInput 选项中选择非数字列？因为我希望用户可以选择查看品牌和信息列，如果用户不选择该选项，她/他将看不到这些列...例如，为了根据用户的决定获取带有或不带有这些列的 csv 文件。

非常感谢您的帮助。但是，您知道是否有可能做同样的事情，但在添加非数字列之前进行转换？因为我不能对所有内容都使用此步骤 `datasetInput %>% mutate(across(where(is.numeric), sqrt))`，因为我有一些函数不适用于 mutate 或 sapply。我不能举出函数的例子，因为它们是敏感信息。我认为解决方案与更新input$pick 或updatePickerInput...有关，但我想不出其他办法。