मेरे उदाहरण ऐप में मेरे पास उपयोगकर्ता कुछ इनपुट देता है और पहले टैब में डेटा.टेबल उत्पन्न करता है। दूसरे टैब में मैं डेटा.टेबल के आधार पर प्लॉट दिखाना चाहूंगा। प्रतिक्रियाशीलता को ठीक करने के लिए मुझे काफी कठिन समय हो रहा है। दुर्भाग्य से इस समय मुझे 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]

यूआई:

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

)

0
Rivka 11 जून 2017, 01:23

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)
1
shosaco 11 जून 2017, 14:38
मुझे यकीन नहीं है कि मैं इसे सही ढंग से समझता हूं, लेकिन फ़ाइलडेटा() को रेंडरप्लॉट में कॉल करने का मतलब इसे वहां बनाना नहीं है। अब इनपुट बदलने पर प्लॉट रिफ्रेश हो जाता है, लेकिन प्लॉट नहीं बदलता है।
 – 
Rivka
11 जून 2017, 11:22
कॉलिंग fileData() बस डेटाटेबल tdata देता है (इस तरह आपने इसे परिभाषित किया है)। यदि आप इनपुट के अनुसार आउटपुट बदलना चाहते हैं, तो tdata को fileData <- reactive ... परिभाषा में बदलें :)
 – 
shosaco
11 जून 2017, 13:23
क्या आप कृपया मुझे एक उदाहरण दे सकते हैं? मैंने सोचा था कि fileData() पहले से ही प्रतिक्रियाशील है। यदि यह प्रतिक्रियाशील नहीं होता तो डेटा-टैब में दिखाया गया डेटा.टेबल अन्यथा कैसे बदल जाता?
 – 
Rivka
11 जून 2017, 14:15
1
मैंने अपना जवाब अपडेट किया, मुझे लगता है कि आप यही हासिल करना चाहते हैं। मुख्य बात यह है कि प्लॉट आउटपुट में आप जो प्लॉट करना चाहते हैं उसे अपडेट करना है।
 – 
shosaco
11 जून 2017, 14:39
1
एक नया प्रश्न होना चाहिए, अन्यथा चीजें भ्रमित हो जाएंगी :) लेकिन मुझे लगता है कि शुरुआत में fileData <- reactiveVal(tdata) सेटिंग मदद करती है, फिर फ़ाइल पढ़ने के बाद आपको fileData(theNewData) सेट करके फ़ाइलडेटा अपडेट करना चाहिए ... (बेशक कॉल की fileData तब fileData() हर जगह है...
 – 
shosaco
11 जून 2017, 17:18