使用plyr中的plyr动态显示数据

Question

例如，我将在ggplot2中使用内置的钻石数据。

我想要显示数据根据裁剪，颜色和清晰度。但是，我想通过扣减来选择项目。我希望在下拉菜单中选择可用的颜色，以此类推。

当您想要查看另一项时，下面的方法不会刷新。在使用plyr时，是否有更简单的方法来做到这一点呢？

钻石数据可能不是最好的例子，但我找不到任何其他数据。

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

Answer 1

对于某些下拉变量的更改，它不刷新的原因是没有设置反应性。

你有几个选择：

备选案文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中添加一个检查输入$削减。(您已经有了输入$color的is.null检查。)

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