在闪亮中使用 plyr 动态显示数据框

Question

作为示例，我将使用 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"))))

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 类似，添加对 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()
  })                  
})