R Shiny Schieberegler Wert dynamisch machen

Question

Ich habe eine Dropdown-Auswahl und eine Slider-Skala. Ich möchte ein Diagramm darstellen, wobei der Dropdown-Schalter die Quelle der Daten ist. - Ich habe dieses Teil funktioniert

Ich möchte einfach den maximalen Wert des Schiebereglers ändern, basierend auf welcher Datensatz ausgewählt ist.

Irgendwelche Vorschläge?

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 Bibliothek (glänzend)

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

Hoffentlich Post jemand helfen Shiny Lernen:

Die Informationen in den Antworten ist konzeptionell sinnvoll und mechanisch, aber hilft nicht die Gesamtfrage.

Also das nützlichste Feature, das ich in der UI API gefunden ist conditionalPanel()here

Das bedeutet, ich lud eine Slider-Funktion für jeden Datensatz erstellen könnte und den Maximalwert durch das Laden der Daten zunächst in global.R erhalten. Für diejenigen, die es nicht wissen, können Objekte, die in global.R geladen sind, von ui.R referenziert werden.

global.R - Lasten in einem ggplo2 Verfahren und Testdatenobjekte (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

Ich glaube, du bist für die updateSliderInput Funktion suchen, die Sie eine programmatisch aktualisieren können glänzender Eingang: http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html. Für andere Eingänge gibt es ähnliche Funktionen.

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

Wie @Edik bemerkt, der beste Weg, dies zu tun wäre, eine update.. Typ Funktion zu verwenden. Es sieht aus wie updateSliderInput tut Kontrolle des Bereichs zu ermöglichen, so können Sie versuchen, renderUI auf der Server-Seite mit:

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

Eine weitere Alternative kann ein renderUI Ansatz anwenden, wie es in einem der glänzenden Galerie Beispiele beschrieben:

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