带有选择输入的SHININE中的分组条形图 [英] grouped bar plot in shiny with select input

问题描述

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

当您使用第一个选择器输入时，它将选择数据源。存在从第一数据源选择变量的第二选择输入。下面的代码适用于非分组条形图。

我正在尝试创建一个双条形图，并且我有另一个独立于当前绘图所使用的数据源的数据源。具有完全相同变量的两个主要数据源。但是，一个表包含"已给出的点数"数据，另一个表包含"已用点数"的数据。

我正在尝试创建一个双条，有回扣给予作为一个条和另一个条的回扣使用。我的问题是，我不能使用一个选择器输入来调用输出，我正在试图找到替代它的方法。我已经发布了下面的代码。

 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)

推荐答案

下面是我稍微修改了您的代码的代码。 我已添加额外的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)

这篇关于带有选择输入的SHININE中的分组条形图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！