web-dev-qa-db-fra.com

R brillant en passant réactif pour sélectionner les choix d'entrée

Dans une application brillante (par RStudio), du côté de serveur, j'ai un réactif qui renvoie une liste de variables en analysant le contenu d'un textInput. La liste des variables est ensuite utilisée dans selectInput et/ou updateSelectInput.

Je ne peux pas le faire fonctionner. Aucune suggestion?

J'ai fait deux tentatives. La première approche consiste à utiliser le réactif outVar directement dans selectInput. La deuxième approche consiste à utiliser le réactif outVar dans updateSelectInput. Ni fonctionne.

serveur.R

shinyServer(
  function(input, output, session) {

    outVar <- reactive({
        vars <- all.vars(parse(text=input$inBody))
        vars <- as.list(vars)
        return(vars)
    })

    output$inBody <- renderUI({
        textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
    })

    output$inVar <- renderUI({  ## works but the choices are non-reactive
        selectInput(inputId = "inVar", label = h4("Select variables:"), choices =  list("a","b"))
    })

    observe({  ## doesn't work
        choices <- outVar()
        updateSelectInput(session = session, inputId = "inVar", choices = choices)
    })

})

ui.R

shinyUI(
  basicPage(
    uiOutput("inBody"),
    uiOutput("inVar")
  )
)

Il y a quelques instants, j'ai posé la même question sur shiny-discussion, mais cela n'a suscité que peu d'intérêt. Je pose donc à nouveau mes excuses https://groups.google.com/forum/#! topic/shiny-discussion/e0MgmMskfWo

Éditer 1

@Ramnath a gentiment posté une solution qui semble fonctionner, notée Edit 2 par lui. Mais cette solution ne résout pas le problème car textinput se trouve du côté ui au lieu de server comme dans mon problème. Si je déplace le textinput de la deuxième édition de Ramnath vers le côté server, le problème réapparaît, à savoir: rien ne s'affiche et RStudio se bloque. J'ai trouvé que le fait d'encapsuler input$text Dans as.character Fait disparaître le problème.

Éditer 2

Dans une discussion ultérieure, Ramnath m'a montré que le problème se posait lorsque le serveur essayait d'appliquer la fonction dynamique outVar avant que ses arguments n'aient été renvoyés par textinput. La solution consiste d'abord à vérifier si is.null(input$inBody) existe.

La vérification de l'existence d'arguments est un aspect crucial de la création d'une application brillante , alors pourquoi n'y ai-je pas pensé ? Eh bien, je l'ai fait, mais j'ai dû faire quelque chose de mal! Compte tenu du temps que j'ai passé sur le problème, c'est une expérience amère. Je montre après le code comment vérifier l'existence.

Ci-dessous, le code de Ramnath avec textinput déplacé vers le côté server. Il bloque RStudio, alors n’essayez pas à la maison. (J'ai utilisé sa notation)

library(shiny)
runApp(list(
  ui = bootstrapPage(
    uiOutput('textbox'),  ## moving Ramnath's textinput to the server side
    uiOutput('variables')
  ),
  server = function(input, output){
    outVar <- reactive({
      vars <- all.vars(parse(text = input$text))  ## existence check needed here to prevent a crash
      vars <- as.list(vars)
      return(vars)
    })

    output$textbox = renderUI({
      textInput("text", "Enter Formula", "a=b+c")
    })

    output$variables = renderUI({
      selectInput('variables2', 'Variables', outVar())
    })
  }
))

Voici comment je vérifie habituellement l'existence:

if (is.null(input$text) || is.na(input$text)){
  return()
} else {
  vars <- all.vars(parse(text = input$text))
  return(vars)
}

Le code de Ramnath est plus court:

if (!is.null(mytext)){
  mytext = input$text
  vars <- all.vars(parse(text = mytext))
  return(vars)
}

Les deux semblent fonctionner, mais je vais le faire à la manière de Ramnath à partir de maintenant: peut-être une parenthèse déséquilibrée dans mon concept m'avait-elle précédemment empêché de faire fonctionner le chèque? Le chèque de Ramnath est plus direct.

Enfin, j'aimerais souligner quelques points concernant mes différentes tentatives de débogage.

Dans ma quête de débogage, j'ai découvert qu'il était possible de "classer" la priorité des "sorties" côté serveur, ce que j'ai exploré pour tenter de résoudre mon problème, mais n'a pas fonctionné car le problème était ailleurs. Pourtant, il est intéressant de savoir et semble ne pas être très connu pour le moment:

outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)

Dans cette quête, j'ai aussi essayétry:

try(vars <- all.vars(parse(text = input$text)))

C'était assez proche, mais ça n'a toujours pas été réglé.

La première solution sur laquelle je suis tombé sur était:

vars <- all.vars(parse(text = as.character(input$text)))

Je suppose qu'il serait intéressant de savoir pourquoi cela a fonctionné: est-ce parce que cela ralentit suffisamment les choses? Est-ce parce que as.character "attend" que input$text soit non-nul?

Quoi qu'il en soit, je suis extrêmement reconnaissant à Ramnath pour ses efforts, sa patience et ses conseils.

57
PatrickT

Vous devez utiliser renderUI sur le côté serveur pour les interfaces utilisateur dynamiques. Voici un exemple minimal. Notez que le deuxième menu déroulant est réactif et s’adapte au jeu de données que vous avez choisi dans le premier. Le code devrait être explicite si vous avez déjà traité avec brillant.

runApp(list(
  ui = bootstrapPage(
    selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
    uiOutput('columns')
  ),
  server = function(input, output){
    output$columns = renderUI({
      mydata = get(input$dataset)
      selectInput('columns2', 'Columns', names(mydata))
    })
  }
))

MODIFIER. Une autre solution utilisant updateSelectInput

runApp(list(
  ui = bootstrapPage(
    selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
    selectInput('columns', 'Columns', "")
  ),
  server = function(input, output, session){
    outVar = reactive({
      mydata = get(input$dataset)
      names(mydata)
    })
    observe({
      updateSelectInput(session, "columns",
      choices = outVar()
    )})
  }
))

EDIT2: Exemple modifié utilisant parse. Dans cette application, la formule de texte entrée est utilisée pour remplir dynamiquement le menu déroulant ci-dessous avec la liste des variables.

library(shiny)
runApp(list(
  ui = bootstrapPage(
    textInput("text", "Enter Formula", "a=b+c"),
    uiOutput('variables')
  ),
  server = function(input, output){
    outVar <- reactive({
      vars <- all.vars(parse(text = input$text))
      vars <- as.list(vars)
      return(vars)
    })

    output$variables = renderUI({
      selectInput('variables2', 'Variables', outVar())
    })
  }
))
70
Ramnath

Autant que je sache, le problème est que input$inBody ne récupère pas un character même si la fonction selectInput reçoit un character comme valeur, à savoir value = "a+b+c". La solution consiste donc à envelopper input$inBody dans un as.character

Les oeuvres suivantes:

L'approche observe avec updateSelectInput:

observe({
     input$inBody
     vars <- all.vars(parse(text=as.character(input$inBody)))
     vars <- as.list(vars)
     updateSelectInput(session = session, inputId = "inVar", choices = vars)
})

L'approche reactive avec selectInput:

outVar <- reactive({
    vars <- all.vars(parse(text=as.character(input$inBody)))
    vars <- as.list(vars)
    return(vars)
})

output$inVar2 <- renderUI({
    selectInput(inputId = "inVar2", label = h4("Select:"), choices =  outVar())
})

Edit: J'ai modifié ma question avec une explication basée sur les commentaires de Ramnath. Ramnath a expliqué le problème et fourni une meilleure solution, que je donne comme édition de ma question. Je vais garder cette réponse pour le compte rendu.

3
PatrickT

serveur.R

### This will create the dynamic dropdown list ###

output$carControls <- renderUI({
    selectInput("cars", "Choose cars", rownames(mtcars))
})


## End dynamic drop down list ###

## Display selected results ##

txt <- reactive({ input$cars })
output$selectedText <- renderText({  paste("you selected: ", txt() ,sep="") })


## End Display selected results ##

ui.R

uiOutput("carControls"),
  br(),
  textOutput("selectedText")
1
Ashish Markanday