1

例として、ggplot2 に組み込まれているダイヤモンド データを使用します。

カット、色、透明度に応じてデータフレームを表示したい。ただし、控除で項目を選択したかったのです。ドロップダウンメニューで利用可能な色などを明確に選択したいと思います。

以下のメソッドは、別のアイテムを見たいときに更新されません。plyrを使用して光沢のあるこれを行う簡単な方法はありますか?

ダイヤモンドのデータフレームは最良の例ではないかもしれませんが、他のデータは見つかりません。

サーバー.R

library(plyr)

dm<-dlply(diamonds, .(cut))

for(x in 1:length(dm)){
   assign(eval(parse(text = paste("names(dm)[x]"))),dm[[x]])
}

shinyServer(function(input, output) {
   output$choose_cut <- renderUI({
      selectInput("cut", "Cut", as.list(names(dm), multiple = TRUE))
    })

   output$choose_color <- renderUI({
      if(is.null(input$cut)) return()
      dat <- get(input$cut)
      dm2<-dlply(dat, .(color))
      for(x in 1:length(dm2)){
         assign(eval(parse(text = paste("names(dm2)[x]"))),dm2[[x]], envir = globalenv()
       )}

    selectInput("color", "Color", as.list(names(dm2)))})

    output$choose_clarity <- renderUI({
    if(is.null(input$color)) return()
    dat <- get(input$color)
    dm3<-dlply(dat, .(clarity))
    for(x in 1:length(dm3)){
       assign(eval(parse(text = paste("names(dm3)[x]"))),dm3[[x]], envir = globalenv())
    }

    selectInput("clarity", "Clarity", as.list(names(dm3)))
   })

    output$table <- renderTable({
       if (is.null(input$clarity)) return()
       dat <- get(input$clarity)
       dat
    })                  
})

ui.R

shinyUI(pageWithSidebar(
headerPanel(""),

    sidebarPanel(
      uiOutput("choose_cut"),
      uiOutput("choose_color"),
      uiOutput("choose_clarity"),
  br()
),

mainPanel(
  "Data", tableOutput("table"))))
4

1 に答える 1

3

特定のドロップダウン変数の変更に対して更新されない理由は、反応性が設定されていないためです。

いくつかのオプションがあります。

オプション 1: 明示的に反応性を誘導する

output$table書かれているように、にのみ依存することに注意してくださいinput$clarity.。いくつかの行を追加することにより、他の変数の反応性をもたらすことができます。

 output$table <- renderTable({
    if (is.null(input$clarity)) return()
    if (is.null(input$color)) return()
    if (is.null(input$cut)) return()
    dat <- get(input$clarity)
    dat
  })

同様にchoose_clarity、input$cut のチェックを追加します。is.null( input$colorのチェックは既にあります。)

 output$choose_clarity <- renderUI({
    if (is.null(input$cut)) return()
    if (is.null(input$color)) return()
    ...

これは私がそれをテストしたときにそれをしました。

オプション 2: リアクティブ関数を使用する

server.R に追加

  subsetData <- reactive({
    # I use subset() here, but you can use ddply() to split the data frame
    subset(diamonds, cut==input$cut & color==input$color & clarity==input$clarity)    
  })

残りはそのままにして、output$table でリアクティブ関数を呼び出すだけです。

  output$table <- renderTable({
    subsetData()
  })

UI.R は変更されていません。完全な Server.R は次のとおりです。

変更された Server.R

library(plyr)
library(ggplot2)

dm<-dlply(diamonds, .(cut))

for(x in 1:length(dm)){
  assign(eval(parse(text = paste("names(dm)[x]"))),dm[[x]])
}

shinyServer(function(input, output) {
  
  
  subsetData <- reactive({
    subset(diamonds, cut==input$cut & color==input$color & clarity==input$clarity)    
  })
  
  
  output$choose_cut <- renderUI({
    selectInput("cut", "Cut", as.list(names(dm), multiple = TRUE))
  })
  
  output$choose_color <- renderUI({
    if(is.null(input$cut)) return()
    dat <- get(input$cut)
    dm2<-dlply(dat, .(color))
    for(x in 1:length(dm2)){
      assign(eval(parse(text = paste("names(dm2)[x]"))),dm2[[x]], envir = globalenv()
      )}
    
    selectInput("color", "Color", as.list(names(dm2)))})
  
  output$choose_clarity <- renderUI({
    if (is.null(input$cut)) return()
    if (is.null(input$color)) return()
    dat <- get(input$color)
    dm3<-dlply(dat, .(clarity))
    for(x in 1:length(dm3)){
      assign(eval(parse(text = paste("names(dm3)[x]"))),dm3[[x]], envir = globalenv())
    }
    
    selectInput("clarity", "Clarity", as.list(names(dm3)))
  })
  
  output$table <- renderTable({
    if (is.null(input$clarity)) return()
    if (is.null(input$color)) return()
    if (is.null(input$cut)) return()
    dat <- get(input$clarity)
    dat
#    subsetData()
  })                  
})
于 2013-09-18T04:04:53.413 に答える