r - R Shiny 使滑块值动态化

Question

我有一个下拉选择器和一个滑块刻度。我想用下拉选择器作为数据源来渲染一个图。- 我有这部分工作

我只是希望滑块的最大值根据选择的数据集而改变。

有什么建议么？

服务器.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")
    )
  )
))

score 6 · Accepted Answer

正如@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})
  }
))

score 4 · Accepted Answer

希望这篇文章能帮助学习 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()
    }
  )

})

用户界面

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')
    )
  )
))

score 2 · Accepted Answer

我认为您正在寻找允许您以编程方式更新闪亮输入的 updateSliderInput 函数：http: //shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html。其他输入也有类似的功能。

 observe({
     x.dataset.selection = input$selection
     if (x.dataset.selection == "raw") {
        x.num.rows = nrow(obatch)
     } else {
        x.num.rows = nrow(eset.spike)
     }
     # Edit: Turns out updateSliderInput can't do this, 
     # but using a numericInput with 
     # updateNumericInput should do the trick.
     updateSliderInput(session, "probes",
       label = paste("Slider label", x.dataset.selection),
       value = c(1,x.num.rows))
 })

score 2 · Accepted Answer

另一种选择是应用 renderUI 方法，就像在一个闪亮的画廊示例中描述的那样：

http://shiny.rstudio.com/gallery/dynamic-ui.html

r - R Shiny 使滑块值动态化

4 回答 4

Related

Reference