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

用户界面

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 回答