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)

这是我得到的地方，但问题是如何在反应式表达式中第二次使用反应数据集，并且前两个属性的输出也为空。我想解决这个问题几天，有什么想法吗？

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
)

闪亮的多重动态子集

2 个答案: