高校数学の質問スレ（医者・東大卒専用） Part438 (894ﾚｽ)
上下前次1-新

---

831: 05/10(土)11:02 ID:ynDPH7B8(1/2) AAS
# ------------------------------------------------------------------------------
# ファイル名：logistic_regression_uraguchi_factors.R
# 目的：裏口入学の決定要因を評価するロジスティック回帰分析
# 考察対象の説明変数：学力、大学ランク (基準カテゴリ: A)、縁故、親の所得、寄付金
# ------------------------------------------------------------------------------

# データ生成 (大学ランクを因子型、基準レベル A)
set.seed(123)
n <- 1000
ranks_char <- sample(LETTERS[1:6], n, replace = TRUE)
ranks_factor <- factor(ranks_char, levels = LETTERS[1:6], ordered = TRUE) # 順序付きファクターとして生成

data <- data.frame(
裏口入学 = rbinom(n, 1, 0.2),
学力 = rnorm(n, mean = 50, sd = 10),
大学ランク = ranks_factor,
縁故 = rbinom(n, 1, 0.1),
親の所得 = rlnorm(n, meanlog = log(5000), sdlog = 0.3),
寄付金 = rlnorm(n, meanlog = log(100000), sdlog = 1.0)
)

# 支払額の生成
rank_numeric <- as.numeric(data$大学ランク) # A=1, B=2, ... 6
data$支払額 <- 10 * pmax(
300 + 100 * data$裏口入学 +
0.5 * (100 - data$学力) +
20 * rank_numeric +
50 * data$縁故 +
0.05 * data$親の所得 +
0.001 * data$寄付金 +
rnorm(n, mean = 0, sd = 50),
0
)

# ロジスティック回帰モデル (大学ランクが因子型として扱われ、基準カテゴリは A)
model_full <- glm(裏口入学 ~ 学力 + 大学ランク + 縁故 + 親の所得 + 寄付金, data = data, family = binomial)

# オッズ比と信頼区間の算出
confint_vals <- exp(confint(model_full))
odds_ratios_ci <- data.frame(
Variable = rownames(confint_vals)[-1],
CI_lower = confint_vals[-1, 1],
CI_upper = confint_vals[-1, 2]
)

# プロット用の変数ラベルを日本語化
label_map <- c(
"学力" = "学力",
"大学ランク.L" = "大学ランク B",
"大学ランク.Q" = "大学ランク C",
"大学ランク.C" = "大学ランク D",
"大学ランク^4" = "大学ランク E",
"大学ランク^5" = "大学ランク F",
"縁故" = "縁故",
"親の所得" = "親の所得",
"寄付金" = "寄付金"
)
odds_ratios_ci$日本語変数名 <- ifelse(odds_ratios_ci$Variable %in% names(label_map),
label_map[odds_ratios_ci$Variable],
odds_ratios_ci$Variable)

---

上下前次1-新書関写板覧索設栞歴

---

あと 63 ﾚｽあります
ｽﾚ情報 赤ﾚｽ抽出 画像ﾚｽ抽出 歴の未読ｽﾚ AAｻﾑﾈｲﾙ

---

ぬこの手 ぬこTOP 0.008s