闪亮:动态数据帧构造; renderUI,observe,reactiveValues

时间:2016-11-29 11:32:41

标签: r dataframe shiny

我认为如何使用Shiny的renderUI功能动态子集数据的问题经常出现,但我很难理解何时使用renderUI(使用uiOutput)而不是其他功能,包括observe,reactive,reactiveValues甚至conditionalPanel。

我想构建一个完全交互式的数据框,其中每个选项都会影响您在其他输入中可以选择的内容。对于此示例,我们将有一个selectInput(单个),selectInput(multi)和一个sliderInput(带有max& min)。

主要选择类别1可以是类别1中的任何值或“全部”。通过选择类别1中的某些内容,您可以反过来影响类别2中显示的内容以及滑块上的值范围。通过首先选择类别2,可以限制类别1的选项以及滑块中的值(总是表示子集的最大值和最小值)。通过从sliderInput开始,如果没有任何数据属于您所声明的范围,则类别1和类别2将受到限制。

N.B。我将合并一个'reset'actionButton来将数据帧重置为app初始化时的状态。

尝试使用一些虚拟数据,我还没有成功。这将按类别1进行子集并更新滑块,但更改类别2不会覆盖渲染表;

require(shiny)

    data <- data.frame(Category1 = rep(letters[1:3],each=15),
                       Info = paste("Text info",1:45),
                       Category2 = sample(letters[15:20],45,replace=T),
                       Size = sample(1:100, 45),
                       MoreStuff = paste("More Stuff",1:45))

ui <- fluidPage(

  titlePanel("Test Explorer"),

  sidebarLayout(
    sidebarPanel(
      uiOutput("category1"),
      uiOutput("category2"),
      uiOutput("sizeslider")
      ),
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output,session) {

  df_subset <- reactive({
    if(input$cat1=="All") {df_subset <- data}
    else{df_subset <- data[data$Category1==input$cat1,]}

  })

  df_subset1 <- reactive({
    if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Category2==input$cat2,]}
  })

  output$category1 <- renderUI({
    selectizeInput('cat1', 'Choose Cat 1', choices = c("All",sort(as.character(unique(data$Category1)))),selected = "All")
  })

  output$category2 <- renderUI({
    selectizeInput('cat2', 'Choose Cat 2 (optional):', choices = sort(as.character(unique(df_subset1()$Category2))), multiple = TRUE,options=NULL)
  })

  output$sizeslider <- renderUI({
    sliderInput("size", label = "Size Range", min=min(df_subset1()$Size), max=max(df_subset1()$Size), value = c(min(df_subset1()$Size),max(df_subset1()$Size)))
  })

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

}

shinyApp(ui, server)

1 个答案:

答案 0 :(得分:4)

然而,跟随发生的事情有点棘手,这就是你想要的吗?注意将reactive更改为eventReactive,因此它专门绑定到input。我还使用%in%运算符为您的selectizeInput

选择了多个

编辑:在您的第一个代码中,您甚至不使用滑块,我将其添加到过滤

#rm(list = ls())
library(shiny)

data <- data.frame(Category1 = rep(letters[1:3],each=15),
                   Info = paste("Text info",1:45),
                   Category2 = sample(letters[15:20],45,replace=T),
                   Size = sample(1:100, 45),
                   MoreStuff = paste("More Stuff",1:45))

ui <- fluidPage(

  titlePanel("Test Explorer"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("category1"),
      uiOutput("category2"),
      uiOutput("sizeslider")
    ),
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output,session) {

  output$category1 <- renderUI({
    selectizeInput('cat1', 'Choose Cat 1', choices = c("All",sort(as.character(unique(data$Category1)))),selected = "All")
  })

  df_subset <- eventReactive(input$cat1,{
    if(input$cat1=="All") {df_subset <- data}
    else{df_subset <- data[data$Category1 == input$cat1,]}
  })

  df_subset1 <- reactive({
    if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Category2 %in% input$cat2,]}
  })

  output$category2 <- renderUI({
    selectizeInput('cat2', 'Choose Cat 2 (optional):', choices = sort(as.character(unique(df_subset()$Category2))), multiple = TRUE,options=NULL)
  })

  output$sizeslider <- renderUI({
    sliderInput("size", label = "Size Range", min=min(df_subset1()$Size), max=max(df_subset1()$Size), value = c(min(df_subset1()$Size),max(df_subset1()$Size)))
  })

  df_subset2 <- reactive({
    if(is.null(input$size)){df_subset1()} else {df_subset1()[df_subset1()$Size >= input$size[1] & df_subset1()$Size <= input$size[2],]}
  })

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

shinyApp(ui, server)

enter image description here