R Shiny使滑块值动态化

Question

我有一个下拉选择器和一个滑块刻度.我想渲染一个绘图,下拉选择器是数据源. - 我有这部分工作

我只想根据选择的数据集更改滑块的最大值.

有什么建议？

server.R

library(shiny)
shinyServer(function(input, output) {

source("profile_plot.R")
load("test.Rdata")

output$distPlot <- renderPlot({
  if(input$selection == "raw") {
    plot_data <- as.matrix(obatch[1:input$probes,1:36])
  } else if(input$selection == "normalised") {
  plot_data <- as.matrix(eset.spike[1:input$probes,1:36])
  } 

  plot_profile(plot_data, treatments = treatment, sep = TRUE)
  })
})

ui.R 库(有光泽)

shinyUI(fluidPage(
  titlePanel("Profile Plot"),

  sidebarLayout(
    sidebarPanel(width=3,
    selectInput("selection", "Choose a dataset:", 
                 choices=c('raw', 'normalised')),
    hr(),
    sliderInput("probes",
              "Number of probes:",
              min = 2,
              max = 3540,
              value = 10)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

Answer 1

正如@Edik 指出的那样，最好的方法是使用update..类型函数。看起来updateSliderInput不允许控制范围，因此您可以尝试renderUI在服务器端使用：

library(shiny)
runApp(list(
  ui = bootstrapPage(
    numericInput('n', 'Maximum of slider', 100),
    uiOutput("slider"),
    textOutput("test")
  ),
  server = function(input, output) {
    output$slider <- renderUI({
      sliderInput("myslider", "Slider text", 1,
                  max(input$n, isolate(input$myslider)), 21)
    })

    output$test <- renderText({input$myslider})
  }
))

Answer 2

希望这篇文章对学习 Shiny 的人有所帮助：

答案中的信息在概念和机械上都很有用，但对解决整个问题没有帮助。

所以我在 UI API 中发现的最有用的功能就conditionalPanel() 在这里

这意味着我可以为加载的每个数据集创建一个滑块函数，并通过最初加载数据来获取最大值global.R。对于那些不知道的人，global.R可以从 中引用加载到的对象ui.R。

global.R - 加载 ggplo2 方法并测试数据对象（eset.spike 和 obatch）

source("profile_plot.R")
load("test.Rdata")

服务器.R-

library(shiny)
library(shinyIncubator)
shinyServer(function(input, output) {
  values <- reactiveValues()

  datasetInput <- reactive({
    switch(input$dataset,
           "Raw Data" = obatch,
           "Normalised Data - Pre QC" = eset.spike)
  })

  sepInput <- reactive({
    switch(input$sep,
           "Yes" = TRUE,
           "No" = FALSE)
  })

  rangeInput <- reactive({
    df <- datasetInput()
    values$range  <- length(df[,1])
    if(input$unit == "Percentile") {
      values$first  <- ceiling((values$range/100) * input$percentile[1])
      values$last   <- ceiling((values$range/100) * input$percentile[2])
    } else {
      values$first  <- 1
      values$last   <- input$probes      
    }
  })

  plotInput <- reactive({
    df     <- datasetInput()
    enable <- sepInput()
    rangeInput()
    p      <- plot_profile(df[values$first:values$last,],
                           treatments=treatment, 
                           sep=enable)
  })

  output$plot <- renderPlot({
    print(plotInput())
  })

  output$downloadData <- downloadHandler(
    filename = function() { paste(input$dataset, '_Data.csv', sep='') },
    content = function(file) {
      write.csv(datasetInput(), file)
    }
  )

  output$downloadRangeData <- downloadHandler(
    filename = function() { paste(input$dataset, '_', values$first, '_', values$last, '_Range.csv', sep='') },
    content = function(file) {
      write.csv(datasetInput()[values$first:values$last,], file)
    }
  )

  output$downloadPlot <- downloadHandler(
    filename = function() { paste(input$dataset, '_ProfilePlot.png', sep='') },
    content = function(file) {
      png(file)
      print(plotInput())
      dev.off()
    }
  )

})

ui.R

library(shiny)
library(shinyIncubator)

shinyUI(pageWithSidebar(
  headerPanel('Profile Plot'),
  sidebarPanel(
    selectInput("dataset", "Choose a dataset:", 
                choices = c("Raw Data", "Normalised Data - Pre QC")),

    selectInput("sep", "Separate by Treatment?:",
                choices = c("Yes", "No")),

    selectInput("unit", "Unit:",
                choices = c("Percentile", "Absolute")),


    wellPanel( 
      conditionalPanel(
        condition = "input.unit == 'Percentile'",
        sliderInput("percentile", 
                    label = "Percentile Range:",
                    min = 1, max = 100, value = c(1, 5))
      ),

      conditionalPanel(
        condition = "input.unit == 'Absolute'",
        conditionalPanel(
          condition = "input.dataset == 'Normalised Data - Pre QC'",
          sliderInput("probes",
                      "Probes:",
                      min = 1,
                      max = length(eset.spike[,1]),
                      value = 30)
        ),

        conditionalPanel(
          condition = "input.dataset == 'Raw Data'",
          sliderInput("probes",
                      "Probes:",
                      min = 1,
                      max = length(obatch[,1]),
                      value = 30)
        )
      )
    )
  ),

  mainPanel(
    plotOutput('plot'), 
    wellPanel(
      downloadButton('downloadData', 'Download Data Set'),
      downloadButton('downloadRangeData', 'Download Current Range'),
      downloadButton('downloadPlot', 'Download Plot')
    )
  )
))