弘前データ４：フローラスキャンデータの探索

著者

司馬博文

日付

5/24/2025

はじめに

hirosaki2.qmd では BP と LAB の関係のモデリング， hirosaki3.qmd では \(\Sigma\)-FLC と LOX-1 の関係をモデリングした． ここではフローラスキャンデータの探索を行う．

library(readxl)
library(knitr)
df <- readRDS("df.rds")
kable(head(df))
受付番号 受診日年齢 性別 Weight BP FLCΣ BP備考 判別式 LOX-1_H LAB_H LOX-index_H タイプ 多様性 item1 item2 item3 item4 item5 item6 item7 item8 item9 item10 item11 item12 item13 item14 item15 item16 item17 item18 BP_A_flag 年代 活気 イライラ感 疲労感 不安感 抑うつ感
2 48 2 52.7 0.47 0.81 B -3.343 75 2.2 165 B 2 2 2 2 2 2 2 4 3 2 3 2 2 2 2 1 2 3 2 0 40代 3 3 4 3 3
3 53 2 64.8 0.67 -0.30 BDG -2.727 55 2.8 154 A 1 3 1 1 1 1 2 3 3 3 2 2 2 2 2 1 1 1 1 0 50代 4 2 4 3 2
4 46 1 76.3 1.10 1.95 NA -2.974 136 3.8 517 B 2 2 3 3 2 2 2 1 1 2 2 2 1 2 2 1 1 1 1 0 40代 2 3 2 3 2
5 65 1 72.4 0.88 -8.96 D -7.338 58 2.3 133 C 2 3 3 3 2 2 2 1 1 1 2 1 1 1 1 1 1 1 1 0 60代 2 3 1 2 1
6 30 1 59.5 0.76 0.64 NA -2.776 46 2.2 101 B 2 2 2 2 3 4 3 3 3 3 4 4 3 3 3 3 3 1 1 0 30代 3 5 4 5 4
7 51 1 76.6 1.69 2.58 NA -2.377 78 3.2 250 B 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 0 50代 3 3 3 3 2

1 タイプの予測問題

1.1 BP との関係の探索

library(dplyr)
df$BP_level <- case_when(
  df$BP > 0.9 ~ 3,
  df$BP > 0.7 & df$BP <= 0.9 ~ 2,
  df$BP <= 0.7 ~ 1
)
length(df[df$BP_level == 3, ]$BP)/dim(df)[1]
[1] 0.3156028
length(df[df$BP_level == 2, ]$BP)/dim(df)[1]
[1] 0.2606383
length(df[df$BP_level == 1, ]$BP)/dim(df)[1]
[1] 0.4379433

1.2 タイプを予測できるか？

library(brms)

formula_nominal <- bf(
  タイプ ~ 1 + BP,
  family = categorical(link = "logit")
)
nominal_type <- brm(
  formula_nominal,
  data = df,
  chains = 4, cores = 4, iter = 8000
)
saveRDS(nominal_type, "nominal_type.rds")
ce <- conditional_effects(nominal_type, effects = "BP", categorical = TRUE)

library(ggplot2)

# プロットに水平方向の直線を追加
plot(ce, plot = FALSE)[[1]] +
      theme(
    axis.text = element_text(size = 24),  # 軸の目盛りの文字サイズ
    axis.title = element_text(size = 30),   # 軸ラベルの文字サイズ
        legend.text = element_text(size = 36),  # 凡例のテキストサイズ
    legend.title = element_text(size = 24)  # 凡例のタイトルサイズ
  )

1.3 FLC との関係の探索

df_FLC <- df[is.na(df$`BP備考`), ]
df_FLC$FLC_level <- case_when(
  df_FLC$FLCΣ >= 2 ~ 3,
  df_FLC$FLCΣ >= 1.0 & df_FLC$FLCΣ < 2 ~ 2,
  df_FLC$FLCΣ < 1.0 ~ 1
)
length(df_FLC[df_FLC$FLC_level == 3, ]$FLCΣ)/dim(df_FLC)[1]
[1] 0.390411
length(df_FLC[df_FLC$FLC_level == 2, ]$FLCΣ)/dim(df_FLC)[1]
[1] 0.3219178
length(df_FLC[df_FLC$FLC_level == 1, ]$FLCΣ)/dim(df_FLC)[1]
[1] 0.3150685

1.4 FLC はタイプを予測できるか？

library(brms)

formula_nominal <- bf(
  タイプ ~ 1 + FLCΣ,
  family = categorical(link = "logit")
)
nominal_type_FLC <- brm(
  formula_nominal,
  data = df_FLC,
  chains = 4, cores = 4, iter = 8000
)
saveRDS(nominal_type_FLC, "nominal_type_FLC.rds")
ce <- conditional_effects(nominal_type_FLC, effects = "FLCΣ", categorical = TRUE)

# プロットに水平方向の直線を追加
plot(ce, plot = FALSE)[[1]] +
      theme(
    axis.text = element_text(size = 24),  # 軸の目盛りの文字サイズ
    axis.title = element_text(size = 30),   # 軸ラベルの文字サイズ
        legend.text = element_text(size = 36),  # 凡例のテキストサイズ
    legend.title = element_text(size = 24)  # 凡例のタイトルサイズ
  )

2 多様性の予測問題

2.1 BP は多様性を予測できるか？

library(brms)

formula_mult <- bf(
  多様性 ~ 1 + BP,
  family = cumulative(link = "logit")
)
mult_diversity_BP <- brm(
  formula_mult,
  data = df,
  chains = 4, cores = 4, iter = 8000
)
saveRDS(mult_diversity_BP, "mult_diversity_BP.rds")
ce <- conditional_effects(mult_diversity_BP, effects = "BP", categorical = TRUE)

# プロットに水平方向の直線を追加
plot(ce, plot = FALSE)[[1]] +
      theme(
    axis.text = element_text(size = 24),  # 軸の目盛りの文字サイズ
    axis.title = element_text(size = 30),   # 軸ラベルの文字サイズ
        legend.text = element_text(size = 36),  # 凡例のテキストサイズ
    legend.title = element_text(size = 24)  # 凡例のタイトルサイズ
)

2.2 FLC は多様性を予測できるか？

formula_mult <- bf(
  多様性 ~ 1 + FLCΣ,
  family = cumulative(link = "logit")
)
mult_diversity_FLC <- brm(
  formula_mult,
  data = df_FLC,
  chains = 4, cores = 4, iter = 8000
)
saveRDS(mult_diversity_FLC, "mult_diversity_FLC.rds")
ce <- conditional_effects(mult_diversity_FLC, effects = "FLCΣ", categorical = TRUE)

# プロットに水平方向の直線を追加
plot(ce, plot = FALSE)[[1]] +
      theme(
    axis.text = element_text(size = 24),  # 軸の目盛りの文字サイズ
    axis.title = element_text(size = 30),   # 軸ラベルの文字サイズ
        legend.text = element_text(size = 36),  # 凡例のテキストサイズ
    legend.title = element_text(size = 24)  # 凡例のタイトルサイズ
)