2026 Kyoto University summer camp
Nature Huang
2026-08-05
Clean Data from e-Stat
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.5.2# 1. 讀取資料
# e-Stat 的檔案有時會有 BOM 編碼問題，而且前 8 行是說明，我們跳過它們 (skip = 8)
df_raw <- read.csv("C:/Users/user/Downloads/FEI_PREF_260806025740.csv", skip = 8, fileEncoding = "UTF-8-BOM", stringsAsFactors = FALSE)
# 2. 資料清理
# 透過欄位索引提取我們需要的資料：第 2 欄是年份，第 6、8、10 欄對應幼年、成年、老年人口
df_clean <- df_raw[, c(2, 6, 8, 10)]
colnames(df_clean) <- c("Year", "Child", "Adult", "Elderly")
# 移除年份中的「年度」文字並轉為數字
df_clean$Year <- as.numeric(gsub("年度", "", df_clean$Year))
# 移除數字中的千分位逗號 (,) 並轉為數值
df_clean$Child <- as.numeric(gsub(",", "", df_clean$Child))
df_clean$Adult <- as.numeric(gsub(",", "", df_clean$Adult))
df_clean$Elderly <- as.numeric(gsub(",", "", df_clean$Elderly))
# 只篩選出你們小組報告需要的近十年資料 (2014 ~ 2024)
df_clean <- df_clean[df_clean$Year >= 2014 & df_clean$Year <= 2024, ]
# 3. 計算人口比例 (%)
df_clean$Total <- df_clean$Child + df_clean$Adult + df_clean$Elderly
df_clean$Child_Pct <- (df_clean$Child / df_clean$Total) * 100
df_clean$Adult_Pct <- (df_clean$Adult / df_clean$Total) * 100
df_clean$Elderly_Pct <- (df_clean$Elderly / df_clean$Total) * 100
# 看看處理好的漂漂亮亮的數據！
print(df_clean)## Year Child Adult Elderly Total Child_Pct Adult_Pct Elderly_Pct
## 1 2024 266000 1502000 752000 2520000 10.55556 59.60317 29.84127
## 2 2023 275000 1507000 753000 2535000 10.84813 59.44773 29.70414
## 3 2022 282000 1512000 755000 2549000 11.06316 59.31738 29.61946
## 4 2021 289000 1515000 758000 2562000 11.28025 59.13349 29.58626
## 5 2020 293465 1467216 734493 2495174 11.76130 58.80215 29.43654
## 6 2019 299000 1531000 753000 2583000 11.57569 59.27216 29.15215
## 7 2018 304000 1539000 749000 2592000 11.72840 59.37500 28.89660
## 8 2017 308000 1548000 743000 2599000 11.85071 59.56137 28.58792
## 9 2016 312000 1560000 733000 2605000 11.97697 59.88484 28.13820
## 10 2015 313866 1539540 703419 2556825 12.27562 60.21296 27.51143
## 11 2014 322000 1586000 701000 2609000 12.34189 60.78957 26.86853Plots for before & after COVID
library(ggplot2)
# 繪製高質感折線圖
p <- ggplot(df_clean, aes(x = Year)) +
# 幼年人口線條與節點 (藍色系)
geom_line(aes(y = Child_Pct, color = "Child (0-14)"), linewidth = 1.2) +
geom_point(aes(y = Child_Pct, color = "Child (0-14)"), size = 3) +
# 成年人口線條與節點 (橘黃色系)
geom_line(aes(y = Adult_Pct, color = "Adult (15-64)"), linewidth = 1.2) +
geom_point(aes(y = Adult_Pct, color = "Adult (15-64)"), size = 3) +
# 老年人口線條與節點 (紅色系，強調高齡化)
geom_line(aes(y = Elderly_Pct, color = "Elderly (65+)"), linewidth = 1.2) +
geom_point(aes(y = Elderly_Pct, color = "Elderly (65+)"), size = 3) +
# 設定專業的商業簡報配色
scale_color_manual(name = "Compartment (Age Group)",
values = c("Child (0-14)" = "#4E79A7",
"Adult (15-64)" = "#F28E2B",
"Elderly (65+)" = "#E15759")) +
# 設定 X 軸精確顯示每一年
scale_x_continuous(breaks = 2014:2024) +
# 使用極簡專業主題
theme_minimal(base_size = 14) +
# 加上英文標題與標籤 (可以直接放進你們的簡報)
labs(title = "Kyoto Prefecture Demographic Shift (2014-2024)",
subtitle = "Elderly population steadily rising while child population declines",
x = "Year",
y = "Percentage of Total Population (%)") +
# 調整字體、標題置中與圖例位置
theme(plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray40"),
legend.position = "bottom",
legend.title = element_text(face = "bold"),
panel.grid.minor = element_blank())
# 在 RStudio 中顯示圖表
print(p)
# 自動存成高解析度圖片到你的下載資料夾！
ggsave("C:/Users/user/Downloads/Kyoto_Demographics_Chart.png", plot = p, width = 10, height = 6, dpi = 300)
# 直接篩選出 2019 (疫情前) 與 2024 (疫情後) 來比較
covid_comparison <- df_clean %>% filter(Year %in% c(2019, 2024))
print(covid_comparison)## Year Child Adult Elderly Total Child_Pct Adult_Pct Elderly_Pct
## 1 2024 266000 1502000 752000 2520000 10.55556 59.60317 29.84127
## 2 2019 299000 1531000 753000 2583000 11.57569 59.27216 29.15215library(ggplot2)
library(ggplot2)
# 繪製高質感對比折線圖 (加入 COVID-19 透明色塊)
p <- ggplot(df_clean, aes(x = Year)) +
# 1. 加入透明色塊標示 COVID 疫情與疫後時期 (2020~2024)
# alpha = 0.15 代表透明度，放在最前面才不會蓋住後面的折線
annotate("rect", xmin = 2020, xmax = 2024, ymin = -Inf, ymax = Inf,
fill = "#333333", alpha = 0.15) +
# 保留 2020 年的爆發虛線，並加上文字標示
geom_vline(xintercept = 2020, linetype = "dashed", color = "#555555", linewidth = 1) +
annotate("text", x = 2022, y = 45, label = "COVID-19 Era",
color = "#555555", fontface = "bold", size = 5) +
# 2. 幼年人口線條與節點
geom_line(aes(y = Child_Pct, color = "Child (0-14)"), linewidth = 1.2) +
geom_point(aes(y = Child_Pct, color = "Child (0-14)"), size = 3) +
# 3. 成年人口線條與節點
geom_line(aes(y = Adult_Pct, color = "Adult (15-64)"), linewidth = 1.2) +
geom_point(aes(y = Adult_Pct, color = "Adult (15-64)"), size = 3) +
# 4. 老年人口線條與節點
geom_line(aes(y = Elderly_Pct, color = "Elderly (65+)"), linewidth = 1.2) +
geom_point(aes(y = Elderly_Pct, color = "Elderly (65+)"), size = 3) +
# 5. 配色與 X 軸設定
scale_color_manual(name = "Compartment (Age Group)",
values = c("Child (0-14)" = "#4E79A7",
"Adult (15-64)" = "#F28E2B",
"Elderly (65+)" = "#E15759")) +
scale_x_continuous(breaks = 2014:2024) +
# 6. 極簡專業主題與標題
theme_minimal(base_size = 14) +
labs(title = "Kyoto Prefecture Demographic Shift (2014-2024)",
subtitle = "Population structure comparison: Before vs. After COVID-19",
x = "Year",
y = "Percentage of Total Population (%)") +
# 7. 細節微調
theme(plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray40"),
legend.position = "bottom",
legend.title = element_text(face = "bold"),
panel.grid.minor = element_blank())
# 顯示圖表
print(p)
# 自動存成高解析度圖片！
ggsave("C:/Users/user/Downloads/Kyoto_Demographics_Shaded.png", plot = p, width = 10, height = 6, dpi = 300)#next work: ## 1.combine Heo san data for 52 週定點報告數據(?) ## 2.比例推算年齡分層(waiting for 高森san) vs.real data (?)
3. just try try 如果需要年齡分層，直接用比例推算 ?！(例如推算流感的 Child 病例)假設比例：Child adult elder 佔 % (wating for 高森san & 肖)
library(readxl)
library(dplyr)
library(ggplot2)
# --- 第一階段：自動讀取 52 週的 Excel 檔案 ---
file_path <- "C:/Users/user/Downloads/Syu_08_2.xlsx"
all_sheets <- excel_sheets(file_path)
week_sheets <- all_sheets[grepl("週", all_sheets)]
flu_cases_kyoto <- numeric(length(week_sheets))
weeks_num <- 1:length(week_sheets)
for (i in seq_along(week_sheets)) {
df_temp <- read_excel(file_path, sheet = week_sheets[i], skip = 4, col_names = FALSE)
# 修正 1：在第 1 欄尋找「京都」
kyoto_row <- df_temp[grep("京都", df_temp[[1]]), ]
if (nrow(kyoto_row) > 0) {
# 修正 2：在第 2 欄抓取「流感總數」
val <- suppressWarnings(as.numeric(kyoto_row[[2]]))
flu_cases_kyoto[i] <- ifelse(is.na(val), 0, val)
} else {
flu_cases_kyoto[i] <- 0
}
}
df_epidemic <- data.frame(Week = weeks_num, Influenza = flu_cases_kyoto)
# --- 第二階段：結合真實年齡感染比例與「人口結構」進行校正 ---
# 1. 真實感染佔比 (Numerator 分子)
prop_cases_child <- 0.489
prop_cases_adult <- 0.478
prop_cases_elderly <- 0.033
# 2. 京都府 2023 年真實人口佔比 (Denominator 分母，來自昨天的分析！)
prop_pop_child <- 0.108
prop_pop_adult <- 0.594
prop_pop_elderly <- 0.297
# 3. 計算 Age-Specific Incidence (發生率指標 = 確診比例 / 人口比例)
# 並乘上原本的流感總數，得出人口校正後的疫情曲線
df_epidemic$Rate_Child <- (df_epidemic$Influenza * prop_cases_child) / prop_pop_child
df_epidemic$Rate_Adult <- (df_epidemic$Influenza * prop_cases_adult) / prop_pop_adult
df_epidemic$Rate_Elderly <- (df_epidemic$Influenza * prop_cases_elderly) / prop_pop_elderly
# --- 第三階段：繪製高質感 Age-Specific Incidence Curves ---
p_final <- ggplot(df_epidemic, aes(x = Week)) +
geom_line(aes(y = Rate_Child, color = "Child (0-14)"), linewidth = 1.2) +
geom_point(aes(y = Rate_Child, color = "Child (0-14)"), size = 2) +
geom_line(aes(y = Rate_Adult, color = "Adult (15-59)"), linewidth = 1.2) +
geom_point(aes(y = Rate_Adult, color = "Adult (15-59)"), size = 2) +
geom_line(aes(y = Rate_Elderly, color = "Elderly (60+)"), linewidth = 1.2) +
geom_point(aes(y = Rate_Elderly, color = "Elderly (60+)"), size = 2) +
scale_color_manual(name = "Age Group",
values = c("Child (0-14)" = "#4E79A7",
"Adult (15-59)" = "#F28E2B",
"Elderly (60+)" = "#E15759")) +
theme_minimal(base_size = 14) +
labs(title = "Age-Specific Incidence Curves: Influenza (Kyoto 2023)",
subtitle = "Population-adjusted rates revealing high transmission burden in children",
x = "Week of 2023",
y = "Adjusted Incidence Rate (Relative Risk)") +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5, color = "gray40"),
legend.position = "bottom")
print(p_final)