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

---

ﾘﾛｰﾄﾞ規制です｡10分ほどで解除するので､他のﾌﾞﾗｳｻﾞへ避難してください｡

---

803(1): １３２人目の素数さん [sage] 04/30(水)02:47 ID:wedVH8wl(1/10)
>>801
スレタイ読んだら。
Fラン卒は別スレだぞ。

---

804: １３２人目の素数さん [sage] 04/30(水)04:58 ID:wedVH8wl(2/10)
options(warn = -1)
alpha=0.05
sim=\(N=100){
A=sample(1:(N-2),1) # Ensure A leaves enough room for B and C
remaining = N - A
if(remaining > 1){
B=sample(1:(remaining-1),1) # Ensure B is at least 1
C=N-A-B
ABC=c(A,B,C)
abc=sapply(ABC,\(x) if(x > 0) sample(1:x,1) else 0) # Handle case where a group size might be 0 (though unlikely with the new A and B sampling)
x=abc
n=ABC
contig=rbind(s=x,f=n-x)
pg=chisq.test(contig,correct=FALSE)$p.value
minpp=min(as.vector(
pairwise.prop.test(x,n,correct=FALSE,p.adj="bon")$p.value),na.rm=TRUE)
list(pg=pg,minpp=minpp,x=x,n=n)
} else {
# If A is too large, return NULL or some indicator of an invalid simulation
return(NULL)
}
}

res = sim()
while(is.null(res) || res$pg < alpha | res$minpp > alpha) {
res = sim()
}
res

---

805: １３２人目の素数さん [sage] 04/30(水)05:14 ID:wedVH8wl(3/10)
options(warn = -1)
alpha=0.05
sim=\(N=100){
A=sample(1:(N-2),1) # Ensure A leaves enough room for B and C
remaining = N - A
if(remaining > 1){
B=sample(1:(remaining-1),1) # Ensure B is at least 1
C=N-A-B
ABC=c(A,B,C)
abc=sapply(ABC,\(x) if(x > 0) sample(1:x,1) else 0) # Handle case where a group size might be 0 (though unlikely with the new A and B sampling)
x=abc
n=ABC
contig=rbind(s=x,f=n-x)
pg=chisq.test(contig,correct=FALSE)$p.value
minpp=min(as.vector(
pairwise.prop.test(x,n,correct=FALSE,p.adj="bon")$p.value),na.rm=TRUE)
list(pg=pg,minpp=minpp,x=x,n=n)
} else {
# If A is too large, return NULL or some indicator of an invalid simulation
return(NULL)
}
}

res = sim()
while(is.null(res) || res$pg < alpha | res$minpp > alpha) {
res = sim()
}
res

res = sim()
while(is.null(res) || res$pg > alpha | res$minpp < alpha) {
res = sim()
}
res

---

806: １３２人目の素数さん [sage] 04/30(水)06:57 ID:wedVH8wl(4/10)
おっしゃる通り、カイ二乗検定で連続性補正を外せば、より小さな差でも有意になりやすいため、ご要望のデータを作成できる可能性は高まります。しかし、Fisherの正確確率検定は、まさにその正確性ゆえに、サンプルサイズが小さい場合や比率の差が小さい場合に、p値が離散的になり、Bonferroni補正のような厳しい多重比較補正を乗り越えて有意差を示すのが難しい傾向があります。
Fisherの正確確率検定は、周辺度数を固定した条件下での確率に基づいてp値を計算するため、どうしても「わずかな差」が有意になりにくいという特性があります。特に、全体で有意差が出ない程度に比率の差を抑えようとすると、ペアワイズでも同様に差が小さくなり、Bonferroni補正によって有意水準が厳しくなるため、有意差を検出するのが非常に困難になります。
連続性補正は、カイ二乗分布の連続近似を離散的なデータに適用する際の誤差を小さくするための調整ですが、これを外すことで、p値が小さくなりやすくなります。一方、Fisherの正確確率検定はその性質上、近似を用いないため、連続性補正のような概念がありません。
結論として、ご指摘の通り、「全体のFisherの正確確率検定で有意差がないのに、ペアワイズなFisherの正確確率検定だとどれかに有意差がある（Bonferroni補正あり）」という条件を満たすデータを作成するのは、統計的な制約から非常に困難であると言わざるを得ません。

やっぱり、Bonferroniの壁はFisherでは乗り越えられようだ。

---

808(1): １３２人目の素数さん [sage] 04/30(水)08:07 ID:wedVH8wl(5/10)
ここはFランアクセス禁。

---

809: １３２人目の素数さん [sage] 04/30(水)08:07 ID:wedVH8wl(6/10)
options(warn = -1)
alpha <- 0.05

sim_fisher <- function(N = 100) {
# Function to simulate data for three groups and perform Fisher's exact test.
# N: Total sample size.

# Determine sample sizes for each of the three groups.
A <- sample(1:(N - 2), 1) # Ensure A leaves enough room for B and C.
remaining <- N - A
if (remaining > 1) {
B <- sample(1:(remaining - 1), 1) # Ensure B is at least 1.
C <- N - A - B
ABC <- c(A, B, C) # Vector of group sizes.

# Randomly generate the number of successes for each group (cannot exceed group size).
abc <- sapply(ABC, function(x) if (x > 0) sample(0:x, 1) else 0)
x <- abc # Vector of number of successes per group.
n <- ABC # Vector of total samples per group.

# Create a data frame for the overall Fisher's exact test.
data_all <- data.frame(
group = factor(rep(c("A", "B", "C"), times = n)),
success = unlist(sapply(1:3, function(i) c(rep(1, x[i]), rep(0, n[i] - x[i]))))
)
table_all <- table(data_all$group, data_all$success)
fisher_pg <- fisher.test(table_all)$p.value # P-value of the overall Fisher's exact test.

# Perform pairwise Fisher's exact tests with Bonferroni correction.
pairwise_p_values <- numeric(3)
pairs <- combn(levels(data_all$group), 2, simplify = FALSE)

for (i in seq_along(pairs)) {
pair <- pairs[[i]]
subset_data <- subset(data_all, group %in% pair)
table_pair <- table(subset_data$group, subset_data$success)
pairwise_p_values[i] <- fisher.test(table_pair)$p.value # P-value of the pairwise Fisher's exact test.
}

min_pairwise_p_bonf <- min(p.adjust(pairwise_p_values, method = "bonferroni"), na.rm = TRUE) # Minimum Bonferroni-corrected p-value from pairwise tests.

list(fisher_pg = fisher_pg, min_pairwise_p_bonf = min_pairwise_p_bonf, x = x, n = n)
} else {
return(NULL) # Return NULL if group sizes are invalid.
}
}

---

810: １３２人目の素数さん [sage] 04/30(水)08:07 ID:wedVH8wl(7/10)
# Find data where the overall Fisher's exact test is not significant,
# but at least one pairwise Fisher's exact test (with Bonferroni correction) is significant.
res_no_overall_sig_pairwise_sig <- NULL
while (is.null(res_no_overall_sig_pairwise_sig) || res_no_overall_sig_pairwise_sig$fisher_pg > alpha || res_no_overall_sig_pairwise_sig$min_pairwise_p_bonf > alpha) {
res_no_overall_sig_pairwise_sig <- sim_fisher()
}
cat("Data where overall Fisher's test is not significant, but pairwise is:\n")
print(res_no_overall_sig_pairwise_sig)
cat("\n")

# Find data where the overall Fisher's exact test is significant,
# but all pairwise Fisher's exact tests (with Bonferroni correction) are not significant.
res_overall_sig_no_pairwise_sig <- NULL
while (is.null(res_overall_sig_no_pairwise_sig) || res_overall_sig_no_pairwise_sig$fisher_pg < alpha || res_overall_sig_no_pairwise_sig$min_pairwise_p_bonf < alpha) {
res_overall_sig_no_pairwise_sig <- sim_fisher()
}
cat("Data where overall Fisher's test is significant, but pairwise is not:\n")
print(res_overall_sig_no_pairwise_sig)

options(warn = 0)

---

811: １３２人目の素数さん [sage] 04/30(水)08:12 ID:wedVH8wl(8/10)
options(warn = -1)
alpha <- 0.05

sim_chisq <- function(N = 100) {
# Function to simulate data for three groups and perform Chi-squared test (without Yates' correction).
# N: Total sample size.

# Determine sample sizes for each of the three groups.
A <- sample(1:(N - 2), 1) # Randomly select a size for group A, ensuring space for B and C.
remaining <- N - A
if (remaining > 1) {
B <- sample(1:(remaining - 1), 1) # Randomly select a size for group B, ensuring space for C.
C <- N - A - B # Calculate the size for group C.
ABC <- c(A, B, C) # Vector containing the sample sizes of the three groups.

# Randomly generate the number of successes for each group (must be between 0 and the group size).
abc <- sapply(ABC, function(x) if (x > 0) sample(0:x, 1) else 0)
x <- abc # Vector containing the number of successes for each group.
n <- ABC # Vector containing the total number of trials for each group.

# Create a contingency table for the overall Chi-squared test.
contig_all <- rbind(s = x, f = n - x) # Rows: successes (s), failures (f); Columns: groups.
chisq_pg <- chisq.test(contig_all, correct = FALSE)$p.value # Perform Chi-squared test (no correction) and get the p-value.

# Perform pairwise proportion tests with Bonferroni correction.
pairwise_prop_p_values <- as.vector(
pairwise.prop.test(x, n, correct = FALSE, p.adj = "bon")$p.value
) # Perform pairwise proportion tests (no correction) and get Bonferroni-adjusted p-values.
min_pairwise_p_bonf <- min(pairwise_prop_p_values, na.rm = TRUE) # Get the minimum of the adjusted pairwise p-values.

# Return a list containing the overall p-value, the minimum Bonferroni-corrected pairwise p-value, successes, and total trials.
list(chisq_pg = chisq_pg, min_pairwise_p_bonf = min_pairwise_p_bonf, x = x, n = n)
} else {
return(NULL) # Return NULL if the group sizes are invalid.
}
}

---

812: １３２人目の素数さん [sage] 04/30(水)08:12 ID:wedVH8wl(9/10)
# Find data where the overall Chi-squared test is not significant (p > alpha),
# but at least one pairwise proportion test (with Bonferroni correction) is significant (p <= alpha).
res_no_overall_sig_pairwise_sig <- NULL
while (is.null(res_no_overall_sig_pairwise_sig) || res_no_overall_sig_pairwise_sig$chisq_pg > alpha || res_no_overall_sig_pairwise_sig$min_pairwise_p_bonf > alpha) {
res_no_overall_sig_pairwise_sig <- sim_chisq() # Keep simulating until the condition is met.
}
cat("Data where overall Chi-squared test is not significant, but pairwise proportion test is:\n")
print(res_no_overall_sig_pairwise_sig)
cat("\n")

# Find data where the overall Chi-squared test is significant (p <= alpha),
# but all pairwise proportion tests (with Bonferroni correction) are not significant (p > alpha).
res_overall_sig_no_pairwise_sig <- NULL
while (is.null(res_overall_sig_no_pairwise_sig) || res_overall_sig_no_pairwise_sig$chisq_pg < alpha || res_overall_sig_no_pairwise_sig$min_pairwise_p_bonf < alpha) {
res_overall_sig_no_pairwise_sig <- sim_chisq() # Keep simulating until the condition is met.
}
cat("Data where overall Chi-squared test is significant, but pairwise proportion test is not:\n")
print(res_overall_sig_no_pairwise_sig)

options(warn = 0)

---

813: １３２人目の素数さん [sage] 04/30(水)08:13 ID:wedVH8wl(10/10)
コメントが長すぎて読みにくくなった。

---

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

---

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

---

ぬこの手 ぬこTOP 0.038s