user1412
user1412

Reputation: 729

Shiny Dynamic Filter variable selection and display of variable values for selection

I am still learning Shiny and R and feel it is a sea where I still need to learn quite a lot. Please excuse me if my method of coding is not ideal and do suggest where the code can be improvised.

I am creating this app where I need to generate cross tabs and charts. I need to filter my data basis variable selected by the user and based on that the tables and charts need to get updated.

So for example if user selects "Store_location" as the filter variable, I want to display the list of values for this variable below it with check box, so

loc1 loc2 loc3 loc4

should get displayed with checkbox, and user can select single / multiple of these values. Basis this my data should get filtered. So if user selects loc1 and loc2, data should get filtered based on the condition (Store_location == "loc1" | Store_location == "loc2")

Once the user unchecks a checkbox OR selects a different variable for filter, accordingly the data should get updated and the crosstabs and charts. I believe this should be possible to be done in Shiny, I was trying to use checkboxGroupInput but not able pass the variable selected and hence getting errors. Currently have commented this so that the code runs. I have created a sample data which is in CSV format and is been read in the app. Data is huge and hence using data.table fread to read the data. So any sub-setting would need to be done in data.table. I do some reformatting / creating of variables when the button "Prepare data for Analysis" is clicked. For this I am using the observeEvent({}) and all my renderTable / renderplot are inside this event. I feel there would be a better way to handle this. If yes do suggest.

Finally, my downloader is giving me error, "only 'grobs' allowed in "gList"" and sometimes error like "replacement has 17 rows, data has 0". I want generate a pdf file with the crosstabs and plot one below the other. Do suggest where I am going wrong.

Sample data can be found here - sample data

Below is the code snippet for my app -

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)

So to summarize, need to your help to run this app for -

  1. Dynamic display of values for the filter variable selected and filter the data so that crosstabs and plots get updated. Note data is big and in data.table

  2. Downloader to download the outputs in pdf format.

Thank you!!

Upvotes: 1

Views: 3403

Answers (1)

Julien Navarre
Julien Navarre

Reputation: 7840

Here is a way to subset your data frame in function of selected values for the desired column.

I didn't really understand what you wanted to do with the row and column select input though.

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)

Upvotes: 1

Related Questions