observeevent 不在 .Rmd 中工作,但在 .R

问题描述 投票:0回答:1

我创建了一个 .Rmd 文件,其中包含一个闪亮的应用程序块。在我的示例设置中,有两个菜单:

  • 年份菜单:选择2018-2022年的年份,
  • 类别菜单:选择四个类别之一。

对于两项温室气体(“温室气体总量”和“人均温室气体”),只有 2018-2020 年的数据。对于其他两个类别,有所有年份的数据。

我需要相应更新菜单:

  • 年份菜单应仅在选择“温室气体总量”或“人均温室气体”类别时显示 2018-2020 年 - 否则应显示所有年份
  • 选择 2021-2022 年时,类别菜单不应显示“温室气体总量”和“人均温室气体”类别 - 否则应显示所有类别
当我的代码只是 .R 文件中的应用程序时,它可以完美运行,但是当我将下面的完整代码包含在 .Rmd 文件中时,菜单不会更新。我可以进行哪些更改以使observeevent在.Rmd中工作?

在我的.Rmd中:

enter image description here

在.R:

enter image description here

.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)
    
shiny menu r-markdown
1个回答
0
投票
您需要服务器中的会话才能使observeEvent正常工作:

server <- function(input, output, session)
而我只有:

server <- function(input, output)
    
© www.soinside.com 2019 - 2024. All rights reserved.