根据初始选择生成 UI/Server

Question

下面是我为我创建的 Shiny 应用程序创建的脚本。我正在尝试创建一个登陆页面（我什至不知道这是否是正确的短语），允许您在您正在使用的数据集之间进行选择。您会注意到在脚本的开头，有 df 和 df2（它们都是相同的数据集，但无关紧要）。

我想做的可能是出现一个初始“页面”，让您可以选择 select 您正在处理的数据集。一旦 selected，它将带您进行设置，如下所示，但有一个明显的例外：如果 df2 是 selected，它将不包含 [=26] 的选项=]:

sliderInput("score2", label = h3("Select Score2 Range"), min = 0, max = 100, value = c(20,80))

但您可以从所有其他输入中进行选择。

我什至不确定从哪里开始，那么完成它的最佳方法是什么？

    library(dbplyr)
    library(dplyr)
    library(shiny)
    library(shinyWidgets)
    library(DT)
    
    df <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')
    df2 <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')
    
    ui <- fluidPage(
  titlePanel("Sample"),
  sidebarLayout(
    sidebarPanel(
      radioButtons("mydata", label = "Choose dataframe", choices = c("df","df2"), inline=TRUE),
      selectizeInput("data1", "Select State", choices = c(unique(df$state))),
      selectizeInput("data2", "Select County", choices = NULL),
      selectizeInput("data3", "Select City", multiple = TRUE, choices = NULL),
      selectizeInput("data4", "Select Demo", choices = c("All", unique(df$demo))),
      selectizeInput("data5", "Select Status", choices = c("All", unique(df$status))),
      sliderInput("age", label = h3("Select Age Range"), 18,
                  35, value = c(18, 20), round = TRUE, step = 1),
      sliderInput("score1", label = h3("Select Score1 Range"), min = 0,
                  max = 100, value = c(20,80)),
      conditionalPanel(condition = "input.mydata=='df'",
                       sliderInput("score2", label = h3("Select Score2 Range"), min = 0, max = 100, value = c(20,80))
      ),
      prettyCheckboxGroup("phones", h3("Only Include Valid Phone Numbers?"), selected = "Yes", choices = list("Yes")),
      downloadButton("download", "Download Data")
    ),
    mainPanel(
      DTOutput("table")
    )
  )
)

    server <- function(input, output, session){
  
  mydf <- reactive({get(input$mydata)})
  
  observeEvent(input$data1, {
    df <- mydf()
    #if (input$data1 != "All") {
    updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
    # } else {
    #   updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county)))
    # }
  }, priority = 2)
  
  observeEvent(c(input$data1, input$data2), {
    df <- mydf()
    if (input$data2 != "All") {
      updateSelectizeInput(session, "data3", "Select City", multiple = TRUE, server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
    } else {
      #if (input$data1 != "All") {
      updateSelectizeInput(session, "data3", "Select City", multiple = TRUE, server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
      # } else {
      #   updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city)))
      # }
    }
  }, priority = 1)
  
  filtered_data <- reactive({
    temp_data <- mydf()
    if (input$data1 != "All") {
      temp_data <- temp_data[temp_data$state == input$data1, ]
    }
    if (input$data2 != "All") {
      temp_data <- temp_data[temp_data$county == input$data2, ]
    }
    if (input$data3 != "All") {
      temp_data <- temp_data[temp_data$city %in% input$data3, ]
    }
    if (input$data4 != "All") {
      temp_data <- temp_data[temp_data$demo == input$data4, ]
    }
    if (input$data5 != "All") {
      temp_data <- temp_data[temp_data$status == input$data5, ]
    }
    
    df2 <- temp_data %>% dplyr::filter(age >= input$age[1] &
                                         age <= input$age[2] &
                                         score1 >= input$score1[1] &
                                         score1 <= input$score1[2])
    if (input$mydata=="df") df2 <- df2 %>% dplyr::filter(score2 >= input$score2[1] & score2 <= input$score2[2])
    
    df3 <- if (is.null(input$phones)) df2 else df2 %>%  dplyr::filter(!is.na(phone))
    df3 %>% dplyr::select(unique_id, first_name, last_name, phone)
  })
  
  output$table <- renderDT(
    filtered_data()
  )
  
  output$download <- downloadHandler(
    filename = function() {
      paste("universe", "_", date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(filtered_data() %>% distinct_all(), file, row.names = FALSE)
    }
  )
  
}
    
    shinyApp(ui, server)

Answer 1

试试这个

library(dbplyr)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(DT)

df <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')
df2 <- read.csv('https://raw.githubusercontent.com/datacfb123/testdata/main/sampleset_df.csv')
df2$unique_id <- df2$unique_id*2  ##  just to check if switching works

ui <- fluidPage(
  titlePanel("Sample"),
  sidebarLayout(
    sidebarPanel(
      radioButtons("mydata", label = "Choose dataframe", choices = c("df","df2"), inline=TRUE),
      selectizeInput("data1", "Select State", choices = c(unique(df$state))),
      selectizeInput("data2", "Select County", choices = NULL),
      selectizeInput("data3", "Select City", choices = NULL, multiple = TRUE),
      selectizeInput("data4", "Select Demo", choices = c("All", unique(df$demo))),
      selectizeInput("data5", "Select Status", choices = c("All", unique(df$status))),
      sliderInput("age", label = h3("Select Age Range"), 18,
                  35, value = c(18, 20), round = TRUE, step = 1),
      sliderInput("score1", label = h3("Select Score1 Range"), min = 0,
                  max = 100, value = c(20,80)),
      conditionalPanel(condition = "input.mydata=='df'",
                       sliderInput("score2", label = h3("Select Score2 Range"), min = 0, max = 100, value = c(20,80))
                       ),
      prettyCheckboxGroup("phones", h3("Only Include Valid Phone Numbers?"), selected = "Yes", choices = list("Yes")),
      downloadButton("download", "Download Data")
    ),
    mainPanel(
      DTOutput("table")
    )
  )
)

server <- function(input, output, session){
  
  mydf <- reactive({get(input$mydata)})
  
  observeEvent(input$data1, {
    df <- mydf()
    #if (input$data1 != "All") {
      updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
    # } else {
    #   updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county)))
    # }
  }, priority = 2)

  observeEvent(c(input$data1, input$data2), {
    req(mydf())
    df <- mydf()
    if (input$data2 != "All") {
      updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
    } else {
      #if (input$data1 != "All") {
        updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
      # } else {
      #   updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city)))
      # }
    }
  }, priority = 1)

  filtered_data <- reactive({
    req(input$data3)
    temp_data <- mydf()
    if (input$data1 != "All") {
      temp_data <- temp_data[temp_data$state == input$data1, ]
    }
    if (input$data2 != "All") {
      temp_data <- temp_data[temp_data$county == input$data2, ]
    }
    if (input$data3 != "All") {
      temp_data <- temp_data[temp_data$city %in% input$data3, ]
    }
    if (input$data4 != "All") {
      temp_data <- temp_data[temp_data$demo %in% input$data4, ]
    }
    if (input$data5 != "All") {
      temp_data <- temp_data[temp_data$status %in% input$data5, ]
    }

    df2 <- temp_data %>% dplyr::filter(age >= input$age[1] &
                                       age <= input$age[2] &
                                       score1 >= input$score1[1] &
                                       score1 <= input$score1[2])
    if (input$mydata=="df") df2 <- df2 %>% dplyr::filter(score2 >= input$score2[1] & score2 <= input$score2[2])

    df3 <- if (is.null(input$phones)) df2 else df2 %>%  dplyr::filter(!is.na(phone))
    df3 %>% dplyr::select(unique_id, first_name, last_name, phone)
  })

  output$table <- renderDT(
    filtered_data()
  )

  output$download <- downloadHandler(
    filename = function() {
      paste("universe", "_", date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(filtered_data() %>% distinct_all(), file, row.names = FALSE)
    }
  )

}

shinyApp(ui, server)

根据初始选择生成 UI/Server

Generating UI/Server based on initial selection

r

shiny

shiny-server

shinyapps

shiny-reactivity