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

时间:2018-08-07 12:59:55

标签: r shiny shiny-server

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

GUI

  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

,没有直方图。

下一个问题是,如何获得直方图而不是表格?我的代码部分

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

但是,我得到以下图片

enter image description here

1 个答案:

答案 0 :(得分: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)

  })

 }