閃亮的動態過濾器變量選擇和顯示變量值的選擇

Question

我仍然在學習Shiny和R，感覺這是一個海，我仍然需要學習很多東西。請原諒，如果我的編碼方法不理想，並建議代碼可以即興創建。

我正在創建這個應用程序，我需要生成交叉選項卡和圖表。我需要過濾用戶選擇的數據基礎變量，並基於表格和圖表需要更新。

因此，例如，如果用戶選擇「Store_location」作爲過濾變量，我想顯示的值列表爲它下面這個變量與複選框，所以

LOC1 LOC2 中Loc3 LOC4

應該顯示覆選框，並且用戶可以選擇單個/多個這些值。根據這我的數據應該被過濾。因此，如果用戶選擇LOC1和LOC2，數據應該得到過濾，根據條件（Store_location ==「LOC1」 | Store_location ==「LOC2」）

一旦用戶取消選中複選框或選擇的過濾器不同的變量，因此數據應該得到更新以及交叉表和圖表。我相信這應該是可能的閃亮做，我試圖用checkboxGroupInput，但無法通過選擇的變量，因此得到錯誤。目前已評論這個，以便代碼運行。我創建了一個CSV格式的示例數據，並已在應用程序中讀取。數據是巨大的，因此使用data.table fread讀取數據。因此，任何子設置都需要在data.table中完成。當點擊「準備分析數據」按鈕時，我會對變量進行重新格式化或創建。爲此，我使用了observeEvent（{}），並且我的所有renderTable/renderplot都在這個事件中。我覺得會有更好的方法來處理這個問題。如果是的話，建議。

最後，我的下載器給我錯誤，「只有'grobs'允許在」gList「中，有時錯誤如」替換有17行，數據有0「。我想用交叉表生成一個pdf文件，並在另一個下面繪製一個。建議我去哪裏錯了。

的樣本數據可以在這裏找到 - sample data

下面是我的應用程序的代碼片段 -

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) 

所以總結一下，需要你的幫助來運行這個程序爲 -

1. 所選過濾器的變量值的動態顯示和過濾器，使交叉表和曲線圖得到更新的數據。注意數據很大，在data.table

2. 下載器以pdf格式下載輸出。

謝謝！

Answer 1

以下是根據所需列的選定值的函數對數據框進行子集合的方法。

雖然我並沒有真正理解你想要對行和列選擇輸入做什麼。

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)