R Shiny - 通过单选按钮和复选框保存组合输入

时间:2017-06-30 19:02:15

标签: r shiny

我是闪亮(但不是R)的新手,我正在努力构建一个应用程序,用户从表中选择特定的行以导出到csv文件中。该表格简化为基本要素,有两列因子和一列回复。

例如,

enter image description here

最初,我根据dataFactor2列中的值将应用程序设置为用户在侧栏上的复选框,他们可以使用这些值来选择要导出的行。 (例如,他们可以选择导出dataFactor2 == A,G和J的表行。)然而,对于大量的dataFactor1和dataFactor2级别来说,它变得难以处理。

我的想法是为dataFactor1的级别添加单选按钮。然后,如果您选择了dataFactor1 == X的单选按钮,您将获得A,B和C的复选框,该表将仅显示dataFactor1 == X的行。您将选择行A,B或C,然后你转到Y和Z.在过程结束时,你仍然会导出对应于所选dataFactor2级别的行。

然而,当我尝试以这种方式实现时,当我从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")


  )

)

))

和server.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)

        })

  })

})

2 个答案:

答案 0 :(得分:2)

  

有关如何捕获所有复选框的任何建议吗?

关于答案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非常有趣且有帮助。

答案 1 :(得分: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)