shiny update plot based on data.table

Question

in my example app I have the user give some input and generate a data.table from it in the first tab. in the second tab I would like to show the plot, depending on the data.table. I am having quite a hard time to get the reactivity right. Unfortunately at this point I get the error: Operation not allowed without an active reactive context.

Please help me or give me hints what I am doing wrong.

the data:

tdata <- data.table(fruit = c("Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple","Banana", "Banana","Banana","Banana","Banana", "Banana","Banana","Banana"), 
                    Fertilizer = c(1,2,4,3,2,2,2,2,1,4,3,2,4,4,3,1), 
                    amount = c(2,3,4,7,1,34,33,21,12,32,22,17,14,9,22,6),
                    red = rep(c("+","+","-","-"),4),
                    green = rep(c("+","-"),8))
tdata[, grp := do.call(paste, c(list(sep="\n"),.SD)),.SDcols = 4:5]

UI:

library(shiny)
library(data.table)
library(DT)

ui <- (fluidPage(tagList(
  sidebarLayout(
    sidebarPanel(uiOutput("file_input")),
    mainPanel(
      tabsetPanel(
        tabPanel("Data",dataTableOutput('fruit_table') ),
        tabPanel("Plot", plotOutput('barPlot'))

  ))))))

Server:

server <- function(input, output) {

  fileData <- reactive(
    return(tdata)
  )

  output$file_input <- renderUI ({
    if(is.null(fileData())){
      return()
    }else{
      tagList(
        checkboxGroupInput(inputId = "fruit",
                           label = "fruit",
                           choices = c(unique(fileData()[,get("fruit")])),
                           selected = fileData()[1, 1, with = FALSE]),
        checkboxGroupInput(inputId = "tube",
                           label = "Fertilizer",
                           choices = unique(fileData()[,get("Fertilizer")]),
                           selected = fileData()[1, 3, with = F]),
        ###build checkboxes from Loop:
        lapply(1:(length(fileData())-4), function(i) {
          checkboxGroupInput(inputId = paste0("color",i),
                             label = colnames(fileData()[,i+3, with = FALSE]),
                             choices = c(unique(fileData()[,get(colnames(fileData()[,i+3, with = FALSE]))])),
                             inline = TRUE,
                             selected = fileData()[1, i+3, with = FALSE])
        }))}})

  output$fruit_table <- renderDataTable({
    if(is.null(fileData())){
      return(NULL)
    }else{

      validate(
        need(input$fruit, 'Check at least one fruit'),
        need(input$tube, 'Check at least one Fertilizer'),
        ####loop not working in here
        need(input$color1, "Check at least one !"), 
        need(input$color2, "Check at least one !")
      )

      filter_expr <- TRUE

      if (!(is.null(input$fruit))) {
        filter_expr <- filter_expr & fileData()[,fruit] %in% input$fruit
        #print((input$fruit))
      }
      if (!(is.null(input$tube))) {
        filter_expr <- filter_expr & fileData()[,Fertilizer] %in% input$tube
      }

      ##non-loop-verison
      if (!(is.null(input$color1))) {
        filter_expr <- filter_expr & fileData()[,red] %in% input$color1
      }

      if (!(is.null(input$color2))) {
        filter_expr <- filter_expr & fileData()[,green] %in% input$color2
       }

      datatable(fileData()[filter_expr,],options = list(pageLength = 25))
    }})

  plot.dat <- reactiveValues(main = NULL)
  plot.dat$main <- ggplot(data = fileData(), mapping = aes( x = fileData()[,grp], y =fileData()[,amount]))+
    geom_boxplot( stat = 'boxplot',
                  position = position_dodge(width=0.8),
                  width = 0.55) 
  observe({

    output$barPlot <- renderPlot({
      if(is.null(fileData())){
        return(NULL)
      }else{

        validate(
          need(input$fruit, 'Check at least one fruit'),
          need(input$tube, 'Check at least one Fertilizer'),
          need(input$color1, "Check at least one !"), 
          need(input$color2, "Check at least one !")
        )

        plot.dat$main

  }})
})
}
shinyApp(ui = ui, server = server

)

shosaco · Accepted Answer · 2017-06-11T11:38:38.493

You need to update the data that gets plotted. See the following working code. I extracted the data to filter in a reactive expression myFilter. This needs to be called before creating the table as well as before creating the plot.

library(shiny)
library(data.table)
library(DT)
library(ggplot2)

tdata <- data.table(fruit = c("Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple","Banana", "Banana","Banana","Banana","Banana", "Banana","Banana","Banana"), 
                    Fertilizer = c(1,2,4,3,2,2,2,2,1,4,3,2,4,4,3,1), 
                    amount = c(2,3,4,7,1,34,33,21,12,32,22,17,14,9,22,6),
                    red = rep(c("+","+","-","-"),4),
                    green = rep(c("+","-"),8))
tdata[, grp := do.call(paste, c(list(sep="\n"),.SD)),.SDcols = 4:5]



ui <- (fluidPage(tagList(
  sidebarLayout(
    sidebarPanel(uiOutput("file_input")),
    mainPanel(
      tabsetPanel(
        tabPanel("Data",dataTableOutput('fruit_table') ),
        tabPanel("Plot", plotOutput('boxPlot'))

      ))))))

server <- function(input, output) {

  fileData <- tdata # static data, doesn't change, noneed to be reactive

  output$file_input <- renderUI ({
    validate(need(!is.null(fileData), ''))
      tagList(
        checkboxGroupInput(inputId = "fruit",
                           label = "fruit",
                           choices = c(unique(fileData[,get("fruit")])),
                           selected = fileData[1, 1, with = FALSE]),
        checkboxGroupInput(inputId = "tube",
                           label = "Fertilizer",
                           choices = unique(fileData[,get("Fertilizer")]),
                           selected = fileData[1, 3, with = F]),
        ###build checkboxes from Loop:
        lapply(seq(length(fileData)-4), function(i) {
          checkboxGroupInput(inputId = paste0("color",i),
                             label = colnames(fileData[,i+3, with = FALSE]),
                             choices = c(unique(fileData[,get(colnames(fileData[,i+3, with = FALSE]))])),
                             inline = TRUE,
                             selected = fileData[1, i+3, with = FALSE])
        })
      )
  })

  # build a filter according to inputs
  myFilter <- reactive({
     validate(need(!is.null(fileData), ''))
      validate(
        need(input$fruit, 'Check at least one fruit'),
        need(input$tube, 'Check at least one Fertilizer'),
        need(input$color1, "Check at least one !"), 
        need(input$color2, "Check at least one !")
      )

      fileData[,fruit] %in% input$fruit & fileData[,Fertilizer] %in% input$tube &
         fileData[,red] %in% input$color1 & fileData[,green] %in% input$color2

    })

    # print the datatable matching myFilter()
    output$fruit_table <- renderDataTable({
      datatable(fileData[myFilter(),],options = list(pageLength = 25))
    })

  # build a boxPLot according to myFilter()
  output$boxPlot <- renderPlot({
    validate(
      need(!is.null(fileData), ''),
      need(input$fruit, 'Check at least one fruit'),
      need(input$tube, 'Check at least one Fertilizer'),
      need(input$color1, "Check at least one !"),
      need(input$color2, "Check at least one !")
    )

    data <- fileData[myFilter(),]
    ggplot(data = data, mapping = aes( x = data[,grp], y =data[,amount]))+
      geom_boxplot( stat = 'boxplot',
                    position = position_dodge(width=0.8),
                    width = 0.55)
  })
}
shinyApp(ui = ui, server = server)

I am not sure if I understand it correctly, but calling fileData() in renderPlot does not mean creating it there. Now the plot refreshes when the input changes, but the plot does not change. — Rivka, Jun 11 '17 at 08:22
calling fileData() just returns the datatable `tdata` (this is how you defined it). If you want to change the output according to the inputs, change `tdata` in the `fileData <- reactive ...` definition :) — shosaco, Jun 11 '17 at 10:23
can you please give me an example? I thought fileData() is reactive already. if it wasn't reactive how would the data.table shown in the data-tab change otherwise? — Rivka, Jun 11 '17 at 11:15
the data.table then get changed in renderData.Table via different input. That does not make it reactive? so should I move the code from `renderData.Table` to `fileData <- reactive({tdata ....})`and just return fileData() in renderData.Table? — Rivka, Jun 11 '17 at 11:39
I updated my answer, I think that's what you want to achieve. The main thing is to update what you want to plot in the plot output. — shosaco, Jun 11 '17 at 11:39
ok, that confirms what I meant with my last comment. we can now also skip the `validate` part in `renderPlot `. great help ! reactivity is way clearer to me now — Rivka, Jun 11 '17 at 11:49
one more thing: if I use a fileReader and save the input as fileData,then fileDate will have to be reactive, right? but then the code is not running, but sends the error: `object of type closure is not subsettable` — Rivka, Jun 11 '17 at 14:15
should be a new question, otherwise things will get confusing :) but I guess setting `fileData <- reactiveVal(tdata)` in the beginning helps, then after fileReading you should update fileData by setting `fileData(theNewData)`... (of course the call of `fileData` is `fileData()` everywhere then... — shosaco, Jun 11 '17 at 14:18

shiny update plot based on data.table

1 Answers1