带有选择输入的闪亮分组条形图

Question

我有多个选择输入，当前控制单个条形图的输出。

当使用第一个selectinput时，它将选择数据源。 有一个辅助selectinput从第一个数据源中选择变量。 当您具有未分组的条形图时，下面的代码可以工作。

我正在尝试创建一个双杠图，并且我有另一个数据源与用于当前图的数据源分开。 具有完全相同的变量的两个主要数据源。 但是，一个表具有“给定点”的数据，而另一个表具有“已使用点”的数据。

我正在尝试创建一个具有折扣的双栏，其中一个作为折扣，另一个为使用的折扣。 我的问题是，我无法使用一个selectinput调用输出，而我正在尝试寻找一种替代方法。 我已经在下面发布了代码。

 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)

Answer 1

以下是我对您的代码进行了一些修改的代码。 我添加了一个额外的selectInput来为使用的点选择一个表。

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)