R 闪亮的动态过滤器变量选择和显示变量值以供选择

我仍然在学习Shiny和R，感觉这是一个我仍然需要学习很多东西的海洋。如果我的编码方法不理想，请原谅，并建议在哪里可以临时编写代码

我正在创建此应用程序，需要在其中生成交叉选项卡和图表。我需要过滤用户选择的数据基础变量，并基于此更新表格和图表

例如，如果用户选择“Store_location”作为过滤器变量，我想在其下方显示该变量的值列表，并选中复选框，因此

loc1 loc2 loc3 loc4

应显示复选框，用户可以选择这些值中的单个/多个。在此基础上，我的数据应该得到过滤。因此，如果用户选择loc1和loc2，则应根据条件对数据进行过滤（Store_location==“loc1”| Store_location==“loc2”）

一旦用户取消选中复选框或为过滤器选择不同的变量，相应地，数据应该得到更新，交叉表和图表也应该得到更新。我相信这应该可以在Shiny中完成，我试图使用checkboxGroupInput，但无法传递所选变量，因此出现错误。目前已经对此进行了注释，以便代码运行。我已经创建了一个CSV格式的示例数据，并已在应用程序中读取。数据量很大，因此使用Data.table fread读取数据。所以任何子设置都需要在data.table中完成。单击“准备分析数据”按钮时，我会重新格式化/创建变量。为此，我使用了observeEvent（{}），我所有的renderTable/renderplot都在这个事件中。我觉得有更好的方法来处理这个问题。如果是，我建议你

最后，我的下载程序给了我一个错误，“gList”中只允许“grobs”，有时还会出现类似“replacement有17行，data有0”这样的错误。我想生成一个带有交叉表的pdf文件，并在另一个下绘制一个。一定要告诉我哪里出了问题

样本数据可在此处找到-

下面是我的应用程序的代码片段-

library("shiny")
library("shinythemes")
library("tools")
library("readxl")
library("data.table")
library("bit64")
library("gmodels")
library("ggplot2")
library("plotly")
library("gridExtra")

### User Interface
ui <- shinyUI(
  navbarPage('My Shiny App',
             tabPanel("Insights",
                      sidebarPanel(
                        fileInput('file1', 'Choose input data',
                                  accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
                        tags$hr(),
                        actionButton(inputId = 'run1', label = "Prepare data for Analysis"),
                        tags$br(),
                        tags$br(),
                        fluidRow(
                          column(10,
                                 div(style = "font-size: 13px;", selectInput("filtervar", label = "Select Filter Variable", ''))
                          ),
                          tags$br(),
                          tags$br(),
                          wellPanel(
                          #  checkboxGroupInput("filteroptions", "Filter Options", choices = sort(unique(fil)))
                          ),
                          column(10,
                                 div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", ''))
                          ),
                          tags$br(),
                          tags$br(),
                          column(10,
                                 div(style = "font-size: 13px;", selectInput("columnvar", "Select Column Variable", ''))
                          )),
                        downloadButton('export',"Download Outputs")
                      )
                      ,
                      mainPanel(
                        tabsetPanel(id='mytabs',
                                    tabPanel("Data", tags$b(tags$br("Below is the top 6 rows of the data prepared" )),tags$br(),tableOutput("table.output")), 
                                    tabPanel("Table",tags$b(tags$br("Table Summary" )),tags$br(),tableOutput("crosstab1"),tags$br(),verbatimTextOutput("datatab1")), 
                                    tabPanel("Chart",tags$b(tags$br("Graphical Output" )),tags$br(),plotlyOutput("plot1"))
                        )
                    )),
             tabPanel("Help")
  ))

server <- shinyServer(function(input, output,session){
  #Below code is to increase the file upload size
  options(shiny.maxRequestSize=1000*1024^2)
  observeEvent(input$run1,{
    updateTabsetPanel(session = session 
                      ,inputId = 'myTabs')
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    data_input <- fread(inFile$datapath)

    data_input[,`:=` (YN2014 = ifelse(Year == "Y2014",1,0),YN2015 = ifelse(Year == "Y2015",1,0))]

    ## vals will contain all plot and table grobs
    vals <- reactiveValues(t1=NULL,t2=NULL,t3=NULL,p1=NULL,p2=NULL)

    output$table.output <- renderTable({
      #      top6rows
      head(data_input)
    })

    s <- reactive(
      data_input
    )

    observe({
      updateSelectInput(session, "rowvar", choices = (as.character(colnames(data_input))),selected = "Store_location")
    })

    observe({
      updateSelectInput(session, "columnvar", choices = (as.character(colnames(data_input))),selected = "Year")
    })

    observe({
      updateSelectInput(session, "filtervar", choices = (as.character(colnames(data_input))),selected = "Store_location")
    })

    output$conditionalInput <- renderUI({
      if(input$checkbox){
        selectInput("typeInput", "Product type",
                    choices = sort(unique(input$filtervar)))
      }
    })

    output$crosstab1 <- renderTable({
      validate(need(input$rowvar,''),
               need(input$columnvar,''))
      vals$t1 <- addmargins(xtabs(as.formula(paste0("~",input$rowvar,"+",input$columnvar)), s()))
    },caption = "<b>Cross-Tab - 1</b>",
    caption.placement = getOption("xtable.caption.placement", "top"), 
    caption.width = getOption("xtable.caption.width", 200))

    output$datatab1 <- renderPrint({
      validate(need(input$rowvar,''),
               need(input$columnvar,''))
      vals$t2 <- as.data.frame(with(s(), CrossTable(get(input$rowvar),get(input$columnvar),max.width = 1,prop.c = T,prop.r = F,prop.t = F,prop.chisq = F,chisq = F,format = "SPSS",dnn = c(input$rowvar,input$columnvar))))

    })

    #plotting theme
    .theme<- theme(
      axis.line = element_line(colour = 'gray', size = .75), 
      panel.background = element_blank(),  
      plot.background = element_blank()
    )    

    output$plot1 <- renderPlotly({
      vals$p1 <- ggplot(data_input, aes(get(input$rowvar), ..count..)) +
        geom_bar(aes(fill = get(input$columnvar)), position = "dodge") +
        theme(axis.text.x=element_text(angle=90, hjust=1),
              axis.line = element_line(colour = 'gray', size = .75), 
              panel.background = element_blank(),  
              plot.background = element_blank()) +
        xlab(input$rowvar) +
        ylab("Frequency") +
        labs(fill=input$columnvar)
    })

    ## clicking on the export button will generate a pdf file 
    ## containing all grobs
    output$export = downloadHandler(
      filename = function() {paste0("RES_Insights_Outputs_",Sys.Date(),".pdf")},
      content = function(file) {
        pdf(file, onefile = TRUE)
        grid.arrange(vals$t1,vals$p1)
        dev.off()
      }
    )

  })

})

shinyApp(ui = ui, server = server)

库（“闪亮”）
图书馆（“shinythemes”）
图书馆（“工具”）
图书馆（“readxl”）
库（“数据表”）
库（“位64”）
库（“gmodels”）
图书馆（“ggplot2”）
图书馆（“阴谋地”）
图书馆（“gridExtra”）
###用户界面
ui这是一种根据所需列的选定值对数据框进行子集的方法

不过，我不太明白您想对行和列select输入做什么

ui <- navbarPage("My Shiny App",
                 tabPanel("Insights",
                          sidebarPanel(
                            fileInput("file1", "Choose input data"),
                            selectInput("filtervar", "Select Filter Variable", NULL),
                            checkboxGroupInput("filteroptions", "Filter Options", NULL)
                            ),
                          mainPanel(
                            tabsetPanel(id = "mytabs",
                                        tabPanel("Data", tableOutput("table.output"))
                            )
                          )
                 )
)

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

  values <- reactiveValues()

  observe({
    file <- input$file1

    if (is.null(file))
      return()

    values$data <- fread(file$datapath)

    vars <- names(values$data)

    updateSelectInput(session, "filtervar", choices = vars)
  })

  observe({

    data <- isolate(values$data)

    filter.var <- input$filtervar

    if (is.null(filter.var) || filter.var == "")
      return()

    values <- data[[filter.var]]

    if (is.factor(values)) {
      options <- levels(values)
    } else {
      options <- unique(values[order(values)])
    }

    updateCheckboxGroupInput(session, "filteroptions", 
                             choices = options, 
                             selected = as.character(options))

  })

  output$table.output <- renderTable({

    isolate({
      data <- values$data
      var <- input$filtervar
    })

    values <- input$filteroptions

    if(is.null(data)) {
      return()
    } else if (is.null(var) || var == "") {
      return(data)
    } else if (is.null(values)) {
      return(data[FALSE])
    } else {

      if (is.numeric(data[[var]]))
        values <- as.numeric(values)

      setkeyv(data, var)
      return(data[.(values)])
    }

  })


}

shinyApp(ui = ui, server = server)

ui感谢您的回答。这有助于获取所选变量的项目&可以使用复选框选择选项，但是原始数据不会被过滤。让我解释一下行和列变量的选择输入。通过在这些变量中选择变量，我可以动态更新我的表和交叉表。使用当前数据。如果您在这些selectinput中运行我的代码并更改变量，您将了解我的意思。因此，现在根据筛选选项中的选择，我希望数据得到筛选，以便表和图表都得到更新的基础筛选数据。希望这是可行的！！