web-dev-qa-db-ja.com

selectInputの選択肢に反応するR光沢のある受け渡し

光沢のあるアプリ(RStudioによる)のserver側には、textInputのコンテンツを解析して変数のリストを返すリアクティブがあります。変数のリストは、selectInputおよび/またはupdateSelectInputで使用されます。

私はそれを機能させることはできません。助言がありますか?

私は2回試みました。最初のアプローチは、リアクティブoutVarを直接selectInputに使用することです。 2番目のアプローチは、outVarでリアクティブupdateSelectInputを使用することです。どちらも動作しません。

server.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")
  )
)
_

少し前に、私はshiny-discussに同じ質問を投稿しましたが、あまり興味を引かなかったので、おwithび申し上げます https://groups.google.com/forum/#! topic/shiny-discuss/e0MgmMskfWo

編集1

@Ramnathは、Edit 2と表示されている、動作するように見えるソリューションを親切に投稿しました。しかし、その解決策は、textinputが私の問題のようにui側ではなくserver側にあるため、問題に対処しません。 Ramnathの2番目の編集のtextinputserver側に移動すると、問題が再び発生します。つまり、何も表示されず、RStudioがクラッシュします。 _input$text_を_as.character_でラップすると、問題が解消されることがわかりました。

Edit 2

さらなる議論の中で、Ramnathは、サーバーが引数がoutVarによって返される前に動的関数textinputを適用しようとすると問題が生じることを示しました。解決策は、最初にis.null(input$inBody)が存在するかどうかを確認することです。

引数の存在を確認することは、光沢のあるアプリを構築するための重要な側面です。まあ、私はやったが、私は何か間違ったことをしたに違いない!私が問題に費やした時間を考えると、それは苦い経験です。コードの後に​​、存在を確認する方法を示します。

以下は、textinputserver側に移動したRamnathのコードです。 RStudioがクラッシュするため、自宅で試さないでください。 (私は彼の表記法を使用しました)

_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())
    })
  }
))
_

私が通常存在を確認する方法は次のとおりです。

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

Ramnathのコードは短くなっています。

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

どちらも機能しているように見えますが、今後はRamnathのやり方でやっていきます。コンストラクトの不均衡なブラケットがチェックを機能させることを以前に妨げていたのでしょうか? Ramnathのチェックはより直接的です。

最後に、デバッグのさまざまな試みに関するいくつかの点に注意したいと思います。

デバッグクエストで、サーバー側に「出力」の優先順位を「ランク付け」するオプションがあることを発見しました。これは、問題を解決するために検討しましたが、問題が他の場所にあったため機能しませんでした。それでも、知るのは面白いですし、現時点ではあまり知られていないようです:

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

そのクエストでは、私も試したtry

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

それはかなり近かったが、それでも修正しなかった。

私がつまずいた最初の解決策は:

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

私はそれがなぜ機能したのかを知ることは興味深いと思います:それは物事を十分に遅くするからですか? _as.character_がnull以外になるのを_input$text_が「待機」しているからですか?

いずれにしても、私はRamnathの努力、忍耐、指導に非常に感謝しています。

57
PatrickT

動的UIの場合、サーバー側でrenderUIを使用する必要があります。最小限の例を次に示します。 2番目のドロップダウンメニューはリアクティブであり、最初のドロップダウンメニューで選択したデータセットに調整されることに注意してください。以前にピカピカに対処したことがある場合、コードは一目瞭然です。

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

編集。 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:parseを使用した変更例。このアプリでは、入力したテキスト式を使用して、下のドロップダウンメニューに変数のリストを動的に入力します。

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

私が知る限り、問題は、character関数にselectInputの値、つまりinput$inBodyが指定されていても、value = "a+b+c"characterを取得しないことです。したがって、解決策はinput$inBodyas.characterでラップすることです

次の作品:

observeを使用したupdateSelectInputアプローチ:

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

reactiveを使用した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())
})

編集:私はRamnathのフィードバックに基づいた説明で質問を編集しました。 Ramnathが問題を説明し、より良い解決策を提供してくれました。これを質問の編集として提供します。この回答は記録に残しておきます。

3
PatrickT

server.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