使用数据集最小值和最大值更新滑块

Question

考虑这个虚拟示例。 我有两个不同的数据集，我需要绘制两个不同的图表。 滑块已设置为显示"First"图形和"table"的年份范围，但是，我的第二个数据集(table2)具有不同的年份范围。 如何更新滑块以自动更新到第二个图形的年份范围？ 我已经阅读了很多关于updateSliderInput的内容，但无法弄清楚。 这是我的例子

library(shiny)
library(ggplot2)

# Define input choices
type <- c("first", "second")
# Data for lambda
table <- structure(list(year = 1991:2010, lambda = c(
  0.68854, 0.75545,
  1.63359, 1.22282, 1.70744, 1.09692, 0.51159, 1.3904, 1.09132,
  0.59846, 0.43055, 0.80135, 0.69027, 0.65646, 0.95485, 1.04818,
  0.67859, 1.00461, 1.16665, 1.28203
)), row.names = c(NA, -20L), class = "data.frame")

table2 <- structure(list(year = 1991:2005, lambda = c(0.68854, 0.75545, 
          1.63359, 1.22282, 1.70744, 1.09692, 0.51159, 1.3904, 1.09132, 
          0.59846, 0.43055, 0.80135, 0.69027, 0.65646, 0.95485)), row.names = c(NA, 
          15L), class = "data.frame")

ui <- fluidPage(
  sidebarPanel(
    h3(""),
    
    # Dropdown to select the desired kind of graphic
    selectInput(
      inputId = "graphtype",
      label = "Graphic",
      choices = type,
      selected = "first"),
    #Slider to select custom years
    sliderInput(inputId = "Yearslider",
                label="Years to plot",
                sep="",
                min=1991,
                max=2010,
                value=c(1991,2010))),
  mainPanel(
    plotOutput("plot")
  )
)
######################################################
#When "second" graph is selected from dropdown I want the slider to update itself
#to reflect the min and max year eg. 1991 to 2005.

server<- function (input, output, session) {
  session$onSessionEnded(function() {
    stopApp()
  })
  
  plot_data <- reactive({
    table[table$year >= input$Yearslider[1] & table$year <= input$Yearslider[2], ] 
  })
  
  plot_data2 <- reactive({
    table2[table2$year >= input$Yearslider[1] & table2$year <= input$Yearslider[2], ] 
  })
  
  dataInput <- reactive({
    switch(input$graphtype,
           "first" = plot_data(),
           "second" = plot_data2())
  })
           
  # Plot data
  create_plots <- reactive({
    #Make the plots
      theme_set(theme_classic(14)) 
      xlabels <- 1991:2010
      if (input$graphtype == "first") {
        disable("Fixed")
        ggplot(plot_data(),aes(year,lambda)) + geom_line(size=1.5,colour="blue") + 
          geom_point(colour="orange",size=4) + geom_hline(yintercept=1,color="hotpink",linetype="dashed") +
          scale_x_continuous("",breaks = xlabels) + 
          theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) + 
          labs(x="",y=expression("Lambda ("~lambda *")"),
               title= paste0("Fish migration ", 
                             table[table$year >= input$Yearslider[1] & table$year <= input$Yearslider[2], ]))
      }
     else{
       ggplot(plot_data2(),aes(year,lambda)) + geom_line(size=1.5,colour="red") + 
         geom_point(colour="orange",size=4) + geom_hline(yintercept=1,color="blue",linetype="dashed") +
         scale_x_continuous("",breaks = xlabels) + 
         theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) + 
         labs(x="",y=expression("Lambda ("~lambda *")"),
              title= paste0("Fish Migration ", 
              table2[table2$year >= input$Yearslider[1] & table2$year <= input$Yearslider[2], ]))
     }
      
  }) 
  
  #Render plots
  output$plot <- renderPlot({
    create_plots()
  },height = 475)
  }         
           
shinyApp(ui = ui, server = server) 

该图在 2005 年停止，因此滑块已被硬编码为 2010 年的最大年份。它需要更新以反映 2005 年作为该特定图的最大年份。 预先感谢。

Answer 1

在服务器端试试这个

observe({
    if (input$graphtype == "first") {
      min = min(table$year)
      max = max(table$year)
    }else{
      min = min(table2$year)
      max = max(table2$year)
    }
    updateSliderInput(session, "Yearslider", min=min, max=max, value=c(min,max))
  })