R Shiny Udostępnij wartość suwaka dynamicznego

Question

Mam selektor rozwijany i skalę suwaków. Chcę renderować wykres za pomocą rozwijanego selektora będącego źródłem danych. - Mam tę część działającą

Po prostu chcę zmienić maksymalną wartość suwaka na podstawie wybranego zestawu danych.

Wszelkie sugestie?

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 biblioteka (błyszczący)

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

Mam nadzieję, że ten post pomoże komuś uczenia Shiny:

informacje zawarte w odpowiedziach jest przydatna koncepcyjnie i mechanicznie, ale nie pomaga w ogólnym pytaniu.

Więc najbardziej przydatna funkcja znalazłem w API UI jest conditionalPanel()here

Oznacza to mogę utworzyć funkcję suwaka dla każdego zbioru danych załadowany i uzyskać wartość max ładując w danych początkowo global.R. Dla osób, które nie wiedzą, obiekty załadowane do global.R można odnosić z ui.R.

global.R - siły w sposobie ggplo2 i badanych obiektów danych (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

myślę szukasz funkcji updateSliderInput który pozwala programowo aktualizuje błyszczące wejście: http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html. Istnieją również podobne funkcje dla innych wejść.

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

Jak @Edik zauważyć, że najlepszym sposobem, aby to zrobić byłoby użyć funkcji update.. typu. To wygląda updateSliderInput robi umożliwiają kontrolę zakresu więc można spróbować użyć renderUI po stronie serwera:

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

Inną alternatywą może być zastosowanie podejścia renderUI jak jest to opisane w jednym z lśniących przykładów galerii:

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