В настоящее время у меня есть несколько входов select, которые управляют выводом одной гистограммы.

Когда вы используете первый вход select, он выберет источник данных. Существует вторичный вход select, который выбирает переменную из первого источника данных. Приведенный ниже код работает, когда у вас есть несгруппированная гистограмма.

Я пытаюсь создать график с двумя полосами, и у меня есть другой источник данных, отличный от того, который я использую для текущего графика. Два основных источника данных с одинаковыми переменными. Однако в одной таблице есть данные для «заданных баллов», а в другой таблице - для «использованных баллов».

Я пытаюсь создать двойной стержень, для которого используются скидки для одной полосы и для другой полосы. Моя проблема в том, что я не могу использовать один вход 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)
0
Attrey 6 Ноя 2018 в 04:45

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)
1
Pang 19 Ноя 2018 в 03:55