使用 select 输入闪亮的分组条形图

Question

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

当您使用第一个 select 输入时，它将 select 数据源。有一个辅助 select 输入，其中 select 来自第一个数据源的变量。当您有一个非分组条形图时，下面的代码有效。

我正在尝试创建一个双条形图，并且我有另一个数据源与我用于当前图的数据源不同。具有完全相同变量的两个主要数据源。但是，1 table 有 'points given' 的数据，另一个 table 有 'points used'.

的数据

我正在尝试创建一个双条，其中一个条给出回扣，另一个条用于回扣。我的问题是我不能使用一个 select 输入来调用输出，我正在尝试寻找替代方法。我已经发布了下面的代码。

 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 到 select 一个 table 用于使用的点数。

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)

使用 select 输入闪亮的分组条形图

grouped bar plot in shiny with select input

r

shiny

shiny-server

shinydashboard