R und glänzend: Wie man eine Liste von Listen (anstelle einer Liste von Werten) in choiceValues ​​in den verschiedenen Eingabesteuerungen von glänzend, wie die Radioknöpfe

Question

übergebe ich versuche, eine kleine shinyapp mit zwei Eingängen zu bauen. Die zweite Eingabe sollte Werte von der ersten Eingabe verwenden. Dies funktioniert gut, wenn "einzelne" Werte übergeben werden. In den folgenden Beispielen nimmt der Schieberegler die Werte der Optionsfelder, entweder 1, 5 oder 10 Jahre, und passt dann den Schieberegut jeweils um 1, 5, 10 Jahre an. So weit so.

library(shiny) 
library(lubridate) 

ui = fluidPage(
    titlePanel("Changing the values of inputs"), 
    fluidRow(
    radioButtons("control_num", 
       "Choose time span:", 
       choiceNames = list("10 years", 
            "5 years", 
            "1 year"), 
       choiceValues = list(10, 
            5, 
            3), 
       inline = T), 
    sliderInput(inputId = "inSlider2", 
       label = "timeline:", 
       min = as.Date("2001-01-01") , 
       max = as.Date("2016-12-31"), 
       value = c(as.Date("2011-01-01") , as.Date("2013-01-01")), 
       step = 1, 
       width = "90%" 
    ) 
) 
) 

server = function(input, output, session) { 

    observe({ 
    c_num <- as.numeric(input$control_num) 
    c_num1 <- as.Date("2016-12-31") - years(c_num) 
    c_num2 <- as.Date("2016-12-31") 

    # Slider range input 
    updateSliderInput(session, "inSlider2", 
         value = c(c_num1 , c_num2)) 
    }) 
} 


shinyApp(ui = ui, server = server) 

Wenn ich jedoch eine Liste von Listen, z. mehrere Datumsbereiche, z. B. Kalenderjahr 2015, 2014 und 2013. Jede dieser Daten besteht aus einer Liste mit zwei Daten: Startdatum (1. Januar) und Enddatum (31. Dezember). Das Problem tritt auf, wenn ich versuche, diese Liste von Listen in "ChoiceValues" anstelle einer Liste von Werten zu übergeben.

library(shiny) 
library(lubridate) 

ui = fluidPage(
    titlePanel("Changing the values of inputs from the server"), 
    fluidRow(

    radioButtons("control_num2", 
       "Choose time span:", 
       choiceNames = list("2015", 
            "2014", 
            "2013"), 
       choiceValues = list(c(as.Date("2015-01-01"), as.Date("2015-12-31")), 
            c(as.Date("2014-01-01"), as.Date("2014-12-31")), 
            c(as.Date("2013-01-01"), as.Date("2013-12-31")) 
            ), 
       inline = T), 

    sliderInput(inputId = "inSlider2", 
       label = "timeliner:", 
       min = as.Date("2001-01-01") , 
       max = as.Date("2016-12-31"), 
       value = c(as.Date("2011-01-01") , as.Date("2013-01-01")), 
       step = 1, 
       width = "90%" 
    ) 

) 
) 

server = function(input, output, session) { 

    observe({ 
    c_num <- input$control_num2 
    c_num1 <- as.list(input$control_num2) 

    # used to check the structure of the input variable 
    updateNumericInput(session, "control_num2", 
         label = paste("Input ", c_num, 
            "Input as list: ", c_num1, 
            "First element of list: ", c_num1[1]), 
         value = c_num) 

    # Slider range input 
    updateSliderInput(session, "inSlider2", 
         value = c_num ) 


    }) 
} 

shinyApp(ui = ui, server = server) 

Wenn die Parameter in dem Teil des Codes beobachten ausgewertet wird, der „Eingang $ conrol_num“ wird immer als eine Liste von Zeichen mit einer Länge von einem genommen. Ich hatte einige Warnungen in diese Richtung. Also ich denke, es gibt keine Möglichkeit, eine Liste von Listen hier zu übergeben. Was wäre ein eleganter Weg, um das Problem zu lösen?

Answer 1

Ich glaube nicht, dass es möglich ist, Listen oder Vektoren als Werte in einer Eingabe zu haben. Versuchen Sie, für jeden Wert eine eindeutige ID-Zeichenfolge zu haben, übergeben Sie diese an den Server und suchen Sie den Wert in einer benannten Liste. z.B.

# in UI 
radioButtons("control_num2", 
      "Choose time span:", 
      choiceNames = c("2015","2014","2013"), 
      choiceValues = c("year2015", "year2014", "year2015") 
      inline = T) 


# in server 
idmap <- list("year2015" = c(as.Date("2015-01-01"), as.Date("2015-12-31")), 
       "year2014" = c(as.Date("2014-01-01"), as.Date("2014-12-31")), 
       "year2013" = c(as.Date("2013-01-01"), as.Date("2013-12-31"))) 

observe({ 
    req(input$control_num2) 
    c_num <- idmap[[input$control_num2]] 
    # Slider range input 
    updateSliderInput(session, "inSlider2", 
         value = c_num) 
}) 

[Bearbeiten] sorry, es war ein Tippfehler in updateSliderInput. Komplette funktionierende Version:

library(shiny) 
library(lubridate) 

ui = fluidPage(
    titlePanel("Changing the values of inputs from the server"), 
    fluidRow(
    radioButtons("control_num2", 
       "Choose time span:", 
       choices=c("2015"="year2015", "2014"="year2014", "2013"="year2013"), 
       inline = T), 
    sliderInput(inputId = "inSlider2", 
       label = "timeliner:", 
       min = as.Date("2001-01-01") , 
       max = as.Date("2016-12-31"), 
       value = c(as.Date("2011-01-01") , as.Date("2013-01-01")), 
       step = 1, 
       width = "90%"))) 

server = function(input, output, session) { 

    idmap <- list("year2015" = c(as.Date("2015-01-01"), as.Date("2015-12-31")), 
       "year2014" = c(as.Date("2014-01-01"), as.Date("2014-12-31")), 
       "year2013" = c(as.Date("2013-01-01"), as.Date("2013-12-31"))) 

    observe({ 
    req(input$control_num2) 
    c_num <- idmap[[input$control_num2]] 
    # Slider range input 
    updateSliderInput(session, "inSlider2", 
         value = c_num) 
    }) 
    } 

shinyApp(ui = ui, server = server)