高校数学の質問スレ（医者・東大卒専用） Part438

高校数学の質問スレ（医者・東大卒専用） Part438 (899ﾚｽ)
上下前次1-新
通常表示 512ﾊﾞｲﾄ分割ﾚｽ栞
抽出解除必死ﾁｪｯｶｰ(本家) (べ) 自ID ﾚｽ栞あぼーん

849: １３２人目の素数さん [sage] 2025/05/25(日) 06:42:27.34 ID:P4nhnL8B

>>847
このプロトタイプをAIに与えて描画機能やコメントをつけてもらった。

beta.parameter <- function(lower, upper, credMass = 0.95, verbose = FALSE) {

# Helper function to convert decimal numbers to fraction strings using MASS::fractions
fractionStr <- function(x) {
as.character(MASS::fractions(x))
}

# Function to compute beta parameter (beta) based on alpha,
# derived from the condition on the shape of the distribution between lower and upper
f <- function(alpha) {
1 + ((alpha - 1) * log(upper / lower)) / log((1 - lower) / (1 - upper))
}

# Root-finding function: difference between desired credible mass
# and the Beta CDF probability between lower and upper with parameters (alpha, f(alpha))
g <- function(alpha) {
pbeta(upper, alpha, f(alpha)) - pbeta(lower, alpha, f(alpha)) - credMass
}

# Find the root of g(alpha) = 0 over the interval [1, 1e5]
# to find the alpha value that satisfies the credible mass condition
re <- uniroot(g, c(1, 1e5))
alpha <- re$root
beta <- f(alpha)

# Calculate the mean of the Beta distribution
mean <- alpha / (alpha + beta)

# Calculate the mode if defined (alpha > 1 and beta > 1),
# otherwise set mode to NA as it is undefined
mode <- if (alpha > 1 && beta > 1) {
(alpha - 1) / (alpha + beta - 2)
} else {
NA
}

http://rio2016.5ch.net/test/read.cgi/math/1723152147/849

850: １３２人目の素数さん [sage] 2025/05/25(日) 06:42:37.76 ID:P4nhnL8B

# If verbose flag is TRUE, plot the Beta distribution and annotate results
if (verbose) {
# Generate x values from 0 to 1 for plotting the density
x <- seq(0, 1, length.out = 1000)

# Compute Beta density values at x
y <- dbeta(x, alpha, beta)

# Color bars within the credible interval [lower, upper] as "lightcoral",
# others as light gray ("gray70")
col <- ifelse(x >= lower & x <= upper, "lightcoral", "gray70")

# Plot histogram-like vertical lines representing the Beta density
plot(x, y, type = "h", col = col, lwd = 2,
main = sprintf("Beta(%.2f, %.2f) Distribution\n[%s, %s] with %.0f%% Probability Mass",
alpha, beta, fractionStr(lower), fractionStr(upper), credMass * 100),
xlab = "x", ylab = "Density", bty = "n")

# Add vertical dashed line for the mean, colored skyblue
abline(v = mean, col = "skyblue", lwd = 1, lty = 2)

# Add vertical dashed line for the mode if defined, colored dark green
if (!is.na(mode)) {
abline(v = mode, col = "darkgreen", lwd = 1, lty = 2)
}

# Prepare legend labels for mean, mode (if exists), and credible interval
labels <- c(
paste0("Mean = ", round(mean, 3)),
if (!is.na(mode)) paste0("Mode = ", round(mode, 3)) else NULL,
paste0("95% Credible Interval [", fractionStr(lower), ", ", fractionStr(upper), "]")
)

# Corresponding colors for legend items
colors <- c(
"skyblue",
if (!is.na(mode)) "darkgreen" else NULL,
"lightcoral"
)

# Line types for legend items (dashed lines for mean and mode, none for credible interval)
ltys <- c(2, if (!is.na(mode)) 2 else NULL, NA)

# Plot characters for legend (none for lines, solid square for interval)
pchs <- c(NA, if (!is.na(mode)) NA else NULL, 15)

# Add legend at the top of the plot with no box, scaled text size
legend("top", legend = labels, col = colors, bty = "n", cex = 0.9,
lty = ltys, pch = pchs)
}

# Return a named vector of calculated parameters and statistics
c(alpha = alpha, beta = beta, mean = mean, mode = mode)
}

http://rio2016.5ch.net/test/read.cgi/math/1723152147/850

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

ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙ

ぬこの手ぬこTOP 2.278s*