mercredi 27 mai 2015

R Shiny: how to link checkbox input in ui.R to observe function in server.R?

I am trying to create a checkbox input in a Shiny app that allows the data product user to select all options available, select/deselect options one at a time, and throw an error message when all options in the checkbox group are deselected. I am able to get the actionLink input in my ui.R file working, where all options are selected or deselected when the user clicks 'Select All' and the plot updates with the correct values. However, when the user deselects options one at a time, I occasionally get an error and warning message, and the plot does not update.

From what I can tell, every other time the "Social" option is selected/deselected, the console throws an error and warning message and the plot does not update, then if the user selects/deselects the "Social" option again, the plot updates and no error/warning messages are thrown.

I wonder if this has something to do with the way I've set up the observe function in my server.R file, with the data frame manipulations I've done in the reactive expression for 'ssDf', or how I've defined the 'channels_input' reactive expression.

Below is an abstract from my ui.R file.

channel_chr <- list("Display" = "Display", "Paid Search" = "Paid Search", "Organic Search" = "Organic Search", 
                "Email" = "Email", "Social" = "Social", "Direct" = "Direct", "Referral" = "Referral", 
                "Affiliate" = "Affiliate")

fluidPage(sidebarLayout(
  sidebarPanel(

  ## Other inputs

    checkboxGroupInput("channel", label = "Channel(s)", 
                       choices = channel_chr,
                       selected = as.character(channel_chr)),
    actionLink("selectall","Select All"),

  ## Other inputs

  ),
  mainPanel(
    uiOutput("plot_ui"),
    ggvisOutput("plot")

  )
))

And a relatively small section from my server.R file is below.

channel_chr <- list("Display" = "Display", "Paid Search" = "Paid Search", "Organic Search" = "Organic Search", 
                 "Email" = "Email", "Social" = "Social", "Direct" = "Direct", "Referral" = "Referral", 
                 "Affiliate" = "Affiliate")

shinyServer(function(input, output, session) {

    # If "Select All" is chosen in ui.R for input$selectall, select all checkboxes in input$channel
    observe({
            if (input$selectall == 0) { 
                ## I tried keeping this blank and return(NULL), but saw no difference
            } else if (input$selectall > 0 & input$selectall %% 2 == 0) {
                updateCheckboxGroupInput(session,"channel","Channel(s)",choices=channel_chr,
                                         selected=as.character(channel_chr))
            } else if (input$selectall %% 2 == 1) {
                updateCheckboxGroupInput(session,"channel","Channel(s)",choices=channel_chr,
                                     selected=c("Display"))
            } 
    })

    channels_input <- reactive ({ 
        temp_chr <- character(length=length(channel_chr))
        temp_channel <- input$channel
        temp_chr[1:length(temp_channel)] <- temp_channel
        return(temp_chr)
    })

# A subset of original data frame as reactive function
ssDf <- reactive({  

    ## contains dplyr, plyr, and ddply manipulations of data frame
    ## according to the user's interactions with ui.R.

    ## One example of data frame manipulation in ssDf() reactive function
    ## based on user inputs, and using if/else condition statements

    else if (input$[inputB] == [option1] & all(sort(channels_input())!=sort(as.character(channel_chr)))) {

            ## If channels_input() != channel_chr { filter only those channels where Channel==channels_input() }
            filteredDat2 <- dplyr::filter(filteredDat, Channel==channels_input()[1])
            for (i in 2:length(channels_input())) {
                if (channels_input()[i] != "") {
                    filteredDat2 <- rbind(filteredDat2, dplyr::filter(filteredDat, 
                                                                      Channel==channels_input()[i]))
                }
            }
            filteredDat2 <- ddply(filteredDat2, .(Date, [Column2]), summarize, sum_[Variable1]=sum([Variable1]), 
                                 [Variable2]=weighted.mean([Variable2], [Variable1]), 
                                 [Variable3]=weighted.mean([Variable3], [Variable1]), 
                                 [Variable4]=weighted.mean([Variable4], [Variable1]), 
                                 [Variable5]=weighted.mean([Variable5], [Variable1]))
            ## Subsequent manipulations removed for brevity.        
            return(filteredDat2)
})

ssDf %>%
    ggvis(~Date, ~[Variable4], stroke = ~TimePeriod) %>%
    layer_lines() %>%
    add_axis("y", title = [Variable4], title_offset = 50) %>%
    scale_datetime("x", domain=c(startNowDate, endNowDate)) %>%
    add_tooltip(all_values, "hover") %>%
    bind_shiny("plot", "plot_ui")

Note that I replaced some of my column, variable, and input names with [Column2], [Variable4], etc. for the sake of this post. Also, my tooltip function is not yet functional, so ignore the all_values function within the add_tooltip function in the ggvis pipeline.

Any help with identifying where I went wrong or tips for debugging complex Shiny apps with ggvis would be much appreciated.

Thank you.




Aucun commentaire:

Enregistrer un commentaire