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

I want to apply multiple drop-down bottoms in Shiny as filters for the data. I found the following example. In this example one load a fixed data, namely mpg from ggplot2. But I want to read the input file dynamically at first and then apply the drop-down choices as filters. Therefore I changed the code:

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

      )
    )

and Server:

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

However, I get the following message:

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

and no histogram.

The next question is, how can I get an histogram instead of a table? The part of my code

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

dose not work too. It means I do get neither a histogram nor an error message!

A sample data set looks like:

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

Addendum: I recognised the problem. The problem is, that dataset is empty and if I change the code above to:

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

I get the following error:

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

Update: I did some changes in the code, but I think that data is still empty.

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

and in GUI I replaced

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

through

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

However, I get the following pic

I think the problem lies in the server. Try this

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)

  })

 }

来源：https://stackoverflow.com/questions/51727460/multiple-drop-down-bottoms-in-shiny-as-filters-for-the-data

标签

Shiny

shiny-server