高校数学の質問スレ(医者・東大卒専用) Part438 (882レス)
前次1-
抽出解除 必死チェッカー(本家) (べ) 自ID レス栞 あぼーん

794: 2025/04/23(水) 02:35:47.03 ID:t2PViPB2(1)調 AAS
# Candidate values for the number of red balls (0 to 100)
R_vals <- 0:100

# Observed data
k <- 4 # Number of red balls drawn
n <- 10 # Sample size
N <- 100 # Total number of balls

# Likelihood using the hypergeometric distribution
likelihood <- dhyper(k, R_vals, N - R_vals, n)

# Prior distribution: uniform
prior <- rep(1, length(R_vals))

# Unnormalized posterior
posterior_unnorm <- likelihood * prior

# Normalize to get the posterior distribution
posterior <- posterior_unnorm / sum(posterior_unnorm)

# MAP estimate (most probable value)
R_MAP <- R_vals[which.max(posterior)]

# Posterior mean (expected value)
R_mean <- sum(R_vals * posterior)

# 95% central credible interval
cumulative <- cumsum(posterior)
lower_CI <- R_vals[which(cumulative >= 0.025)[1]]
upper_CI <- R_vals[which(cumulative >= 0.975)[1]]

# 95% Highest Posterior Density Interval (HPDI)
sorted <- order(posterior, decreasing = TRUE)
cumsum_sorted <- cumsum(posterior[sorted])
HPDI_index <- sorted[which(cumsum_sorted <= 0.95)]
HPDI_range <- range(R_vals[HPDI_index])

# Display results
cat("MAP estimate:", R_MAP, "\n")
cat("Posterior mean:", round(R_mean, 2), "\n")
cat("95% central credible interval: [", lower_CI, ",", upper_CI, "]\n")
cat("95% HPDI: [", HPDI_range[1], ",", HPDI_range[2], "]\n")

# Plot posterior distribution
plot(R_vals, posterior, type = "h", lwd = 2,
main = "Posterior Distribution P(R | Data)",
xlab = "Number of Red Balls (R)", ylab = "Posterior Probability")
abline(v = c(lower_CI, upper_CI), col = "blue", lty = 2)
abline(v = HPDI_range, col = "red", lty = 3)
legend("topright", legend = c("95% Central CI", "95% HPDI"),
col = c("blue", "red"), lty = c(2,3))
前次1-
スレ情報 赤レス抽出 画像レス抽出 歴の未読スレ

ぬこの手 ぬこTOP 0.028s