使用用户定义的子集

时间:2016-12-27 02:19:57

标签: r subset shiny

我有以下数据集:

df <- data.frame(x = gl(n = 2, k = 10, labels = c(0, 1)), 
                 y = gl(n = 4, k = 5, labels = c('hi', 'bye', 'wee', 'whoa')))

我创建了一个闪亮的应用程序,允许用户选择数据框的任何变量。选择变量后,会出现单选按钮。我希望用户能够使用单选按钮选择值,然后将其用于数据框的子集,并最终将结果打印在数据表中。我到目前为止的代码如下:

server.R

library(tidyr) 
library(dplyr)

df <- data.frame(x = gl(n = 2, k = 10, labels = c(0, 1)), 
                 y = gl(n = 4, k = 5, labels = c('hi', 'bye', 'wee', 'whoa')))

function(input, output) {

  # Select specification of features for subsetting
  output$ui <- renderUI({

    # Get length of features selected 
    numVar <- length(as.integer(input$in0))

    # Create n radioButtons based on number of features selected
    lapply(input$in0, function(x) {
           list(radioButtons(paste0("dynamic", x), x, 
                             choices = c("zero" = "0",
                                         "one" = "1"),
                             selected = "0"))
  })
})

output$mytable = renderDataTable({
      df
    })

}

ui.R

library(tidyr) 
library(dplyr)

df <- data.frame(x = gl(n = 2, k = 10, labels = c(0, 1)), 
                 y = gl(n = 4, k = 5, labels = c('hi', 'bye', 'wee', 'whoa')))

fluidPage(
  br(),
  fluidRow(
    column(3,
      h2('Test subset'),

      # Drop down of all features
      selectInput(inputId = 'in0', label = 'Choose features', 
                  choices = colnames(df), 
                  multiple = TRUE, selectize = TRUE), 

      # Radio buttons for features
      wellPanel(uiOutput("ui"))
    ), 
    column(9,
           dataTableOutput('mytable')
    )
  )
)

具体来说,我不知道如何从单选按钮访问用户选择,以便在df文件中对数据表server.R进行子集化。在这种情况下,只需要子集使用x变量。也就是说,一个由0&1和1组成,但它应该能够处理许多变量。因此,子集代码必须考虑用户选择了多少变量。

1 个答案:

答案 0 :(得分:1)

这样的东西?

server.R

function(input, output) {
  # Select specification of features for subsetting
  output$ui <- renderUI({
    lapply(input$in0, function(var) {
      list(radioButtons(paste0("dynamic_", var), label = var, 
                        choices = levels(df[[var]])))
    })
  })

  output$mytable = renderDataTable({
    if(is.null(input$in0)) return(df)
    sub <- function(data, var) {
      idx <- data[[var]] == input[[paste0("dynamic_", var)]]
      data[idx, ]
    }
    Reduce(f = sub, init = df, x = input$in0)
  })
}