R Shiny Make滑塊值動態

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

希望這篇文章將幫助別人學習閃亮：

的信息的答案是非常有用的概念和機械地，但不幫助整體的問題。

所以最有用的功能，我的UI API中發現的是conditionalPanel()here

這意味着我可以創建每個加載的數據集滑蓋功能，在數據獲得通過加載的最大值最初global.R。對於那些不知道的，加載到global.R中的對象可以從ui.R引用。

global.R - 在一個ggplo2方法和測試數據對象的負載（eset.spike & obatch）

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

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

Answer 2

我認爲你正在尋找的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)) 
}) 

Answer 3

至於@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 4

另一種選擇，可以施加renderUI方法像它在的有光澤畫廊例子之一描述：

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