我创建了一个 .Rmd 文件,其中包含一个闪亮的应用程序块。在我的示例设置中,有两个菜单:
对于两项温室气体(“温室气体总量”和“人均温室气体”),只有 2018-2020 年的数据。对于其他两个类别,有所有年份的数据。
我需要相应更新菜单:
在我的.Rmd中:
在.R:
.Rmd代码:
---
title: "Climate Vulnerability and Readiness"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
editor_options:
markdown:
wrap: 72
---
# Introduction {.tabset}
<div class="justified-text">
texttexttext</div>
# Analysis {.tabset}
library(shiny)
library(googleVis)
library(dplyr)
library(DT)
library(shinyWidgets)
# Load your data
ghg_stack <- ghg <- data.frame(
ISO3 = rep(c("USA", "CAN", "MEX", "BRA", "IND"), each = 5),
Name = rep(c("United States", "Canada", "Mexico", "Brazil", "India"), each = 5),
year = rep(2018:2022, times = 5),
ghg_per_capita_rank = c(1, 2, 3, NA, NA, 4, 3, 2, NA, NA, 5, 4, 1, NA, NA, 3, 5, 4, NA, NA, 2, 1, 5, NA, NA),
share_of_temperature_change_from_ghg_rank = c(2, 3, 1, 4, 5, 3, 2, 5, 4, 1, 5, 4, 3, 1, 2, 4, 5, 2, 1, 3, 1, 2, 4, 5, 3),
temperature_change_from_ghg_rank = c(3, 1, 5, 2, 4, 2, 5, 4, 3, 1, 4, 3, 2, 5, 1, 5, 4, 1, 2, 3, 1, 3, 4, 2, 5),
total_ghg_rank = c(2, 3, 4, NA, NA, 5, 4, 1, NA, NA, 3, 5, 2, NA, NA, 1, 2, 3, NA, NA, 4, 1, 5, NA, NA)
)
# Define UI for the map and table
ui <- fluidPage(
titlePanel(div(span("Country Rankings"), style={'padding-top: 15px'})),
tabPanel("GHG Emissions Map",
sidebarLayout(
sidebarPanel(
selectInput("ghg_year", "Select Year", choices = 2018:2022, selected = 2020),
selectInput("ghg_category", "Select GHG Metric",
choices = list(
"GHG Per Capita" = "ghg_per_capita",
"Share of Temperature Change from GHG" = "share_of_temperature_change_from_ghg",
"Temperature Change from GHG" = "temperature_change_from_ghg",
"Total GHG" = "total_ghg"
))
),
mainPanel(
tags$div(class="color-scale-label", "Highest to Lowest Emissions"),
htmlOutput("ghg_map")
)
)
)
)
# Define server logic for the map and table
server <- function(input, output) {
# Watch for changes in the year and dynamically update the available categories
observeEvent(input$ghg_year, {
if (input$ghg_year %in% c(2021, 2022)) {
# Restrict categories if the year is 2021 or 2022
updateSelectInput(session, "ghg_category",
choices = list(
"Share of Temperature Change from GHG" = "share_of_temperature_change_from_ghg",
"Temperature Change from GHG" = "temperature_change_from_ghg"
), selected = "share_of_temperature_change_from_ghg")
} else {
# Restore all categories for other years
updateSelectInput(session, "ghg_category",
choices = list(
"GHG Per Capita" = "ghg_per_capita",
"Share of Temperature Change from GHG" = "share_of_temperature_change_from_ghg",
"Temperature Change from GHG" = "temperature_change_from_ghg",
"Total GHG" = "total_ghg"
), selected = "ghg_per_capita")
}
})
# Watch for changes in the category and dynamically update the available years
observeEvent(input$ghg_category, {
if (input$ghg_category %in% c("ghg_per_capita", "total_ghg")) {
# Restrict years if the selected category is GHG Per Capita or Total GHG
restricted_years <- 2018:2020 # Exclude 2021 and 2022
updateSelectInput(session, "ghg_year", choices = restricted_years, selected = 2020)
} else {
# Restore all years if other categories are selected
available_years <- 2018:2022
updateSelectInput(session, "ghg_year", choices = available_years, selected = 2020)
}
})
output$ghg_map <- renderGvis({
ghg_year <- input$ghg_year
ghg_category <- input$ghg_category
req(input$ghg_year)
# Append "_rank" to the selected GHG metric to get the ranking column
rank_column <- paste0(ghg_category, "_rank")
# Filter and prepare the data for the selected year and rank column
ghg_map_data <- ghg %>%
filter(year == ghg_year) %>%
select(ISO3, Name, Rank = all_of(rank_column)) %>%
mutate(Location = ifelse(Name %in% c("Congo (Brazzaville)", "Congo (Kinshasa)", "South Sudan"), ISO3, Name)) %>%
mutate(Rank.tooltip = ifelse(is.na(Rank), "Rank: Insufficient data", paste("Rank: <b>", Rank, "<b>"))) %>%
mutate(Tooltip.header = Name)
# Check if there are any non-NA values in the Rank column
if (all(is.na(ghg_map_data$Rank))) {
return(NULL) # If all values are NA, do not render the map
}
# Determine the range of the Rank values
min_rank <- min(ghg_map_data$Rank, na.rm = TRUE)
max_rank <- max(ghg_map_data$Rank, na.rm = TRUE)
# Create the map
gvisGeoChart(ghg_map_data, locationvar = "Location", colorvar = "Rank",
hovervar = "Tooltip.header",
options = list(colorAxis = paste0("{minValue:", min_rank, ", maxValue:", max_rank, ", colors:['#E60000', '#FFFF00', '#009933']}"),
backgroundColor = '#81d4fa', datalessRegionColor = '#f5f5f5',
defaultColor = '#f5f5f5',
tooltip = "{isHtml: true}",
width = "100%",
height = "400px"))
})
}
shinyApp(ui = ui, server = server)
server <- function(input, output, session)
而我只有:
server <- function(input, output)