闪亮的多重动态子集

Question

我正在尝试在 Shiny 中制作一个应用程序，该应用程序通过用户输入动态地对数据集进行 3 次子集化。 让我们假设数据集是

Number<- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140)
Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b')
Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g')
Index<-c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14')
df <- data.frame(Number, Att1 , Att2,Index)

我想要做的是创建一个下拉菜单，为您提供来自 att1 的选项 a 或 b，然后该选项与第二个下拉菜单做出反应，其中显示 att2 的选项，但对选项 att1 进行子集化。根据用户的选择，最后一个下拉菜单将为他提供选择哪个索引的选项。现在，在选择索引后，数据帧必须仅返回索引指示的数字，并且该数字将在后续步骤中使用。

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("App"),

  sidebarLayout(
    sidebarPanel(
      selectInput("Att1", "Choose Att1",choices= c(as.character(unique(df$Att1))  )),
      uiOutput("c")),
    # Show a plot of the generated distribution
    mainPanel( DT::dataTableOutput("table")

    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  Number<- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140)
  Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b')
  Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g')
  Index<-c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14')
  df <- data.frame(Number, Att1 , Att2,Index)


  selectedData <- reactive({
    Ddata<-subset(df,Att1==input$Att1)
  })

  output$c<-renderUI({selectInput("Att2", "Choose Att2",choices= c(as.character(unique(selectedData()$Att2)) ))})
  selectedData2 <- reactive({
    Vdata<-subset(selectedData(),Att2==input$c)
    Vdata<-as.data.frame(Vdata)
    Vdata
  })

  output$table <- DT::renderDataTable({
    head(selectedData2(), n = 10)
  })



}

# Run the application 
shinyApp(ui = ui, server = server)

这是我目前为止的结果，但问题是如何在反应式表达式中第二次使用反应式数据集，并且前 2 个属性的输出为空。我试图解决这个问题好几天，有什么想法吗？

Answer 1

有一个特定的闪亮函数来更新SelectInput 的内容：updateSelectInput()。

如果在 observe 中使用，它可以完全用于您想要做的事情：

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

    observe({
        input$Att1

        x <- df[df$Att1 == input$Att1, 'Att2']
        xs <- as.character(unique(x))
        updateSelectInput(session, 'Att2', choices = xs)
    })

    selectedData <- reactive({
        df[df$Att2 == input$Att2, ]
    })

    output$table <- DT::renderDataTable({
        head(selectedData(), n = 10)
    })       

}

为了完整性，这里是ui

ui <- fluidPage(

    # Application title
    titlePanel("App"),

    sidebarLayout(
        sidebarPanel(
            selectInput("Att1", "Choose Att1",choices = as.character(unique(df$Att1))  ),
            selectInput("Att2", "Choose Att2",choices = NULL, selected = 1)
            ),
        # Show a plot of the generated distribution
        mainPanel( DT::dataTableOutput("table")

        )
    )
)

Answer 2

继续您所拥有的...我将"NULL" 添加为下拉列表的选项，如果选择"NULL"，则保留完整的数据集。

Number <- c(10, 20, 30 , 40, 50 ,60, 70, 80, 90,100,110,120,130,140)
Att1 <- c('a','a','a','a','a','a','a','b','b','b','b','b','b','b')
Att2 <- c('c','c','c','d','d','d','d','e','e','e','g','g','g','g')
Index <- c('I1','I2','I3','I4', 'I5','I6','I7','I8','I9','I10', 'I11','I12','I13','I14')
df <- data.frame(Number, Att1, Att2, Index)

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("App"),

  sidebarLayout(
    sidebarPanel(
      selectInput("Att1", "Choose Att1", choices = c("NULL", as.character(unique(df$Att1))), selected = "NULL"),
      uiOutput("c"),
      uiOutput("d")),
    # Show a plot of the generated distribution
    mainPanel( DT::dataTableOutput("table")

    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  selectedData <- reactive({
    if(input$Att1 == "NULL") Ddata <- df  #Keep full data set if NULL
    else Ddata <- subset(df, Att1 == input$Att1)

    Ddata
  })

######################
  output$c <- renderUI({selectInput("Att2", "Choose Att2", choices = c("NULL", as.character(unique(selectedData()$Att2))), selected = "NULL")})

  selectedData2 <- reactive({
    if(input$Att2 == "NULL") Vdata <- selectedData()
    else Vdata <- subset(selectedData(), Att2 == input$Att2)

    Vdata
  })
######################

#=====================
  output$d <- renderUI({selectInput("Index", "Choose Index", choices = c("NULL", as.character(unique(selectedData2()$Index))), selected = "NULL")})

  selectedData3 <- reactive({
    if(input$Index == "NULL") Fdata <- selectedData2()
    else Fdata <- subset(selectedData2(), Index == input$Index)

    Fdata
  })
#=====================

  output$table <- DT::renderDataTable({
    head(selectedData3(), n = 10)
  })
}

# Run the application 
runApp(shinyApp(ui = ui, 
         server = server), launch.browser=TRUE
)