首页 > 解决方案 > R shiny 3 selectInput 与“All”选项同时添加反应性

问题描述

我很难理解 R Shiny 中的反应性概念。我使用如下合成数据复制了该应用程序。

如您所见,我最终使用了 3 个带有“All”选项的 selectInputs ......但不确定这是否是正确的方法。

我的问题是,每次更改输入时(在任何一个菜单上),都会生成一个全新的输出。但我需要在这里利用反应性的概念......

我只想在变量“类型”发生更改时生成一个新的输出(新地图),并且只想在输出地图保持不变的情况下使用其他两个下拉菜单过滤数据。

我不知道如何在保持“全部”选项可行的同时重新安排代码。请帮我!任何帮助将不胜感激!

library(shiny)
library(dplyr)
library(leaflet)
library(ggplot2)
library(htmltools)


# Load the Data
schools <- read.csv("https://raw.githubusercontent.com/yunique1020/synthetic_data/main/syntheticdata.csv")

# Data Pre-processing
sapply(schools, function(x) length(unique(x)))

names(schools) <- make.names(c("id", "number", "name", "street", "suburb", "postcode", "type", "year", 
                                 "sector", "latitude", "longitude"))

hist_type <- schools %>%
    ggplot(aes(x=type)) +
    geom_bar()
hist_type

hist_sector <- schools %>%
    ggplot(aes(x=sector)) +
    geom_bar()
hist_sector

hist_year <- schools %>%
    ggplot(aes(x=year)) +
    geom_bar()
hist_year

count(schools, type)
count(schools, year)

# Replace missing values to category 'Other' in year column
schools$year <- replace(schools$year, schools$year == "", "Other")




# Define UI for application
ui <- fluidPage(
    
    # Application title
    titlePanel("Schools Data Explorer"),
    
    tabsetPanel(
        tabPanel("Task 1 — schools",  p(),
                 
                 sidebarLayout(
                     sidebarPanel(
                         selectInput("type", "Type of Schooling : ",
                                     c("All", schools$type)),
                         selectInput("sector", "Sector: ", choices = c("All", schools$sector)),
                         selectInput("year", "Year Levels: ", choices = c("Any", schools$year))
                         
                     ),
                     
                     mainPanel(
                         leafletOutput("schoolMap")
                     )
                 )
                 
        )
                 
    )
)

# Define server logic
server <- function(input, output) {

    
    # Create a vector of icons to use Font Awesome ‘hospital-o’ icon
    HospitalIcons <- awesomeIconList(
        Public = makeAwesomeIcon(icon = 'hospital-o', markerColor = 'green', iconColor = 'white', library = "fa"),
        Private = makeAwesomeIcon(icon = 'hospital-o', markerColor = 'orange', iconColor = 'white', library = "fa")
    )
    
    # Create a function called map for repeated steps
    map <- function(x){
        m <- leaflet(x) %>%
            addTiles() %>%
            addAwesomeMarkers(lng = x$longitude, lat = x$latitude,
                              icon = ~HospitalIcons[x$sector],
                              label = ~htmlEscape(x$name),
                              popup = paste0("School: ", x$name, "<br>",
                                             "Address: ", x$street, " ", x$suburb))
        return(m)
    } 
    
    output$schoolMap <- renderLeaflet({
        if (input$type == "All" & input$sector == "All" & input$year == "Any"){
            map(schools)
        } else if (input$type == "All" & input$year == "Any") {
            all_types_any_year <- schools %>% filter(sector == input$sector)
            map(all_types_any_year)
        } else if (input$type == "All" & input$sector == "All") {
            all_types_all_sectors <- schools %>% filter(year == input$year)
            map(all_types_all_sectors)
        } else if (input$sector == "All" & input$year == "Any") {
            all_sectors_any_year <- schools %>% filter(type == input$type)
            map(all_sectors_any_year)
        } else if (input$type == "All"){
            all_types <- schools %>% filter(sector == input$sector & year == input$year)
            map(all_types)
        } else if (input$sector == "All") {
            all_sectors <- schools %>% filter(type == input$type & year == input$year)
            map(all_sectors)
        } else if (input$year == "Any") {
            any_year <- schools %>% filter(type == input$type & sector == input$sector)
            map(any_year)
        }
        else {
            filteredData <- schools %>% filter(type == input$type & sector == input$sector & year == input$year)
            map(filteredData)
        }
    }) 
        
}


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

标签: rshinyleafletshiny-reactivityselectinput

解决方案


我不完全清楚你在这里的意思。如果部门或年份发生变化,则数据集会被相应地过滤,然后在过滤后的数据上生成地图,对吗?这意味着每次任何输入更改时都需要重新生成地图。如果行业或年份发生变化,您如何设想地图保持不变?

顺便说一句,您可以按如下方式重构您的 renderLeaflet:

typeFilter <- ifelse(input$type %in% "All", unique(schools$type), input$type)
sectorFilter <- ifelse(input$sector %in% "All", unique(schools$sector), input$sector)
yearFilter <- ifelse(input$year %in% "Any", unique(schools$year), input$year)

filteredData <- schools %>% filter(type %in% input$type & sector %in% input$sector & year %in% input$year)
map(filteredData)

推荐阅读