grouped bar plot in shiny with select input

问题

I have multiple select inputs that control the output of a single bar graph currently.

When you use the first selectinput, it will select the data source. There is a secondary selectinput which selects the variable from the first data source. The code below works when you have a non grouped bar plot.

I am trying to create a double bar plot and I have another data source separate from the one I am using for the current plot. The two main data sources that have the exact same variables. However, 1 table has data for 'points given' and another table has data for 'points used'.

I am trying to create a double bar that has rebates given as one bar and another bar for rebates used. My issue is that I cannot use one selectinput to call outputs and I am trying to find an alternative to this. I have posted the code below.

 table1 <- data.frame(replicate(4,sample(500:1000,52,rep=TRUE)))
table1$Week <- replicate(1, sample(1:52,52, rep=FALSE))

table2 <- data.frame(replicate(4,sample(500:1000,52,rep=TRUE)))
table2$Week <- replicate(1, sample(1:52,52, rep=FALSE))

table3 <- data.frame(replicate(4,sample(500:1000,52,rep=TRUE)))
table3$Week <- replicate(1, sample(1:52,52, rep=FALSE))



ui <- fluidPage(

    selectInput("Data1", width = '150px',  selected = "select", label = NULL, choices = c("table1","table2", "table3"))
    ,selectInput("column1", "select variable", width = '150px', choices = c("X1", "X2", "X3", "X4"), selected = "X1")
    ,plotlyOutput("maingraph1")

)

server <- function(input,output, session){

  Data_to_display_Tab1 <<- reactive({
    switch(input$Data1,
           "table1" = Table1,
           "table2" = Table2,
           "table3" = Table3)
  })

  observe({
    updateSelectInput(session, "column1", choices = names(Data_to_display_Tab1()[,-c(5)]), selected = "Table1") 
  })


  output$maingraph1 <- renderPlotly({

    plot_ly(Data_to_display_Tab1()) %>%

      add_trace(x = ~Week, y = ~Data_to_display_Tab1()[,input$column1], type = 'bar', mode = 'lines', name = 'test') %>%
      layout(barmode = 'group', xaxis = list(title = "x axis goes here"), yaxis = list(title = "y axis goes here"))  

  })


}
shinyApp(ui=ui, server=server)

回答1:

Below is the code which I have modified your code a bit. I have added an extra selectInput to select a table for points used.

library(shiny)
library(plotly)
# Sample dataframes for points given
Week <- seq(1:52)
table1 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)
table2 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)
table3 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)

# Sample dataframes for points used
table4 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)
table5 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)
table6 <- data.frame(replicate(4, sample(500:1000, 52, rep = TRUE)), Week)

ui <- fluidPage( sidebarLayout( fluidRow(sidebarPanel(
  uiOutput("Data1"),
  uiOutput("Data2"),
  uiOutput("column1") )),
  mainPanel(
  plotlyOutput("maingraph1")
)))

server <- function(input,output, session){
  # selectInput function to select one table from the list of Points Given tables
  output$Data1 <- renderUI({
    selectInput("dataTables", label = "Select a Table(Points Given)", choices = c("table1", "table2", "table3"))
  })
  # reactive environment to map the selected table name with actual dataframe(i.e, points given)
  Data_to_display_Tab1 <- reactive({
    if (input$dataTables == "table1") {
      df1 <- table1
    } else if (input$dataTables == "table2") {
      df1 <- table2
    } else df1 <- table3
    return(df1)
  })
  # Another selectInput function to select a table from the list of Points Used
  output$Data2 <- renderUI({
    selectInput(inputId = "dataTables2", label = "Select a Table(Points Used)", choices = c("table4", "table5", "table6"))
  })
  # reactive environment to map the selected table name with actual dataframe(i.e, points used)
  Data_to_display_Tab2 <- reactive({
    if (input$dataTables2 == "table4") {
      df2 <- table4
    } else if (input$dataTables2 == "table5") {
      df2 <- table5
    } else df2 <- table6
    return(df2)
  })
  # selectInput function to display variable names of selected table from previous selectInput
  output$column1 <- renderUI({
    selectInput(inputId = "columnNames", label = "Select a Variable", choices = names(Data_to_display_Tab1()[,-c(5)]), selected = "X1")
  })
  # Plotly code
  output$maingraph1 <- renderPlotly({
    plot_ly(Data_to_display_Tab1(), x = ~Week, y = Data_to_display_Tab1()[[input$columnNames]], type = 'bar', name = 'points given') %>%
      add_trace( x = Data_to_display_Tab2()["Week"], y = Data_to_display_Tab2()[[input$columnNames]], name = 'points used') %>%
      layout(xaxis = list(title = "Week"), yaxis = list(title = input$columnNames), barmode = 'group')
  })
}
shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/53164693/grouped-bar-plot-in-shiny-with-select-input

标签

Shiny

shiny-server

shinydashboard