R Shiny - 保存来自单选按钮和复选框的组合输入

Question

我是 Shiny（但不是 R）的新手，我正在努力构建一个应用程序，用户可以在其中选择表中的特定行以导出到 csv 文件中。简化为基本要素，该表有两列因素和一列响应。

例如，

最初，我根据 dataFactor2 列中的值将应用程序设置为用户在侧边栏上有复选框的位置，他们可以使用这些值来选择要导出的行。 （例如，他们可以选择导出 dataFactor2 == A、G 和 J 的表行。）但是，对于大量的 dataFactor1 和 dataFactor2 级别，这变得很笨拙。

我的想法是为 dataFactor1 的级别添加单选按钮。然后，如果您选择 dataFactor1 == X 的单选按钮，您将获得 A、B 和 C 的复选框，并且该表将仅显示 dataFactor1 == X 的行。您将选择行 A、B 或C，然后您将转到 Y 和 Z。在该过程结束时，您仍将导出与所选数据因子 2 级别相对应的行。

但是，当我尝试以这种方式实现时，当我从一个级别的 dataFactor1 移动到下一个级别时，一切都会重置。有关如何捕获所有复选框的任何建议？

下面的 ui.R 示例代码：

#ui.R

library(shiny)

myFactor1<-c("X", "Y", "Z")
myFactor2<-c() #initialize

shinyUI(fluidPage(

  titlePanel("Sample"),

  # Sidebar with radio buttons and checkboxes
  sidebarLayout(
    sidebarPanel(width=2,

      #display radio button list of factor1 values
      radioButtons("factor1", 
                   label = "dataFactor1",
                   choices=myFactor1), #dynamically generate factor list

      #display checkboxes of factor2 values
      checkboxGroupInput("factor2",
                         label="dataFactor2",
                         choices=myFactor2) #dynamically generate list

    ),

    # Show factor2 selections and table
    mainPanel(

      textOutput("text2"),
      tableOutput("table2")


  )

)

))

和服务器.R：

#server.R
library(shiny)

shinyServer(function(input, output, session) {

  mydata<-data.frame(dataFactor1=c(rep("X", 3), rep("Y", 4), rep("Z", 5)),
                     dataFactor2=c("A", "B", "C", "D", "E", "F", "G", "H", 
                                   "I", "J", "K", "L"),
                     dataResponse=rnorm(12))

  observe({
        factor1Choice<-input$factor1

        myFactor2_list<-mydata$dataFactor2[mydata$dataFactor1==factor1Choice]

        updateCheckboxGroupInput(session, "factor2",
                                 choices = myFactor2_list)

        mydata2<-mydata[mydata$dataFactor1==factor1Choice,]

        output$table2<-renderTable(mydata2)

        observe({
          factor2Choice<-input$factor2
          output$text2<-renderText(factor2Choice)

        })

  })

})

Answer 1

关于如何捕获所有选中的框有什么建议吗？

关于here 的两个答案，您可以这样做（快速而肮脏）：

myFactor1<-c("X", "Y", "Z")
myFactor2<-c() #initialize

ui <- fluidPage(

  titlePanel("Sample"),

  # Sidebar with radio buttons and checkboxes
  sidebarLayout(
    sidebarPanel(width=2,

      #display radio button list of factor1 values
      radioButtons("factor1", 
                   label = "dataFactor1",
                   choices=myFactor1), #dynamically generate factor list

      #display checkboxes of factor2 values
      checkboxGroupInput("factor2",
                         label="dataFactor2",
                         choices=myFactor2) #dynamically generate list

    ),

    # Show factor2 selections and table
    mainPanel(

      textOutput("text2"),
      tableOutput("table2")


  )

)

)


server <- function(input, output, session) {

  mydata<-data.frame(dataFactor1=c(rep("X", 3), rep("Y", 4), rep("Z", 5)),
                     dataFactor2=c("A", "B", "C", "D", "E", "F", "G", "H", 
                                   "I", "J", "K", "L"),
                     dataResponse=rnorm(12))

  values <- reactiveValues(cb = with(mydata, setNames(rep(FALSE, nlevels(dataFactor2)), levels(dataFactor2))))  

  observeEvent(input$factor2, {
    myFactor2_list<-mydata$dataFactor2[mydata$dataFactor1==input$factor1]
    values$cb[myFactor2_list] <- myFactor2_list %in% input$factor2
  })

  observe({
        factor1Choice<-input$factor1

        myFactor2_list<-mydata$dataFactor2[mydata$dataFactor1==factor1Choice]

        updateCheckboxGroupInput(session, "factor2",
                                 choices = myFactor2_list,
                                 selected = levels(mydata$dataFactor2)[values$cb])

        mydata2<-mydata[mydata$dataFactor1==factor1Choice,]

        output$table2<-renderTable(mydata2)

        observe({
          factor2Choice<-input$factor2
          output$text2<-renderText(factor2Choice)

        })

  })

}
shinyApp(ui, server)

一般设置是另一个问题 - 我发现 these shiny sessions 非常有趣和有用。

Answer 2

这是一个可能的解决方案，使用列表来存储选择。使用unlist恢复所有选中的复选框。

library(shiny)

myFactor1<-c("X", "Y", "Z")

ui <- shinyUI(fluidPage(
  titlePanel("Sample"),
  # Sidebar with radio buttons and checkboxes
  sidebarLayout(
    sidebarPanel(width=2,
      #display radio button list of factor1 values
      radioButtons("factor1", 
                   label = "dataFactor1",
                   choices=myFactor1), #dynamically generate factor list
      #display checkboxes of factor2 values
      checkboxGroupInput("factor2", label="dataFactor2")
    ),
    # Show factor2 selections and table
    mainPanel(
      textOutput("text2"),
      tableOutput("table2"),
      p("All selections:"),
      textOutput("text3")
    )
  )
))

server <- shinyServer(function(input, output, session) {

  mydata<-data.frame(dataFactor1=c(rep("X", 3), rep("Y", 4), rep("Z", 5)),
                     dataFactor2=c("A", "B", "C", "D", "E", "F", "G", "H", 
                                   "I", "J", "K", "L"),
                     dataResponse=rnorm(12))

  # to store selections
  mySelection <- list()

  observeEvent(input$factor1, {
    factor1Choice<-input$factor1
    myFactor2_list<-mydata$dataFactor2[mydata$dataFactor1==factor1Choice]

    updateCheckboxGroupInput(session, "factor2",
                             choices = myFactor2_list, 
                             # update with stored selections
                             selected = mySelection[[input$factor1]])

    mydata2<-mydata[mydata$dataFactor1==factor1Choice,]

    output$table2<-renderTable(mydata2)

  })

  observeEvent(input$factor2, {
    # backup the selection
    mySelection[[input$factor1]] <<- input$factor2
    output$text2 <- renderText(mySelection[[input$factor1]])    
    # get all selections
    output$text3 <- renderText(unlist(mySelection))    
  })

})

shinyApp(ui, server)