R et brillant: Comment passer une liste de listes (au lieu d'une liste de valeurs) dans choiceValues ​​dans les différents contrôles d'entrée de shiny, comme les boutons radio

Question

Je tente de construire un petit shinyapp avec deux entrées. La deuxième entrée doit utiliser les valeurs de la première entrée. Cela fonctionne bien si des valeurs "uniques" sont transmises. Dans les exemples suivants, l'entrée de diapositive prend les valeurs des boutons radio, soit 1, 5 ou 10 ans, puis ajuste l'entrée du curseur de 1, 5, 10 ans respectivement. Si loin.

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) 

Cependant, si je veux passer une liste de listes, par ex. Plusieurs plages de dates, par exemple les années civiles 2015, 2014 et 2013. Chacune d'entre elles consiste en une liste de deux dates: date de début (1er janvier) et date de fin (31 décembre). Les problèmes apparaissent lorsque j'essaie de transmettre cette liste de listes dans "choiceValues" au lieu d'une liste de valeurs.

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) 

Lorsque les paramètres sont évalués dans le respect partie du code, la « entrée conrol_num $ » est toujours pris comme une liste de caractère avec la longueur d'un. J'avais quelques avertissements dans ce sens. Donc je suppose qu'il n'y a aucune possibilité de passer une liste de listes ici. Quelle serait une manière élégante de résoudre le problème?

Answer 1

Je ne pense pas qu'il soit possible d'avoir des listes ou des vecteurs comme valeurs dans une entrée. Essayez d'avoir une chaîne d'identifiant unique pour chaque valeur, transmettez-la au serveur, puis recherchez la valeur dans une liste nommée. par exemple.

# 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) 
}) 

[modifier] désolé, il y avait une faute de frappe dans updateSliderInput. Version de travail complète:

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)