Rで確率分布:コンドルセの陪審定理

seed <- 20250801
set.seed(seed)

# 必要なライブラリを読み込む
library(ggplot2)
library(dplyr)
library(scales) # y軸をパーセント表示にするために使用

# ---- パラメータ設定 ----
# 専門家チームの人数 (1人から101人までの奇数)
# 奇数にして、多数決における『同数（引き分け）』の発生を避け、シミュレーションを単純化する
n_values <- seq(1, 101, by = 2)

# 専門家個人の正解率 (p)
# ケースA: 先進的なチーム (p=0.6)
# ケースB: 保守的なチーム (p=0.4)
p_values <- c(0.6, 0.4)

# 各設定でのシミュレーション試行回数
n_sims <- 2000

# 結果を格納するデータフレームを作成
results <- expand.grid(n = n_values, p = p_values)
results$correct_decision_prob <- NA # 結果を格納する列を追加

# ---- シミュレーション実行 ----

for (i in 1:nrow(results)) {
  n <- results$n[i]
  p <- results$p[i]

  # n_sims回、多数決シミュレーションを行う
  # rbinomで、n人の専門家がpの確率で正しい判断(1)をする試行をn_sims回行う
  sim_results <- rbinom(n_sims, n, p)

  # 多数決で正しい判断となるのは、正しい判断をした人数が半数を超える場合
  correct_decisions <- sum(sim_results > (n / 2))

  # 集団が正しい判断をした確率を計算
  results$correct_decision_prob[i] <- correct_decisions / n_sims
}

# ---- 結果の可視化 ----

# 凡例ラベル用のファクターを作成
results$team_type <- factor(
  results$p,
  levels = c(0.6, 0.4),
  labels = c("先進的なチーム (p=0.6)", "保守的なチーム (p=0.4)")
)

# グラフの作成
g <- ggplot(results, aes(x = n, y = correct_decision_prob, color = team_type)) +
  geom_line(linewidth = 1.2) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "black") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, 1)) +
  scale_color_manual(values = c("先進的なチーム (p=0.6)" = "#0072B2", "保守的なチーム (p=0.4)" = "#D55E00")) +
  labs(
    title = "コンドルセの陪審定理シミュレーション：専門家チームの人数と判断の正しさ",
    subtitle = "新製品「コンドルセ」を発売すべきか？",
    x = "専門家チームの人数",
    y = "チームが「発売すべき」と正しく判断する確率",
    color = "専門家チームのタイプ"
  ) +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold", size = 14),
    plot.subtitle = element_text(size = 14)
  )

# グラフを表示
print(g)