公衆衛生ビッグデータ分析：
演習リソース集

# 棒グラフ作成 - 死因別の死亡数（最新年） latest_year_data <- clean_data %>% filter(year == max(year)) ggplot(latest_year_data, aes(x = reorder(cause_name, -deaths), y = deaths)) + geom_bar(stat = "identity", fill = "steelblue") + theme_minimal() + labs(title = paste("主要死因別死亡数（", max(latest_year_data$year), "年）"), x = "死因", y = "死亡数") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) # 時系列グラフ作成 - 特定の死因の推移 heart_disease_trend <- clean_data %>% filter(cause_name == "Heart disease") ggplot(heart_disease_trend, aes(x = year, y = deaths)) + geom_line(color = "red", size = 1) + geom_point(color = "red", size = 2) + theme_minimal() + labs(title = "心臓病による死亡数の推移", x = "年", y = "死亡数") # 複数の死因比較グラフ top_causes <- clean_data %>% filter(cause_name %in% c("Heart disease", "Cancer", "Stroke", "Alzheimer's disease")) %>% group_by(year, cause_name) %>% summarize(deaths = sum(deaths, na.rm = TRUE)) ggplot(top_causes, aes(x = year, y = deaths, color = cause_name, group = cause_name)) + geom_line(size = 1) + geom_point(size = 2) + theme_minimal() + scale_color_brewer(palette = "Set1") + labs(title = "主要死因の死亡数推移", x = "年", y = "死亡数", color = "死因")

# 棒グラフ作成 - 死因別の死亡数（最新年）
latest_year = clean_data['year'].max()
latest_year_data = clean_data[clean_data['year'] == latest_year]

plt.figure(figsize=(12, 6))
plt.bar(latest_year_data['cause_name'], latest_year_data['deaths'])
plt.xticks(rotation=45, ha='right')
plt.title(f'主要死因別死亡数（{latest_year}年）')
plt.xlabel('死因')
plt.ylabel('死亡数')
plt.tight_layout()
plt.show()

# 時系列グラフ作成 - 特定の死因の推移
heart_disease_trend = clean_data[clean_data['cause_name'] == 'Heart disease']

plt.figure(figsize=(10, 5))
plt.plot(heart_disease_trend['year'], heart_disease_trend['deaths'], 'ro-', linewidth=2)
plt.title('心臓病による死亡数の推移')
plt.xlabel('年')
plt.ylabel('死亡数')
plt.grid(True, linestyle='--', alpha=0.7)
plt.tight_layout()
plt.show()

# 複数の死因比較グラフ
top_causes = clean_data[clean_data['cause_name'].isin(['Heart disease', 'Cancer', 'Stroke', "Alzheimer's disease"])]

plt.figure(figsize=(12, 6))
for cause in ['Heart disease', 'Cancer', 'Stroke', "Alzheimer's disease"]:
    cause_data = top_causes[top_causes['cause_name'] == cause]
    plt.plot(cause_data['year'], cause_data['deaths'], 'o-', linewidth=2, label=cause)

plt.title('主要死因の死亡数推移')
plt.xlabel('年')
plt.ylabel('死亡数')
plt.legend()
plt.grid(True, linestyle='--', alpha=0.5)
plt.tight_layout()
plt.show()

# サブプロットを使った複数グラフの表示
fig, axes = plt.subplots(2, 2, figsize=(14, 10))
fig.suptitle('公衆衛生データの多角的分析', fontsize=16)

# 左上: 棒グラフ
axes[0, 0].bar(latest_year_data['cause_name'], latest_year_data['deaths'])
axes[0, 0].set_title('死因別死亡数')
axes[0, 0].set_xticklabels(latest_year_data['cause_name'], rotation=45, ha='right')

# 右上: 円グラフ
axes[0, 1].pie(latest_year_data['deaths'], labels=latest_year_data['cause_name'], autopct='%1.1f%%')
axes[0, 1].set_title('死因別死亡数の割合')

# 左下: 時系列
heart_disease_trend = clean_data[clean_data['cause_name'] == 'Heart disease']
axes[1, 0].plot(heart_disease_trend['year'], heart_disease_trend['deaths'], 'r-')
axes[1, 0].set_title('心臓病による死亡数の推移')
axes[1, 0].set_xlabel('年')
axes[1, 0].set_ylabel('死亡数')
axes[1, 0].grid(True)

# 右下: 箱ひげ図
axes[1, 1].boxplot([clean_data[clean_data['cause_name'] == cause]['deaths'] 
                    for cause in ['Heart disease', 'Cancer', 'Stroke']])
axes[1, 1].set_xticklabels(['Heart disease', 'Cancer', 'Stroke'])
axes[1, 1].set_title('死因別死亡数の分布')
axes[1, 1].set_ylabel('死亡数')

plt.tight_layout(rect=[0, 0, 1, 0.95])
plt.show()

# Rでのリスク比とオッズ比計算の例 # 2x2表データの作成 library(epitools) # 例: 喫煙と肺がんの関連（仮想データ） smoking_data <- matrix(c(40, 60, 10, 90), nrow = 2, dimnames = list(c("Lung Cancer", "No Lung Cancer"), c("Smoker", "Non-Smoker"))) print(smoking_data) # リスク比の計算 riskratio(smoking_data) # オッズ比の計算 oddsratio(smoking_data) # 95%信頼区間の確認 oddsratio.wald(smoking_data) # フィッシャーの正確検定 fisher.test(smoking_data)

# Rでの交絡因子の調整例 # 必要なパッケージ library(dplyr) library(ggplot2) library(epitools) # 仮想データの作成: 年齢・喫煙・心臓病のデータ set.seed(123) n <- 1000 age_group <- sample(c("若年", "中年", "高齢"), n, replace = TRUE, prob = c(0.3, 0.4, 0.3)) smoking <- ifelse(age_group == "若年", sample(c(TRUE, FALSE), sum(age_group == "若年"), replace = TRUE, prob = c(0.2, 0.8)), ifelse(age_group == "中年", sample(c(TRUE, FALSE), sum(age_group == "中年"), replace = TRUE, prob = c(0.4, 0.6)), sample(c(TRUE, FALSE), sum(age_group == "高齢"), replace = TRUE, prob = c(0.3, 0.7)))) # 心臓病発症確率は年齢と喫煙状態に依存 prob_heart_disease <- case_when( age_group == "若年" & smoking == TRUE ~ 0.05, age_group == "若年" & smoking == FALSE ~ 0.01, age_group == "中年" & smoking == TRUE ~ 0.15, age_group == "中年" & smoking == FALSE ~ 0.05, age_group == "高齢" & smoking == TRUE ~ 0.30, age_group == "高齢" & smoking == FALSE ~ 0.15 ) heart_disease <- rbinom(n, 1, prob_heart_disease) # データフレームの作成 health_data <- data.frame( age_group = age_group, smoking = smoking, heart_disease = heart_disease ) # 喫煙と心臓病の関連（層別化なし） table_overall <- table(health_data$smoking, health_data$heart_disease) print("全体の関連:") print(table_overall) print(oddsratio.wald(table_overall)) # 年齢層別の層別解析 for (age in c("若年", "中年", "高齢")) { subset_data <- filter(health_data, age_group == age) table_strata <- table(subset_data$smoking, subset_data$heart_disease) print(paste("年齢層:", age)) print(table_strata) print(oddsratio.wald(table_strata)) } # ロジスティック回帰による交絡調整 model1 <- glm(heart_disease ~ smoking, family = binomial, data = health_data) model2 <- glm(heart_disease ~ smoking + age_group, family = binomial, data = health_data) # 調整なしと調整ありのオッズ比比較 print("調整なしのモデル:") summary(model1) exp(cbind(OR = coef(model1), confint(model1))) print("年齢調整済みのモデル:") summary(model2) exp(cbind(OR = coef(model2), confint(model2)))