EUROSTAT人口数据Shiny应用代码调试求助

一、核心问题排查与修复步骤 #

1. 数据下载与预处理修复 #

确保依赖包正确加载，数据提取和格式转换无错误：

# 安装首次运行所需包
# install.packages(c("eurostat", "shiny", "dplyr", "ggplot2", "tmap", "lubridate", "countrycode", "sf"))

library(eurostat)
library(shiny)
library(dplyr)
library(ggplot2)
library(tmap)
library(lubridate)
library(countrycode)
library(sf)

# 下载并清洗数据
data <- get_eurostat(id = "demomwk", time_format = "raw") %>%
  filter(!is.na(values)) %>%
  mutate(
    year = substr(time, 1, 4), # 提取年份
    week = substr(time, 6, 7), # 提取周数
    # 转换性别编码为可读标签
    sex = factor(sex, levels = c("F", "M", "T"), labels = c("Female", "Male", "Total")),
    # 转换欧盟国家代码为全称
    geo = factor(geo, labels = countrycode(geo, "eurostat", "country.name"))
  ) %>%
  filter(!is.na(geo)) # 移除无法匹配的无效国家代码

2. UI交互组件修复 #

完善输入控件逻辑，确保多选择、默认值设置合理：

ui <- fluidPage(
  titlePanel("EUROSTAT Weekly Population Data Dashboard"),
  sidebarLayout(
    sidebarPanel(
      # 多国家选择控件
      selectInput("countries", "选择国家", 
                  choices = sort(unique(data$geo)), 
                  multiple = TRUE,
                  selected = c("Germany", "France", "Italy")),
      # 年份选择（默认最新年份）
      selectInput("year", "选择年份",
                  choices = sort(unique(data$year), decreasing = TRUE),
                  selected = max(data$year)),
      # 性别选择控件
      selectInput("sex", "选择性别",
                  choices = unique(data$sex),
                  selected = "Total")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("数据表格", tableOutput("data_table")),
        tabPanel("欧洲地图", tmapOutput("map_plot")),
        tabPanel("时间序列", plotOutput("ts_plot"))
      )
    )
  )
)

3. 数据表格格式修复（指定分隔符） #

严格按照COUNTRY; SEX; WEEK; NUMBER;格式输出：

server <- function(input, output) {
  # 响应式过滤数据
  filtered_data <- reactive({
    req(input$countries, input$year, input$sex) # 确保输入有效
    data %>%
      filter(geo %in% input$countries,
             year == input$year,
             sex == input$sex) %>%
      rename(COUNTRY = geo, SEX = sex, WEEK = week, NUMBER = values) %>%
      select(COUNTRY, SEX, WEEK, NUMBER) %>%
      arrange(COUNTRY, WEEK)
  })
  
  # 输出带分号格式的表格
  output$data_table <- renderTable({
    filtered_data() %>%
      mutate(across(everything(), ~ paste0(.x, ";")))
  }, bordered = TRUE, spacing = "s")
}

4. 欧洲地图可视化修复 #

解决地图数据匹配问题，正确汇总国家人口总计：

# 地图可视化逻辑（嵌入server函数内）
output$map_plot <- renderTmap({
  # 获取欧洲地图空间数据
  map_data <- get_eurostat_geospatial(output_class = "sf", resolution = "60")
  
  # 按国家汇总人口数据
  aggregated_data <- filtered_data() %>%
    group_by(COUNTRY) %>%
    summarise(TOTAL = sum(NUMBER, na.rm = TRUE)) %>%
    left_join(map_data, by = c("COUNTRY" = "NAME_EN"))
  
  # 渲染地图
  tm_shape(map_data) +
    tm_polygons(col = "lightgray") +
    tm_shape(aggregated_data) +
    tm_polygons("TOTAL", title = "Total Population", palette = "YlOrRd", alpha = 0.7) +
    tm_layout(main.title = paste(input$year, input$sex, "Population Total"),
              legend.position = c("right", "bottom"))
})

5. 时间序列可视化修复 #

处理周数的时间排序问题，生成分国家的趋势线：

# 时间序列逻辑（嵌入server函数内）
output$ts_plot <- renderPlot({
  ts_data <- filtered_data() %>%
    mutate(
      week_num = as.integer(WEEK),
      # 将周数转换为可排序的日期格式
      date = ymd(paste0(input$year, "-W", week_num, "-1"))
    ) %>%
    arrange(date)
  
  ggplot(ts_data, aes(x = date, y = NUMBER, color = COUNTRY)) +
    geom_line(size = 1.2) +
    geom_point(size = 2) +
    labs(title = paste("Weekly Population Trend (", input$year, " - ", input$sex, ")", sep = ""),
         x = "Week", y = "Population Count") +
    theme_minimal() +
    theme(
      plot.title = element_text(size = 16, face = "bold"),
      axis.text.x = element_text(angle = 45, hjust = 1),
      legend.title = element_text(face = "bold")
    )
})

二、完整可运行代码 #

将上述模块整合后，完整代码如下：

# 安装首次运行所需包
# install.packages(c("eurostat", "shiny", "dplyr", "ggplot2", "tmap", "lubridate", "countrycode", "sf"))

library(eurostat)
library(shiny)
library(dplyr)
library(ggplot2)
library(tmap)
library(lubridate)
library(countrycode)
library(sf)

# 下载并预处理数据
data <- get_eurostat(id = "demomwk", time_format = "raw") %>%
  filter(!is.na(values)) %>%
  mutate(
    year = substr(time, 1, 4),
    week = substr(time, 6, 7),
    sex = factor(sex, levels = c("F", "M", "T"), labels = c("Female", "Male", "Total")),
    geo = factor(geo, labels = countrycode(geo, "eurostat", "country.name"))
  ) %>%
  filter(!is.na(geo))

# UI部分
ui <- fluidPage(
  titlePanel("EUROSTAT Weekly Population Data Dashboard"),
  sidebarLayout(
    sidebarPanel(
      selectInput("countries", "选择国家", 
                  choices = sort(unique(data$geo)), 
                  multiple = TRUE,
                  selected = c("Germany", "France", "Italy")),
      selectInput("year", "选择年份",
                  choices = sort(unique(data$year), decreasing = TRUE),
                  selected = max(data$year)),
      selectInput("sex", "选择性别",
                  choices = unique(data$sex),
                  selected = "Total")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("数据表格", tableOutput("data_table")),
        tabPanel("欧洲地图", tmapOutput("map_plot")),
        tabPanel("时间序列", plotOutput("ts_plot"))
      )
    )
  )
)

# Server部分
server <- function(input, output) {
  filtered_data <- reactive({
    req(input$countries, input$year, input$sex)
    data %>%
      filter(geo %in% input$countries,
             year == input$year,
             sex == input$sex) %>%
      rename(COUNTRY = geo, SEX = sex, WEEK = week, NUMBER = values) %>%
      select(COUNTRY, SEX, WEEK, NUMBER) %>%
      arrange(COUNTRY, WEEK)
  })
  
  # 数据表格输出
  output$data_table <- renderTable({
    filtered_data() %>%
      mutate(across(everything(), ~ paste0(.x, ";")))
  }, bordered = TRUE, spacing = "s")
  
  # 地图输出
  output$map_plot <- renderTmap({
    map_data <- get_eurostat_geospatial(output_class = "sf", resolution = "60")
    
    aggregated_data <- filtered_data() %>%
      group_by(COUNTRY) %>%
      summarise(TOTAL = sum(NUMBER, na.rm = TRUE)) %>%
      left_join(map_data, by = c("COUNTRY" = "NAME_EN"))
    
    tm_shape(map_data) +
      tm_polygons(col = "lightgray") +
      tm_shape(aggregated_data) +
      tm_polygons("TOTAL", title = "Total Population", palette = "YlOrRd", alpha = 0.7) +
      tm_layout(main.title = paste(input$year, input$sex, "Population Total"),
                legend.position = c("right", "bottom"))
  })
  
  # 时间序列输出
  output$ts_plot <- renderPlot({
    ts_data <- filtered_data() %>%
      mutate(
        week_num = as.integer(WEEK),
        date = ymd(paste0(input$year, "-W", week_num, "-1"))
      ) %>%
      arrange(date)
    
    ggplot(ts_data, aes(x = date, y = NUMBER, color = COUNTRY)) +
      geom_line(size = 1.2) +
      geom_point(size = 2) +
      labs(title = paste("Weekly Population Trend (", input$year, " - ", input$sex, ")", sep = ""),
           x = "Week", y = "Population Count") +
      theme_minimal() +
      theme(
        plot.title = element_text(size = 16, face = "bold"),
        axis.text.x = element_text(angle = 45, hjust = 1),
        legend.title = element_text(face = "bold")
      )
  })
}

# 运行应用
shinyApp(ui = ui, server = server)

三、关键修复说明 #

• 数据层面：修复了国家代码映射错误，移除无效数据，确保年份、周数提取准确。
• 交互层面：添加req()函数避免空输入报错，优化默认选择项提升用户体验。
• 格式层面：通过字段重命名和批量添加分号，严格匹配指定输出格式。
• 可视化层面：解决地图数据匹配问题，将周数转换为日期格式确保时间序列排序正确。

内容的提问来源于stack exchange，提问作者Marcela1717