shiny update plot based on data.table - r

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
)

Answer 1

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)