Question

我感兴趣的是允许App用户按照他/她的需要向下钻取数据。我使用下面的mtcars数据集制作了一个玩具示例。

runApp(
  list(
    ui = fluidPage(
      sidebarLayout(
        sidebarPanel(
          selectInput("cyl", "Select cylinders:", unique(mtcars$cyl), multiple = T, selected = unique(mtcars$cyl)),
          selectInput("gear", "Select gears:", unique(mtcars$gear), multiple = T, selected = unique(mtcars$gear)),
          selectInput("am", "Select am:", unique(mtcars$am), multiple = T, selected = unique(mtcars$am)),
          numericInput("wt", "Select wt greater than:", value=1)
          , width = 2),

        mainPanel(

          tabsetPanel(
            tabPanel(title = "Results", dataTableOutput("tAble"))
          )
        )
      )
    )

    , server = function(input, output, session){

      output$tAble <- renderDataTable({subset(mtcars, cyl %in% input$cyl & 
                                                gear%in%input$gear &
                                                am%in%input$am &
                                                wt > input$wt)})


    }
  )
)

此应用程序将显示符合所有条件的数据框部分。

我的问题是我必须事先写出所有潜在的子集标准。如果我的数据有200个可能的子集变量怎么办？我希望能够做的是根据需要添加子集框，而不预先创建selectInputs / etc。

例如，当应用启动时，显示所有数据。然后可以选择通过单击按钮添加子集选项？！

任何帮助表示赞赏！

干杯， LUC

Answer 1

要渲染UI元素，您需要在服务器中创建tagList()个UI元素，然后在UI中渲染它们。

然后，您需要能够根据动态创建的UI元素对数据进行子集化。在这里，我正在根据UI元素的名称评估文本字符串，以进行子集化

library(shiny)

runApp(
    list(
        ui = fluidPage(
            sidebarLayout(
                sidebarPanel(
                    uiOutput("myChoices"),
                    numericInput("wt", "Select wt greater than:", value=1)
                    , width = 2),

                mainPanel(

                    tabsetPanel(
                        tabPanel(title = "Results", dataTableOutput("tAble"))
                    )
                )
            )
        )

        , server = function(input, output, session){

            myCols <- names(mtcars)[1:3]

            mySelectInputs <- tagList()

            for(i in myCols){
                mySelectInputs[[i]] <- selectInput(i, label = i, choices = unique(mtcars[, i]),
                                                                                     selected = unique(mtcars[, i]), multiple = T)
            }

            output$myChoices <- renderUI({
                mySelectInputs
            })

            output$tAble <- renderDataTable({

                lst <- sapply(myCols, function(x){
                    vals <- input[[x]]
                    substitute(x %in% i, list(i = vals, x = x))
                })

                txt <- gsub("\"", "", paste0(lst, collapse = " & "))
                print(txt)

                subset(mtcars, eval(expr = parse(text = txt) ) )

            })
        }
    )
)

根据RShiny

1 个答案: