基於data.table

Question

閃亮的更新情節在我的示例應用程序我有用戶給一些輸入，並在第一個選項卡中從它生成一個data.table。在第二個選項卡中，我想顯示該圖，具體取決於data.table。我很難獲得正確的反應性。不幸的是在這一點上，我得到了error: Operation not allowed without an active reactive context.

請幫助我或給我提示我做錯了什麼。

數據：

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 <- 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

您需要更新被繪製的數據。請參閱以下工作代碼。我提取數據以反應性表達式myFilter過濾。這需要在創建表之前以及創建圖之前調用。

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)