Shiny 中的多个下拉底部作为数据过滤器

Question

我想在 Shiny 中应用多个下拉底部作为数据过滤器。我找到了 following example。在这个例子中，加载一个固定数据，即 mpg from ggplot2。但我想首先动态读取输入文件，然后将下拉选项应用为过滤器。因此我更改了代码：

图形界面:

  fluidPage(
      titlePanel("Ausfallsbericht"),


      # Sidebar layout with input and output definitions ----
      sidebarLayout(

        # Sidebar panel for inputs ----
        sidebarPanel(
          fluidRow(
        #find all the files in ths path
            column(12,
                   selectInput(inputId = 'date',
                               label = 'Choose a date:',
                               choices = list.files(path = "C:/R_myfirstT/data",
                                                    full.names = FALSE,
                                                    recursive = FALSE)),
                   ###
               selectInput("konz",
                           "Konzernbe:",
                           c("All",
                             unique(as.character(datT2$Konzernbe )))),

               selectInput("lgdK",
                           "LGD:",
                           c("All",
                             unique(as.character(datT2$LGD.Klasse)))),

               selectInput("group",
                           "Best:",
                           c("All",
                             unique(datT2$Best)))
         )
          )
      ),
    #  Create a new row for the table.
      fluidRow(
        DT::dataTableOutput("table")
      )

      )
    )

和服务器:

function(input, output) {

  #read the data
  dataset <- reactive({
    infile <- input$date
    if (is.null(infile)){
      return(NULL)
    }
    read.table(paste0('O:/R/data/',infile),header=TRUE, sep=";")
  })
  data<- dataset
  datT2<-dataset
  # Filter data based on selections
  output$table <- DT::renderDataTable(DT::datatable({
    #data <- datT2
    if (input$konz != "All") {
      data <- data[data$Konzernbe == input$konz,]
    }
    if (input$group != "All") {
      data <- data[data$Best == input$group,]
    }
    if (input$lgdK != "All") {
      data <- data[data$LGD.Klasse == input$lgdK,]
    }
    x <- data()$Marktwert
    hist(x, breaks = 40)

    #data
    }))
 }

但是，我收到以下消息：

Warning: Error in DT::datatable: 'data' must be 2-dimensional

并且没有直方图。

下一个问题是，如何获得直方图而不是 table？我的部分代码

 x <- data()$Marktv
  hist(x, breaks = 40)

剂量也不起作用。这意味着我既没有得到直方图也没有得到错误消息！

示例数据集如下所示：

Konzernbe  Best  LGD.Klasse  Marktwert   EL absolut 
6010    3   3   1142345261  1428757
6010    3   3   849738658   1028973
6010    1   3   1680222820  220554
6010    1   3   896459567   116673
6010    0   3   1126673222  72077
6010    1   3   704226037   93310
--      1   4   336164879   49299
6010    0   3   948607746   60443
6070    1   3   265014117   34170
6020    3   3   47661945    58551
6050    2   3   307011781   115959
6020    0   1   1064022992  20320
6010    0   3   831782040   52950
6080    3   3   19367641    20286
--      2   4   197857365   87608
6010    1   3   679828856   90884
6050    3   3   317092037   372362
6080    3   3   20223616    21929
6010    1   3   693736624   96899
6050    3   3   308447822   372915
6010    4   3   177281455   862068

附录：我发现了这个问题。问题是，dataset 是空的，如果我将上面的代码更改为：

  infile <- input$date
    if (is.null(infile)){
      return(NULL)
    }
   dataset <- read.table(paste0('O:/R/data/',infile),header=TRUE, sep=";")

我收到以下错误：

 Warning: Error in .getReactiveEnvironment()$currentContext: Operation not
 allowed without an active reactive context. (You tried to do something that can 
 only be done from inside a reactive expression or observer.)

更新：我对代码做了一些修改，但我认为data仍然是空的。

function(input, output) {

  #read the data 
  dataset <- reactive({
    infile <- input$date
    if (is.null(infile)){
      return(NULL)
    }
    dataset <- read.table(paste0('O:/R/data/'),header=TRUE, sep=";")
    data<- dataset() #datT2#dataset
    # Filter data based on selections
  output$table <- DT::renderDataTable(DT::datatable({
    #data <- datT2
    if (input$konz != "All") {
      data <- data[data$Konzernbe == input$konz,]
    }
    if (input$group != "All") {
      data <- data[data$Best == input$group,]
    }
    if (input$lgdK != "All") {
      data <- data[data$LGD.Klasse == input$lgdK,]
    }
    #x <- data()$Marktwert
    #hist(x, breaks = 40)

    })) 

  })
  output$plot <- renderPlot({
      x <- data()$Marktwert
      hist(x, breaks = 40)
  })
 }

在 GUI 中我替换了

#  Create a new row for the table.
      fluidRow(
        DT::dataTableOutput("table")
      )

到

# Main panel for displaying outputs ----
mainPanel(
  plotOutput("plot")
)

但是，我得到了下面的图片

Answer 1

我觉得是服务器的问题。试试这个

function(input, output) {

  #read the data 
  dataset <- reactive({
  infile <- input$date
  if (is.null(infile)){
    return(NULL)
  }
  data<-read.table(paste0('---/data/',infile),header=TRUE, sep=";")
  data[is.na(data)]<- 0

  if (input$konz != "All") {
   data <- data[data$Konzernbezeichnung == input$konz,]
  }
  if (input$group != "All") {
   data <- data[data$Bestandseingruppierung == input$group,]
  }
  if (input$lgdK != "All") {
   data <- data[data$LGD.Klasse == input$lgdK,]
  }
  })

  # Filter data based on selections
  output$plot <- renderPlot({

   x <- dataset()$Marktwert
   hist(x, breaks = 40)

  })

 }

Shiny 中的多个下拉底部作为数据过滤器

multiple drop-down bottoms in Shiny as filters for the data

r

shiny

shiny-server