Upload to Server
Uploading to server
This commit is contained in:
238
samplesize/1ProportionTest/app.R
Normal file
238
samplesize/1ProportionTest/app.R
Normal file
@@ -0,0 +1,238 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Tỷ lệ một mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
sliderInput("p0",
|
||||
label = "Tỷ lệ giả định dưới H0 (p0):",
|
||||
min = 0.01, max = 0.99, value = 0.5, step = 0.01),
|
||||
|
||||
sliderInput("p1",
|
||||
label = "Tỷ lệ kỳ vọng dưới Ha (p1):",
|
||||
min = 0.01, max = 0.99, value = 0.6, step = 0.01),
|
||||
|
||||
# Hiển thị effect size được tính toán
|
||||
h5("Effect Size (Cohen's h):"),
|
||||
uiOutput("effect_size_display"),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.p.test() từ gói 'pwr'.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Tỷ lệ một mẫu"),
|
||||
p("Kiểm định này so sánh một tỷ lệ quan sát được trong mẫu với một tỷ lệ giả định hoặc đã biết trong tổng thể (\\(p_0\\))."),
|
||||
p("$$H_0: p = p_0$$"),
|
||||
p("$$H_a: p \\neq p_0 \\quad (\\text{hoặc } > p_0 \\text{ hoặc } < p_0\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Z-statistic):"),
|
||||
p("Giá trị thống kê Z được tính như sau:"),
|
||||
p("$$ Z = \\frac{\\hat{p} - p_0}{\\sqrt{\\frac{p_0(1-p_0)}{n}}} $$"),
|
||||
p("Trong đó \\(\\hat{p}\\) là tỷ lệ trong mẫu, \\(p_0\\) là tỷ lệ giả định, và \\(n\\) là cỡ mẫu."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's h):"),
|
||||
p("Để tính toán power, sự khác biệt giữa hai tỷ lệ được chuyển đổi bằng phép biến đổi arcsin để ổn định phương sai. Cohen's h được định nghĩa là:"),
|
||||
p("$$ h = |2 \\arcsin(\\sqrt{p_1}) - 2 \\arcsin(\\sqrt{p_0})| $$"),
|
||||
p("Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một cơ quan y tế biết rằng tỷ lệ tiêm chủng vắc-xin cúm trong cộng đồng năm ngoái là 40% (\\(p_0\\)). Năm nay, họ thực hiện một chiến dịch truyền thông mới và muốn kiểm tra xem chiến dịch có hiệu quả hay không. Họ muốn có đủ power để phát hiện nếu tỷ lệ tiêm chủng tăng lên ít nhất là 50% (\\(p_1\\))."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Kiểm định: Tỷ lệ một mẫu."),
|
||||
tags$li("Giả thuyết không (H0): Tỷ lệ tiêm chủng vẫn là 40%."),
|
||||
tags$li("Giả thuyết đối (Ha): Tỷ lệ tiêm chủng lớn hơn 40%.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi tiến hành khảo sát, họ cần biết cần khảo sát bao nhiêu người. Họ nhập các giá trị vào ứng dụng:"),
|
||||
tags$ul(
|
||||
tags$li("\\(p_0 = 0.40\\)"),
|
||||
tags$li("\\(p_1 = 0.50\\)"),
|
||||
tags$li("Loại kiểm định: Lớn hơn (Greater)"),
|
||||
tags$li("Power = 0.8, Alpha = 0.05")
|
||||
),
|
||||
p("Ứng dụng sẽ tự động tính effect size `h` và cho ra cỡ mẫu cần thiết để thực hiện nghiên cứu này.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán effect size h
|
||||
h <- reactive({
|
||||
req(input$p0, input$p1)
|
||||
abs(ES.h(input$p1, input$p0))
|
||||
})
|
||||
|
||||
# Hiển thị h ra giao diện
|
||||
output$effect_size_display <- renderUI({
|
||||
withMathJax(paste0("$$ h = ", round(h(), 3), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(h(), input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.p.test(
|
||||
h = h(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(10, required_n + 100, by = 2)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.p.test(
|
||||
n = sample_sizes,
|
||||
h = h(),
|
||||
sig.level = input$sig_level,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra. Hãy chắc chắn p0 và p1 không quá gần nhau."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện sự khác biệt giữa tỷ lệ", tags$b(input$p0), "và", tags$b(input$p1), "(effect size h =", tags$b(round(h(), 3)), ") với power là", tags$b(input$power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu", x = "Cỡ mẫu (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.05, 1, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(h_val) {
|
||||
res <- tryCatch({
|
||||
pwr.p.test(
|
||||
h = h_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (h)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = h(), linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = h(), y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = h(), y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
234
samplesize/2ProportionTest/app.R
Normal file
234
samplesize/2ProportionTest/app.R
Normal file
@@ -0,0 +1,234 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Tỷ lệ hai mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
sliderInput("p1",
|
||||
label = "Tỷ lệ kỳ vọng ở Nhóm 1 (p1):",
|
||||
min = 0.01, max = 0.99, value = 0.65, step = 0.01),
|
||||
|
||||
sliderInput("p2",
|
||||
label = "Tỷ lệ kỳ vọng ở Nhóm 2 (p2):",
|
||||
min = 0.01, max = 0.99, value = 0.5, step = 0.01),
|
||||
|
||||
# Hiển thị effect size được tính toán
|
||||
h5("Effect Size (Cohen's h):"),
|
||||
uiOutput("effect_size_display"),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.2p.test() từ gói 'pwr'.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Tỷ lệ hai mẫu"),
|
||||
p("Kiểm định này so sánh tỷ lệ của hai nhóm độc lập (\\(p_1\\) và \\(p_2\\))."),
|
||||
p("$$H_0: p_1 = p_2$$"),
|
||||
p("$$H_a: p_1 \\neq p_2 \\quad (\\text{hoặc } > p_2 \\text{ hoặc } < p_2\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Z-statistic):"),
|
||||
p("Giá trị thống kê Z được tính như sau:"),
|
||||
p("$$ Z = \\frac{(\\hat{p}_1 - \\hat{p}_2) - 0}{\\sqrt{\\hat{p}(1-\\hat{p})(\\frac{1}{n_1} + \\frac{1}{n_2})}} $$"),
|
||||
p("Trong đó \\(\\hat{p}_1, \\hat{p}_2\\) là tỷ lệ trong hai mẫu, và \\(\\hat{p}\\) là tỷ lệ gộp."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's h):"),
|
||||
p("Sự khác biệt giữa hai tỷ lệ được chuyển đổi bằng phép biến đổi arcsin. Cohen's h được định nghĩa là:"),
|
||||
p("$$ h = |2 \\arcsin(\\sqrt{p_1}) - 2 \\arcsin(\\sqrt{p_2})| $$"),
|
||||
p("Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu muốn so sánh hiệu quả của hai chiến dịch truyền thông khác nhau (A và B) nhằm khuyến khích người dân đi xét nghiệm sàng lọc ung thư. Họ chia ngẫu nhiên các cộng đồng thành hai nhóm, mỗi nhóm tiếp xúc với một chiến dịch."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Nhóm 1: Tiếp xúc với chiến dịch A."),
|
||||
tags$li("Nhóm 2: Tiếp xúc với chiến dịch B."),
|
||||
tags$li("Kiểm định: Tỷ lệ hai mẫu, để so sánh tỷ lệ người dân đi xét nghiệm giữa hai nhóm.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Dựa trên các nghiên cứu trước, họ kỳ vọng tỷ lệ đi xét nghiệm ở nhóm B là 50% (\\(p_2\\)). Họ hy vọng chiến dịch A hiệu quả hơn, và muốn có đủ power để phát hiện nếu tỷ lệ ở nhóm A đạt 65% (\\(p_1\\))."),
|
||||
p("Họ có thể nhập các giá trị này vào ứng dụng để tìm ra số người cần khảo sát cho mỗi nhóm chiến dịch.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán effect size h
|
||||
h <- reactive({
|
||||
req(input$p1, input$p2)
|
||||
abs(ES.h(input$p1, input$p2))
|
||||
})
|
||||
|
||||
# Hiển thị h ra giao diện
|
||||
output$effect_size_display <- renderUI({
|
||||
withMathJax(paste0("$$ h = ", round(h(), 3), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(h(), input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Sử dụng pwr.2p.test
|
||||
pwr_result <- tryCatch({
|
||||
pwr.2p.test(
|
||||
h = h(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(10, required_n + 100, by = 2)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.2p.test(
|
||||
n = sample_sizes,
|
||||
h = h(),
|
||||
sig.level = input$sig_level,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra. Hãy chắc chắn p1 và p2 không quá gần nhau."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện sự khác biệt giữa tỷ lệ", tags$b(input$p1), "(Nhóm 1) và", tags$b(input$p2), "(Nhóm 2) với power là", tags$b(input$power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * 2, ".")
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.05, 1.2, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(h_val) {
|
||||
res <- tryCatch({
|
||||
pwr.2p.test(
|
||||
h = h_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (h)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = h(), linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = h(), y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = h(), y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
215
samplesize/F-test/app.R
Normal file
215
samplesize/F-test/app.R
Normal file
@@ -0,0 +1,215 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định F (so sánh 2 phương sai)"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("v_ratio",
|
||||
label = "Tỷ lệ phương sai (\\(\\sigma_1^2 / \\sigma_2^2\\)):",
|
||||
value = 2, min = 1.1, step = 0.1),
|
||||
helpText("Đây là effect size. Giá trị 2 có nghĩa là phương sai của nhóm 1 được giả định lớn gấp đôi phương sai của nhóm 2."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Nhỏ hơn (Less)" = "less",
|
||||
"Lớn hơn (Greater)" = "greater")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi mức độ khác biệt về phương sai thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định F"),
|
||||
p("Kiểm định F được sử dụng để so sánh phương sai của hai mẫu độc lập."),
|
||||
p("$$H_0: \\sigma_1^2 = \\sigma_2^2 \\quad (\\text{tỷ lệ phương sai bằng 1})$$"),
|
||||
p("$$H_a: \\sigma_1^2 \\neq \\sigma_2^2 \\quad (\\text{hoặc } > \\text{ hoặc } <\\text{)}$$"),
|
||||
tags$div(class = "alert alert-warning",
|
||||
tags$b("Giả định quan trọng:"), " Kiểm định F rất nhạy với giả định rằng dữ liệu trong cả hai nhóm phải tuân theo phân phối chuẩn. Nếu giả định này bị vi phạm, hãy cân nhắc sử dụng kiểm định Levene hoặc Brown-Forsythe."),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê F được tính bằng tỷ lệ của hai phương sai mẫu:"),
|
||||
p("$$ F = \\frac{s_1^2}{s_2^2} $$"),
|
||||
p("Trong đó \\(s_1^2\\) và \\(s_2^2\\) là phương sai của mẫu 1 và mẫu 2, với cỡ mẫu tương ứng là \\(n_1\\) và \\(n_2\\)."),
|
||||
|
||||
tags$b("2. Phân phối của thống kê kiểm định:"),
|
||||
p("Dưới giả thuyết \\(H_0\\) (khi \\(\\sigma_1^2 = \\sigma_2^2\\)), thống kê F tuân theo phân phối F với bậc tự do \\(df_1 = n_1 - 1\\) và \\(df_2 = n_2 - 1\\)."),
|
||||
p("$$ F \\sim F(n_1 - 1, n_2 - 1) $$"),
|
||||
p("Dưới giả thuyết \\(H_a\\) (khi \\(\\frac{\\sigma_1^2}{\\sigma_2^2} = \\lambda > 1\\)), giá trị \\(F/\\lambda\\) tuân theo phân phối F nói trên. Điều này rất quan trọng để tính power."),
|
||||
|
||||
tags$b("3. Tính toán Power:"),
|
||||
p("Power là xác suất bác bỏ \\(H_0\\) một cách chính xác khi \\(H_a\\) là đúng. Công thức phụ thuộc vào loại kiểm định:"),
|
||||
|
||||
tags$i("a) Kiểm định hai phía (Two-sided):"),
|
||||
p("$$ \\text{Power} = P(F < F_{crit, lower} | H_a) + P(F > F_{crit, upper} | H_a) $$"),
|
||||
p("Trong đó \\( F_{crit, lower} = F_{\\alpha/2, n_1-1, n_2-1} \\) và \\( F_{crit, upper} = F_{1-\\alpha/2, n_1-1, n_2-1} \\)."),
|
||||
|
||||
tags$i("b) Kiểm định lớn hơn (Greater):"),
|
||||
p("$$ \\text{Power} = P(F > F_{crit, upper} | H_a) $$"),
|
||||
p("Trong đó \\( F_{crit, upper} = F_{1-\\alpha, n_1-1, n_2-1} \\)."),
|
||||
|
||||
tags$i("c) Kiểm định nhỏ hơn (Less):"),
|
||||
p("$$ \\text{Power} = P(F < F_{crit, lower} | H_a) $$"),
|
||||
p("Trong đó \\( F_{crit, lower} = F_{\\alpha, n_1-1, n_2-1} \\).")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI ---
|
||||
calculate_f_power <- function(n1, n2, v_ratio, sig_level, alternative) {
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_lower <- qf(alpha, n1 - 1, n2 - 1)
|
||||
crit_upper <- qf(1 - alpha, n1 - 1, n2 - 1)
|
||||
power <- pf(crit_lower / v_ratio, n1 - 1, n2 - 1) + (1 - pf(crit_upper / v_ratio, n1 - 1, n2 - 1))
|
||||
} else if (alternative == "greater") {
|
||||
crit_upper <- qf(1 - sig_level, n1 - 1, n2 - 1)
|
||||
power <- 1 - pf(crit_upper / v_ratio, n1 - 1, n2 - 1)
|
||||
} else { # less
|
||||
crit_lower <- qf(sig_level, n1 - 1, n2 - 1)
|
||||
power <- pf(crit_lower / v_ratio, n1 - 1, n2 - 1)
|
||||
}
|
||||
return(power)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
# Hoàn toàn reactive, không cần debounce
|
||||
main_results <- reactive({
|
||||
req(input$v_ratio, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Tìm cỡ mẫu cần thiết
|
||||
n <- 5 # Bắt đầu từ n nhỏ
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 2000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_f_power(n, n, input$v_ratio, input$sig_level, input$alternative)
|
||||
}
|
||||
required_n <- ifelse(n > 2000, NA, n)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
# Đảm bảo dãy sample_sizes hợp lệ ngay cả khi không tìm thấy required_n
|
||||
upper_bound <- if (!is.na(required_n)) required_n + 50 else 200
|
||||
sample_sizes <- seq(5, upper_bound, by = 1)
|
||||
|
||||
powers <- sapply(sample_sizes, function(s_n) {
|
||||
calculate_f_power(s_n, s_n, input$v_ratio, input$sig_level, input$alternative)
|
||||
})
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (!is.na(res$required_n)) {
|
||||
tagList(
|
||||
tags$p("Để phát hiện sự khác biệt về phương sai (tỷ lệ =", tags$b(input$v_ratio), ") với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * 2, ".")
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không thể đạt được power mong muốn với cỡ mẫu tối đa (2000). Vui lòng xem xét lại các tham số.")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
{
|
||||
if(!is.na(res$required_n)) {
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen")
|
||||
}
|
||||
} +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(1.2, 3.0, by = 0.1)
|
||||
required_n_values <- sapply(effect_sizes, function(ratio) {
|
||||
n <- 5
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 2000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_f_power(n, n, ratio, input$sig_level, input$alternative)
|
||||
}
|
||||
ifelse(n > 2000, NA, n)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Tỷ lệ Phương sai (Effect Size)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
207
samplesize/Kruskal-Wallis-Test/app.R
Normal file
207
samplesize/Kruskal-Wallis-Test/app.R
Normal file
@@ -0,0 +1,207 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Kruskal-Wallis"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("k", "Số lượng nhóm so sánh (k):", value = 3, min = 2),
|
||||
|
||||
selectInput("dist_shape", "Hình dạng phân phối của dữ liệu:",
|
||||
choices = c("Lệch phải (Log-Normal)" = "lnorm",
|
||||
"Đối xứng, đuôi dày (t, df=5)" = "t_dist",
|
||||
"Phân phối đều (Uniform)" = "unif")),
|
||||
|
||||
numericInput("effect_size",
|
||||
label = "Effect Size (Median Shift / SD):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Đây là độ lớn của sự dịch chuyển của trung vị (median) của một nhóm so với các nhóm còn lại, được chuẩn hóa bằng độ lệch chuẩn."),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
numericInput("n_sims",
|
||||
label = "Số lần lặp mô phỏng:",
|
||||
value = 500, min = 100, max = 5000),
|
||||
|
||||
hr(),
|
||||
actionButton("calculate", "Bắt đầu tính toán", class = "btn-primary"),
|
||||
helpText("Vì tính toán dựa trên mô phỏng, quá trình có thể mất vài giây.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Kruskal-Wallis"),
|
||||
p("Đây là kiểm định phi tham số thay thế cho One-Way ANOVA. Nó kiểm tra xem liệu có sự khác biệt về phân phối giữa ba hay nhiều nhóm độc lập hay không."),
|
||||
p("$$H_0: \\text{Phân phối của tất cả các nhóm là như nhau}$$"),
|
||||
p("$$H_a: \\text{Phân phối của ít nhất một nhóm khác biệt so với các nhóm còn lại}$$"),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Khi nào sử dụng?"),
|
||||
p("Sử dụng kiểm định này thay cho One-Way ANOVA khi giả định về phân phối chuẩn của dữ liệu trong các nhóm không được đáp ứng, hoặc khi dữ liệu ở dạng thứ hạng (ordinal).")
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Ứng dụng sử dụng phương pháp mô phỏng Monte Carlo để ước tính cỡ mẫu. Quá trình này bao gồm việc tạo ra hàng nghìn bộ dữ liệu giả định (trong đó một nhóm có phân phối bị dịch chuyển đi), áp dụng kiểm định cho từng bộ, và đếm tỷ lệ các kiểm định phát hiện ra hiệu ứng."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu muốn so sánh mức độ hài lòng của bệnh nhân (đo bằng thang điểm từ 1 đến 10) đối với ba bệnh viện khác nhau (A, B, C)."),
|
||||
p(tags$b("Tại sao dùng Kruskal-Wallis?")),
|
||||
p("Dữ liệu về mức độ hài lòng thường không tuân theo phân phối chuẩn (nó là dữ liệu thứ hạng và bị chặn ở hai đầu). Do đó, so sánh phân phối dựa trên hạng (rank) sẽ phù hợp hơn là so sánh trung bình."),
|
||||
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu cần xác định số lượng bệnh nhân cần khảo sát ở mỗi bệnh viện. Họ kỳ vọng một sự khác biệt có effect size khoảng 0.4. Họ có thể nhập các giá trị này vào ứng dụng để tìm ra cỡ mẫu cần thiết cho nghiên cứu của mình.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
simulation_results <- eventReactive(input$calculate, {
|
||||
|
||||
inputs <- list(
|
||||
k = input$k,
|
||||
dist_shape = input$dist_shape,
|
||||
effect_size = input$effect_size,
|
||||
sig_level = input$sig_level,
|
||||
target_power = input$power,
|
||||
n_sims = input$n_sims
|
||||
)
|
||||
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
powers <- numeric(length(sample_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy mô phỏng...', value = 0, {
|
||||
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
|
||||
p_values <- replicate(inputs$n_sims, {
|
||||
|
||||
# Tạo dữ liệu cho k nhóm
|
||||
data_list <- lapply(1:inputs$k, function(group_idx) {
|
||||
# Nhóm đầu tiên có phân phối bị dịch chuyển, các nhóm còn lại thì không
|
||||
shift <- if (group_idx == 1) inputs$effect_size else 0
|
||||
|
||||
if (inputs$dist_shape == "t_dist") {
|
||||
return(rt(n, df = 5) + shift)
|
||||
} else if (inputs$dist_shape == "lnorm") {
|
||||
return(rlnorm(n, meanlog = shift, sdlog = 1))
|
||||
} else { # unif
|
||||
return(runif(n, 0, 1) + shift)
|
||||
}
|
||||
})
|
||||
|
||||
# Chuyển thành dataframe phù hợp cho kruskal.test
|
||||
df <- data.frame(
|
||||
value = unlist(data_list),
|
||||
group = factor(rep(1:inputs$k, each = n))
|
||||
)
|
||||
|
||||
# Thực hiện kiểm định Kruskal-Wallis
|
||||
kruskal.test(value ~ group, data = df)$p.value
|
||||
})
|
||||
|
||||
powers[i] <- mean(p_values < inputs$sig_level, na.rm = TRUE)
|
||||
|
||||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||||
|
||||
if (powers[i] >= inputs$target_power) {
|
||||
sample_sizes <- sample_sizes[1:i]
|
||||
powers <- powers[1:i]
|
||||
break
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
list(
|
||||
sample_sizes = sample_sizes,
|
||||
powers = powers,
|
||||
inputs = inputs
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- simulation_results()
|
||||
|
||||
required_n_index <- which(res$powers >= res$inputs$target_power)[1]
|
||||
|
||||
if (!is.na(required_n_index)) {
|
||||
required_n <- res$sample_sizes[required_n_index]
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size là", tags$b(res$inputs$effect_size), "giữa", tags$b(res$inputs$k), "nhóm với power là", tags$b(res$inputs$target_power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", required_n * res$inputs$k, ".")
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500).")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- simulation_results()
|
||||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||||
|
||||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_point(color = "#007bff", size = 3) +
|
||||
geom_hline(yintercept = res$inputs$target_power, linetype = "dashed", color = "red") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power thực nghiệm (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
ggplot() +
|
||||
labs(title = "Phân tích này không được thực hiện tự động do thời gian tính toán lâu.",
|
||||
subtitle = "Vui lòng chạy lại với các giá trị Effect Size khác nhau để so sánh.") +
|
||||
theme_minimal()
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
251
samplesize/LevenesTest/app.R
Normal file
251
samplesize/LevenesTest/app.R
Normal file
@@ -0,0 +1,251 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(car) # Gói chứa hàm leveneTest
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Levene"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("k_groups",
|
||||
label = "Số lượng nhóm (k):",
|
||||
value = 3, min = 2, max = 10),
|
||||
|
||||
numericInput("sd_ratio",
|
||||
label = "Tỷ lệ độ lệch chuẩn (Effect size):",
|
||||
value = 1.5, min = 1.1, step = 0.1),
|
||||
helpText("Đây là tỷ lệ giữa độ lệch chuẩn của nhóm 'khác biệt' so với các nhóm còn lại (có độ lệch chuẩn là 1). Giá trị càng lớn, sự khác biệt càng rõ rệt."),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
numericInput("n_sims",
|
||||
label = "Số lần lặp mô phỏng:",
|
||||
value = 500, min = 100, max = 5000),
|
||||
|
||||
hr(),
|
||||
helpText("Kết quả chính và đồ thị Power sẽ tự động cập nhật sau 1 giây. Chuyển sang các tab khác để chạy phân tích sâu hơn.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả ước tính"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Phân tích này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi mức độ khác biệt về phương sai thay đổi (với power và alpha được giữ cố định)."),
|
||||
actionButton("run_effect_analysis", "Chạy phân tích Effect Size", class = "btn-success mb-3"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Phương pháp",
|
||||
h4("Giả thuyết của Kiểm định Levene"),
|
||||
p("Kiểm định Levene được sử dụng để kiểm tra giả định về tính đồng nhất của phương sai (homogeneity of variance) giữa hai hay nhiều nhóm."),
|
||||
p("$$H_0: \\sigma_1^2 = \\sigma_2^2 = \\dots = \\sigma_k^2$$"),
|
||||
p("$$H_a: \\text{Có ít nhất một cặp phương sai không bằng nhau}$$"),
|
||||
hr(),
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Ứng dụng sử dụng phương pháp mô phỏng Monte Carlo để ước tính cỡ mẫu:"),
|
||||
tags$ol(
|
||||
tags$li("Với mỗi cỡ mẫu \\(n\\) (cho mỗi nhóm), chúng tôi tạo ra một số lượng lớn các bộ dữ liệu (ví dụ 500 bộ)."),
|
||||
tags$li("Trong mỗi bộ dữ liệu, dữ liệu cho \\(k-1\\) nhóm được tạo từ phân phối chuẩn với phương sai bằng 1, và một nhóm được tạo với phương sai bằng (effect size)². "),
|
||||
tags$li("Áp dụng kiểm định Levene cho từng bộ dữ liệu và ghi lại p-value."),
|
||||
tags$li("Power thực nghiệm được tính bằng tỷ lệ các kiểm định có p-value nhỏ hơn mức ý nghĩa \\(\\alpha\\)."),
|
||||
tags$li("Cỡ mẫu cần thiết là cỡ mẫu nhỏ nhất đạt được power mong muốn.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- HÀM MÔ PHỎNG LÕI ---
|
||||
# Hàm này tìm cỡ mẫu cần thiết cho một bộ tham số cụ thể
|
||||
find_required_n <- function(target_power, sig_level, k_groups, sd_ratio, n_sims, progress = NULL) {
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
required_n <- NA
|
||||
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
|
||||
p_values <- replicate(n_sims, {
|
||||
# Tạo dữ liệu cho k nhóm
|
||||
data_list <- lapply(1:k_groups, function(group_idx) {
|
||||
# Nhóm đầu tiên có sd khác biệt, các nhóm còn lại có sd = 1
|
||||
current_sd <- if (group_idx == 1) sd_ratio else 1
|
||||
rnorm(n, mean = 0, sd = current_sd)
|
||||
})
|
||||
|
||||
# Chuyển thành dataframe phù hợp cho leveneTest
|
||||
df <- data.frame(
|
||||
value = unlist(data_list),
|
||||
group = factor(rep(1:k_groups, each = n))
|
||||
)
|
||||
|
||||
# Thực hiện kiểm định Levene
|
||||
leveneTest(value ~ group, data = df)$`Pr(>F)`[1]
|
||||
})
|
||||
|
||||
current_power <- mean(p_values < sig_level, na.rm = TRUE)
|
||||
|
||||
if (!is.null(progress)) {
|
||||
progress$inc(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n, "/ Power =", round(current_power, 2)))
|
||||
}
|
||||
|
||||
if (current_power >= target_power) {
|
||||
required_n <- n
|
||||
break
|
||||
}
|
||||
}
|
||||
return(required_n)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH (TỰ ĐỘNG) ---
|
||||
reactive_inputs <- reactive({
|
||||
list(
|
||||
sig_level = input$sig_level,
|
||||
power = input$power,
|
||||
k_groups = input$k_groups,
|
||||
sd_ratio = input$sd_ratio,
|
||||
n_sims = input$n_sims
|
||||
)
|
||||
})
|
||||
|
||||
debounced_inputs <- debounce(reactive_inputs, 1000)
|
||||
|
||||
simulation_results <- reactive({
|
||||
inputs <- debounced_inputs()
|
||||
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
powers <- numeric(length(sample_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy mô phỏng chính...', value = 0, {
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
p_values <- replicate(inputs$n_sims, {
|
||||
data_list <- lapply(1:inputs$k_groups, function(j) {
|
||||
current_sd <- if (j == 1) inputs$sd_ratio else 1
|
||||
rnorm(n, mean = 0, sd = current_sd)
|
||||
})
|
||||
df <- data.frame(value = unlist(data_list), group = factor(rep(1:inputs$k_groups, each = n)))
|
||||
leveneTest(value ~ group, data = df)$`Pr(>F)`[1]
|
||||
})
|
||||
powers[i] <- mean(p_values < inputs$sig_level, na.rm = TRUE)
|
||||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||||
if (powers[i] >= inputs$power) {
|
||||
sample_sizes <- sample_sizes[1:i]
|
||||
powers <- powers[1:i]
|
||||
break
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
list(
|
||||
sample_sizes = sample_sizes,
|
||||
powers = powers,
|
||||
inputs = inputs
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- simulation_results()
|
||||
first_index_above_power <- which(res$powers >= res$inputs$power)[1]
|
||||
|
||||
if (!is.na(first_index_above_power)) {
|
||||
required_n <- res$sample_sizes[first_index_above_power]
|
||||
tagList(
|
||||
tags$p("Để phát hiện sự khác biệt về phương sai (tỷ lệ SD =", tags$b(res$inputs$sd_ratio), ") giữa", tags$b(res$inputs$k_groups), "nhóm với power là", tags$b(res$inputs$power), "và mức ý nghĩa", tags$b(res$inputs$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", required_n * res$inputs$k_groups, ".")
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500). Hãy thử tăng effect size hoặc giảm power mong muốn.")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- simulation_results()
|
||||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) + geom_point(color = "#007bff", size = 3) +
|
||||
geom_hline(yintercept = res$inputs$power, linetype = "dashed", color = "red") +
|
||||
annotate("text", x = max(res$sample_sizes) * 0.1, y = res$inputs$power + 0.04, label = paste("Power mục tiêu =", res$inputs$power), color = "red") +
|
||||
labs(title = paste("Power vs. Cỡ mẫu (cho mỗi nhóm)"), x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power thực nghiệm (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_results <- eventReactive(input$run_effect_analysis, {
|
||||
inputs <- isolate(reactive_inputs()) # Lấy giá trị hiện tại, không cần reactive
|
||||
|
||||
effect_sizes <- seq(1.2, 2.5, by = 0.1)
|
||||
required_n_values <- numeric(length(effect_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy phân tích Effect Size...', value = 0, {
|
||||
for (i in 1:length(effect_sizes)) {
|
||||
current_sd_ratio <- effect_sizes[i]
|
||||
# Sử dụng hàm lõi để tìm cỡ mẫu
|
||||
required_n_values[i] <- find_required_n(
|
||||
target_power = inputs$power,
|
||||
sig_level = inputs$sig_level,
|
||||
k_groups = inputs$k_groups,
|
||||
sd_ratio = current_sd_ratio,
|
||||
n_sims = inputs$n_sims,
|
||||
progress = NULL # Không cần progress lồng nhau
|
||||
)
|
||||
incProgress(1/length(effect_sizes), detail = paste("Tỷ lệ SD =", current_sd_ratio))
|
||||
}
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_results()
|
||||
|
||||
ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", isolate(input$power), ")"),
|
||||
x = "Tỷ lệ Độ lệch chuẩn (Effect Size)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
206
samplesize/MannWhitneyUtest/app.R
Normal file
206
samplesize/MannWhitneyUtest/app.R
Normal file
@@ -0,0 +1,206 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Mann-Whitney U"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
selectInput("dist_shape", "Hình dạng phân phối của dữ liệu:",
|
||||
choices = c("Lệch phải (Log-Normal)" = "lnorm",
|
||||
"Đối xứng, đuôi dày (t, df=5)" = "t_dist",
|
||||
"Phân phối đều (Uniform)" = "unif")),
|
||||
|
||||
numericInput("effect_size",
|
||||
label = "Effect Size (Location Shift / SD):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Đây là độ lớn của sự dịch chuyển vị trí (ví dụ: trung vị) của nhóm 1 so với nhóm 2, được chuẩn hóa bằng độ lệch chuẩn."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
numericInput("n_sims",
|
||||
label = "Số lần lặp mô phỏng:",
|
||||
value = 500, min = 100, max = 5000),
|
||||
|
||||
hr(),
|
||||
actionButton("calculate", "Bắt đầu tính toán", class = "btn-primary"),
|
||||
helpText("Vì tính toán dựa trên mô phỏng, quá trình có thể mất vài giây.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Mann-Whitney U"),
|
||||
p("Đây là kiểm định phi tham số thay thế cho kiểm định t hai mẫu độc lập. Nó kiểm tra xem liệu một quan sát được chọn ngẫu nhiên từ nhóm 1 có khả năng lớn hơn (hoặc nhỏ hơn) một quan sát được chọn ngẫu nhiên từ nhóm 2 hay không."),
|
||||
p("$$H_0: P(X > Y) = 0.5$$"),
|
||||
p("$$H_a: P(X > Y) \\neq 0.5 \\quad (\\text{hoặc } > 0.5 \\text{ hoặc } < 0.5\\text{)}$$"),
|
||||
p("Một cách diễn giải khác là \\(H_0\\) cho rằng phân phối của hai nhóm là như nhau."),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Khi nào sử dụng?"),
|
||||
p("Sử dụng kiểm định này thay cho kiểm định t hai mẫu khi giả định về phân phối chuẩn của dữ liệu trong các nhóm không được đáp ứng, hoặc khi dữ liệu ở dạng thứ hạng (ordinal).")
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Ứng dụng sử dụng phương pháp mô phỏng Monte Carlo để ước tính cỡ mẫu. Quá trình này bao gồm việc tạo ra hàng nghìn bộ dữ liệu giả định (trong đó một nhóm có phân phối bị dịch chuyển đi), áp dụng kiểm định cho từng bộ, và đếm tỷ lệ các kiểm định phát hiện ra hiệu ứng."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu muốn so sánh hiệu quả của hai phương pháp tư vấn cai thuốc lá khác nhau (A và B). Họ đo lường số điếu thuốc trung bình mà bệnh nhân hút mỗi ngày sau một tháng can thiệp."),
|
||||
p(tags$b("Tại sao dùng Mann-Whitney?")),
|
||||
p("Dữ liệu về số điếu thuốc hút mỗi ngày thường không tuân theo phân phối chuẩn (nó là dữ liệu đếm, không thể âm, và thường bị lệch phải). Do đó, so sánh phân phối dựa trên hạng sẽ phù hợp hơn là so sánh trung bình."),
|
||||
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu cần xác định số lượng bệnh nhân cần cho mỗi phương pháp tư vấn. Họ kỳ vọng một sự khác biệt có effect size khoảng 0.5. Họ có thể nhập các giá trị này vào ứng dụng để tìm ra cỡ mẫu cần thiết cho nghiên cứu của mình.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
simulation_results <- eventReactive(input$calculate, {
|
||||
|
||||
inputs <- list(
|
||||
dist_shape = input$dist_shape,
|
||||
effect_size = input$effect_size,
|
||||
alternative = input$alternative,
|
||||
sig_level = input$sig_level,
|
||||
target_power = input$power,
|
||||
n_sims = input$n_sims
|
||||
)
|
||||
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
powers <- numeric(length(sample_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy mô phỏng...', value = 0, {
|
||||
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
|
||||
p_values <- replicate(inputs$n_sims, {
|
||||
|
||||
# Tạo dữ liệu cho 2 nhóm
|
||||
# Nhóm 1 có phân phối bị dịch chuyển, nhóm 2 thì không
|
||||
shift <- inputs$effect_size
|
||||
|
||||
if (inputs$dist_shape == "t_dist") {
|
||||
group1 <- rt(n, df = 5) + shift
|
||||
group2 <- rt(n, df = 5)
|
||||
} else if (inputs$dist_shape == "lnorm") {
|
||||
group1 <- rlnorm(n, meanlog = shift, sdlog = 1)
|
||||
group2 <- rlnorm(n, meanlog = 0, sdlog = 1)
|
||||
} else { # unif
|
||||
group1 <- runif(n, 0, 1) + shift
|
||||
group2 <- runif(n, 0, 1)
|
||||
}
|
||||
|
||||
# Thực hiện kiểm định Mann-Whitney U (wilcox.test cho 2 mẫu)
|
||||
wilcox.test(group1, group2, alternative = inputs$alternative)$p.value
|
||||
})
|
||||
|
||||
powers[i] <- mean(p_values < inputs$sig_level, na.rm = TRUE)
|
||||
|
||||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||||
|
||||
if (powers[i] >= inputs$target_power) {
|
||||
sample_sizes <- sample_sizes[1:i]
|
||||
powers <- powers[1:i]
|
||||
break
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
list(
|
||||
sample_sizes = sample_sizes,
|
||||
powers = powers,
|
||||
inputs = inputs
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- simulation_results()
|
||||
|
||||
required_n_index <- which(res$powers >= res$inputs$target_power)[1]
|
||||
|
||||
if (!is.na(required_n_index)) {
|
||||
required_n <- res$sample_sizes[required_n_index]
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size là", tags$b(res$inputs$effect_size), "với power là", tags$b(res$inputs$target_power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", required_n * 2, ".")
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500).")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- simulation_results()
|
||||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||||
|
||||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_point(color = "#007bff", size = 3) +
|
||||
geom_hline(yintercept = res$inputs$target_power, linetype = "dashed", color = "red") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power thực nghiệm (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
ggplot() +
|
||||
labs(title = "Phân tích này không được thực hiện tự động do thời gian tính toán lâu.",
|
||||
subtitle = "Vui lòng chạy lại với các giá trị Effect Size khác nhau để so sánh.") +
|
||||
theme_minimal()
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
211
samplesize/Onesampleztest/app.R
Normal file
211
samplesize/Onesampleztest/app.R
Normal file
@@ -0,0 +1,211 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Z một mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt, được chuẩn hóa bằng độ lệch chuẩn TỔNG THỂ (đã biết)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Sự khác biệt chính: Z-test vs. T-test"),
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Điểm mấu chốt:"),
|
||||
p("Sự lựa chọn giữa Z-test và T-test phụ thuộc vào việc bạn có biết độ lệch chuẩn của tổng thể (\\(\\sigma\\)) hay không."),
|
||||
tags$ul(
|
||||
tags$li(tags$b("Sử dụng Z-test khi:"), "Độ lệch chuẩn của tổng thể (\\(\\sigma\\)) đã biết. Điều này hiếm khi xảy ra trong thực tế, nhưng có thể xảy ra khi có một lượng lớn dữ liệu lịch sử (ví dụ: điểm thi chuẩn hóa toàn quốc, thông số trong một quy trình sản xuất đã được kiểm soát chặt chẽ)."),
|
||||
tags$li(tags$b("Sử dụng T-test khi:"), "Độ lệch chuẩn của tổng thể (\\(\\sigma\\)) không xác định và phải được ước tính từ độ lệch chuẩn của mẫu (\\(s\\)). Đây là trường hợp phổ biến nhất trong nghiên cứu.")
|
||||
),
|
||||
p("Khi cỡ mẫu rất lớn (thường > 30 hoặc > 100), phân phối t sẽ xấp xỉ phân phối chuẩn, và kết quả của hai kiểm định sẽ rất giống nhau.")
|
||||
),
|
||||
hr(),
|
||||
h4("Giả thuyết của Kiểm định Z một mẫu"),
|
||||
p("Kiểm định này so sánh trung bình của một mẫu duy nhất (\\(\\mu\\)) với một giá trị trung bình đã biết hoặc giả định (\\(\\mu_0\\)), khi \\(\\sigma\\) đã biết."),
|
||||
p("$$H_0: \\mu = \\mu_0$$"),
|
||||
p("$$H_a: \\mu \\neq \\mu_0 \\quad (\\text{hoặc } > \\text{ hoặc } <\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê Z được tính như sau:"),
|
||||
p("$$ Z = \\frac{\\bar{x} - \\mu_0}{\\sigma / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{x}\\) là trung bình mẫu, \\(\\sigma\\) là độ lệch chuẩn TỔNG THỂ, và \\(n\\) là cỡ mẫu."),
|
||||
|
||||
tags$b("2. Tính toán Power:"),
|
||||
p("Power được tính toán dựa trên phân phối chuẩn. Dưới giả thuyết đối \\(H_a\\), thống kê Z tuân theo phân phối chuẩn với trung bình là \\(d\\sqrt{n}\\).")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI CHO Z-TEST ---
|
||||
calculate_z_power <- function(n, d, sig_level, alternative) {
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_val_upper <- qnorm(1 - alpha)
|
||||
power <- pnorm(crit_val_upper - d * sqrt(n), lower.tail = FALSE) + pnorm(-crit_val_upper - d * sqrt(n), lower.tail = TRUE)
|
||||
} else { # one.sided (greater or less)
|
||||
crit_val <- qnorm(1 - sig_level)
|
||||
power <- pnorm(crit_val - abs(d) * sqrt(n), lower.tail = FALSE)
|
||||
}
|
||||
return(power)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Tìm cỡ mẫu cần thiết
|
||||
n <- 2 # Bắt đầu từ n nhỏ
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, input$d, input$sig_level, input$alternative)
|
||||
}
|
||||
required_n <- ifelse(n > 5000, NA, n)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
upper_bound <- if (!is.na(required_n)) required_n + 50 else 200
|
||||
sample_sizes <- seq(5, upper_bound, by = 1)
|
||||
|
||||
powers <- sapply(sample_sizes, function(s_n) {
|
||||
calculate_z_power(s_n, input$d, input$sig_level, input$alternative)
|
||||
})
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res) || is.na(res$required_n)) {
|
||||
return(tags$div(class = "alert alert-warning", "Không thể đạt được power mong muốn với cỡ mẫu tối đa (5000). Vui lòng xem xét lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu", x = "Cỡ mẫu (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, d_val, input$sig_level, input$alternative)
|
||||
}
|
||||
ifelse(n > 5000, NA, n)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
222
samplesize/PearsonCorrelationTest/app.R
Normal file
222
samplesize/PearsonCorrelationTest/app.R
Normal file
@@ -0,0 +1,222 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Tương quan Pearson"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
sliderInput("r",
|
||||
label = "Hệ số tương quan kỳ vọng (r):",
|
||||
value = 0.3, min = 0.1, max = 0.9, step = 0.05),
|
||||
helpText("Đây là effect size. Quy ước: 0.1 (nhỏ), 0.3 (trung bình), 0.5 (lớn)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
# Hiển thị công thức biến đổi Fisher's Z
|
||||
h5("Phép biến đổi Fisher's Z:"),
|
||||
uiOutput("fisher_z_formula_display"),
|
||||
helpText("Hệ số r được biến đổi thành Z để tính toán power.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Tương quan Pearson"),
|
||||
p("Kiểm định này kiểm tra xem có mối tương quan tuyến tính giữa hai biến liên tục hay không. Hệ số tương quan của tổng thể được ký hiệu là \\(\\rho\\)."),
|
||||
p("$$H_0: \\rho = 0$$"),
|
||||
p("$$H_a: \\rho \\neq 0 \\quad (\\text{hoặc } > 0 \\text{ hoặc } < 0\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (t-statistic):"),
|
||||
p("Để kiểm định ý nghĩa của hệ số tương quan mẫu (r), nó được chuyển đổi thành một giá trị t:"),
|
||||
p("$$ t = \\frac{r \\sqrt{n-2}}{\\sqrt{1-r^2}} $$"),
|
||||
p("Giá trị này tuân theo phân phối t với \\(n-2\\) bậc tự do."),
|
||||
|
||||
tags$b("2. Phép biến đổi Fisher's Z (dùng cho tính power):"),
|
||||
p("Để tính toán power, hệ số tương quan `r` được biến đổi sang thang đo Z, có phân phối gần chuẩn hơn:"),
|
||||
p("$$ Z_r = \\frac{1}{2} \\ln{\\left(\\frac{1+r}{1-r}\\right)} = \\text{arctanh}(r) $$"),
|
||||
p("Hàm `pwr.r.test` sử dụng phép biến đổi này để thực hiện các tính toán power."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu sức khỏe muốn tìm hiểu mối liên hệ giữa số giờ ngủ trung bình mỗi đêm và mức độ căng thẳng (stress) được đo bằng một thang điểm chuẩn hóa."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Biến 1: Số giờ ngủ (biến liên tục)."),
|
||||
tags$li("Biến 2: Điểm số căng thẳng (biến liên tục)."),
|
||||
tags$li("Phân tích: Tương quan Pearson sẽ được sử dụng để xem liệu có mối tương quan tuyến tính (âm) giữa hai biến này hay không.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi thu thập dữ liệu, nhà nghiên cứu cần biết cần khảo sát bao nhiêu người. Dựa trên các tài liệu, họ kỳ vọng một mối tương quan ở mức 'trung bình', khoảng \\(r = -0.3\\)."),
|
||||
p("Họ có thể nhập giá trị tuyệt đối của r (r = 0.3) vào ứng dụng, cùng với power và mức ý nghĩa mong muốn, để tìm ra cỡ mẫu cần thiết cho nghiên cứu.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Hiển thị công thức Fisher's Z
|
||||
output$fisher_z_formula_display <- renderUI({
|
||||
withMathJax("$$ Z_r = \\frac{1}{2} \\ln{\\left(\\frac{1+r}{1-r}\\right)} $$")
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$r, input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.r.test(
|
||||
r = input$r,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 100, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.r.test(
|
||||
n = sample_sizes,
|
||||
r = input$r,
|
||||
sig.level = input$sig_level,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một mối tương quan (r) là", tags$b(input$r), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu", x = "Cỡ mẫu (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 0.9, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(r_val) {
|
||||
res <- tryCatch({
|
||||
pwr.r.test(
|
||||
r = r_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Hệ số tương quan (r)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$r, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$r, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$r, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
244
samplesize/RepeatAnova/app.R
Normal file
244
samplesize/RepeatAnova/app.R
Normal file
@@ -0,0 +1,244 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Repeated Measures ANOVA"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("k", "Số lần đo lường lặp lại (k):", value = 3, min = 2),
|
||||
helpText("Ví dụ: đo lường tại 3 thời điểm (Baseline, 3 tháng, 6 tháng) thì k=3."),
|
||||
|
||||
numericInput("f",
|
||||
label = "Effect Size (Cohen's f):",
|
||||
value = 0.25, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's f đo lường độ lớn của sự khác biệt giữa các lần đo. Quy ước: 0.1 (nhỏ), 0.25 (trung bình), 0.4 (lớn)."),
|
||||
|
||||
sliderInput("epsilon",
|
||||
label = "Hệ số điều chỉnh Sphericity (ε):",
|
||||
min = 0.5, max = 1, value = 1, step = 0.05),
|
||||
helpText("Epsilon = 1 nếu giả định sphericity được đáp ứng. Giá trị nhỏ hơn cho thấy sự vi phạm. Sử dụng ước tính từ các nghiên cứu trước nếu có."),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
h5("Bậc tự do của tử số (u):"),
|
||||
uiOutput("df_numerator_display")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Số đối tượng"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Repeated Measures ANOVA"),
|
||||
p("Kiểm định này so sánh trung bình của ba hay nhiều lần đo lường trên cùng một nhóm đối tượng."),
|
||||
p("$$H_0: \\mu_1 = \\mu_2 = \\dots = \\mu_k$$"),
|
||||
p("$$H_a: \\text{Có ít nhất một cặp trung bình không bằng nhau}$$"),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Giả định Sphericity:"),
|
||||
p("Đây là một giả định quan trọng, cho rằng phương sai của sự khác biệt giữa các cặp đo lường là bằng nhau. Nếu giả định này bị vi phạm, kết quả có thể không chính xác. Hệ số điều chỉnh Epsilon (ε) được sử dụng để điều chỉnh bậc tự do, làm cho kiểm định trở nên chặt chẽ hơn. Epsilon = 1 có nghĩa là giả định được đáp ứng hoàn hảo.")
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Công thức tính toán"),
|
||||
p("Cỡ mẫu được tính toán dựa trên hàm `pwr.f2.test`, một công cụ cho các mô hình tuyến tính tổng quát."),
|
||||
tags$b("1. Bậc tự do của tử số (Numerator df - u):"),
|
||||
p("Bậc tự do này được điều chỉnh bởi epsilon:"),
|
||||
p("$$ u = (k - 1) \\times \\epsilon $$"),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's f):"),
|
||||
p("Tương tự như One-Way ANOVA, `f` đo lường độ lớn của sự khác biệt giữa các trung bình của các lần đo."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhóm nghiên cứu muốn đánh giá hiệu quả lâu dài của một loại vaccine mới. Họ đo nồng độ kháng thể trong máu của cùng một nhóm tình nguyện viên tại 3 thời điểm: 1 tháng, 6 tháng, và 12 tháng sau khi tiêm."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Thiết kế: Đo lường lặp lại (within-subjects)."),
|
||||
tags$li("Số lần đo (k): 3."),
|
||||
tags$li("Phân tích: Repeated Measures ANOVA sẽ được sử dụng để xem liệu nồng độ kháng thể trung bình có thay đổi một cách có ý nghĩa theo thời gian hay không.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi bắt đầu, họ cần biết cần bao nhiêu tình nguyện viên. Họ kỳ vọng một sự thay đổi ở mức 'trung bình' theo thời gian, và chọn effect size \\(f = 0.25\\). Họ cũng không chắc về giả định sphericity, nên dựa trên các nghiên cứu tương tự, họ ước tính một cách thận trọng với \\(\\epsilon = 0.85\\)."),
|
||||
p("Họ có thể nhập các giá trị này vào ứng dụng để tìm ra số lượng tình nguyện viên cần thiết cho nghiên cứu.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do tử số (u)
|
||||
u <- reactive({
|
||||
req(input$k, input$epsilon)
|
||||
(input$k - 1) * input$epsilon
|
||||
})
|
||||
|
||||
output$df_numerator_display <- renderUI({
|
||||
withMathJax(paste0("$$ u = (k-1)\\epsilon = ", round(u(), 2), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(u(), input$f, input$sig_level, input$power, input$k, input$epsilon)
|
||||
|
||||
f2 <- input$f^2
|
||||
|
||||
# pwr.f2.test giải ra v (bậc tự do mẫu số)
|
||||
pwr_result <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = f2,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
v <- pwr_result$v
|
||||
# Từ v, tính số đối tượng n
|
||||
# v = (n-1)*(k-1)*epsilon => n = v/((k-1)*epsilon) + 1
|
||||
required_n <- ceiling(v / ((input$k - 1) * input$epsilon) + 1)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
# Tính lại v cho mỗi n để tính power
|
||||
v_for_plot <- (sample_sizes - 1) * (input$k - 1) * input$epsilon
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
v = v_for_plot,
|
||||
f2 = f2,
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một sự khác biệt giữa các lần đo có độ lớn (f) là", tags$b(input$f), "với power là", tags$b(input$power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "đối tượng"))
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Số đối tượng", x = "Số đối tượng (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(u(), input$sig_level, input$power, input$k, input$epsilon)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.6, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(f_val) {
|
||||
res <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = f_val^2,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$v
|
||||
}, error = function(e) NA)
|
||||
|
||||
if(is.na(res)) return(NA)
|
||||
|
||||
ceiling(res / ((input$k - 1) * input$epsilon) + 1)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (f)",
|
||||
y = "Số đối tượng cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$f, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$f, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$f, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
239
samplesize/Shapiro-Wilk/app.R
Normal file
239
samplesize/Shapiro-Wilk/app.R
Normal file
@@ -0,0 +1,239 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib) # Để có giao diện hiện đại
|
||||
library(ggplot2) # Để vẽ đồ thị
|
||||
library(shinycssloaders) # Để thêm hiệu ứng tải
|
||||
|
||||
# Định nghĩa các lựa chọn phân phối một lần để sử dụng ở cả UI và Server
|
||||
dist_choices <- c("Chi-squared (df=3)" = "chisq",
|
||||
"Beta (alpha=2, beta=5)" = "beta",
|
||||
"Phân phối t (df=5)" = "t",
|
||||
"Gamma (shape=2, rate=1.5)" = "gamma")
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
# Sử dụng theme Bootstrap hiện đại
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
|
||||
# MathJax để hiển thị công thức toán học
|
||||
withMathJax(),
|
||||
|
||||
# Tiêu đề của ứng dụng
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Chuẩn Shapiro-Wilk"),
|
||||
|
||||
# Bố cục sidebar
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
# Chọn phân phối của giả thuyết đối (H1)
|
||||
selectInput("alt_dist",
|
||||
label = "Phân phối của giả thuyết đối (H1):",
|
||||
choices = dist_choices,
|
||||
selected = "chisq"),
|
||||
|
||||
# Thanh trượt cho mức ý nghĩa (alpha)
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
# Thanh trượt cho power mong muốn
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
# Số lần lặp mô phỏng
|
||||
numericInput("n_sims",
|
||||
label = "Số lần lặp mô phỏng:",
|
||||
value = 500, min = 100, max = 5000),
|
||||
|
||||
hr(),
|
||||
helpText("Kết quả chính và đồ thị Power sẽ tự động cập nhật. Chuyển sang tab 'Phân tích Mức ý nghĩa' để chạy các phân tích sâu hơn.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
# Sử dụng tab để tổ chức kết quả
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
# Tab 1: Kết quả tính toán
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả ước tính"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
# Tab 2: Đồ thị Power
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
# Tab 3: Phân tích Mức ý nghĩa (MỚI)
|
||||
tabPanel(
|
||||
"Phân tích Mức ý nghĩa",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Mức ý nghĩa (\\(\\alpha\\))"),
|
||||
p("Phân tích này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi bạn điều chỉnh mức ý nghĩa alpha (với power và phân phối được giữ cố định từ các tham số chính)."),
|
||||
p("Vì tính toán này khá nặng, vui lòng nhấn nút bên dưới để bắt đầu."),
|
||||
actionButton("run_alpha_analysis", "Chạy phân tích Alpha", class = "btn-success mb-3"),
|
||||
withSpinner(plotOutput("alpha_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
# Tab 4: Công thức và phương pháp
|
||||
tabPanel(
|
||||
"Giả thuyết và Phương pháp",
|
||||
h4("Giả thuyết của Kiểm định Shapiro-Wilk"),
|
||||
p("$$H_0: \\text{Dữ liệu tuân theo phân phối chuẩn}$$"),
|
||||
p("$$H_a: \\text{Dữ liệu không tuân theo phân phối chuẩn}$$"),
|
||||
hr(),
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Chúng tôi sử dụng phương pháp mô phỏng Monte Carlo... (giải thích chi tiết)")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH (TỰ ĐỘNG) ---
|
||||
|
||||
reactive_inputs <- reactive({
|
||||
list(
|
||||
sig_level = input$sig_level,
|
||||
power = input$power,
|
||||
alt_dist = input$alt_dist,
|
||||
n_sims = input$n_sims
|
||||
)
|
||||
})
|
||||
|
||||
debounced_inputs <- debounce(reactive_inputs, 1000)
|
||||
|
||||
simulation_results <- reactive({
|
||||
inputs <- debounced_inputs()
|
||||
sig_level <- inputs$sig_level
|
||||
target_power <- inputs$power
|
||||
alt_dist <- inputs$alt_dist
|
||||
n_sims <- inputs$n_sims
|
||||
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
powers <- numeric(length(sample_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy mô phỏng chính...', value = 0, {
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
p_values <- replicate(n_sims, {
|
||||
if (alt_dist == "chisq") random_data <- rchisq(n, df = 3)
|
||||
else if (alt_dist == "beta") random_data <- rbeta(n, shape1 = 2, shape2 = 5)
|
||||
else if (alt_dist == "t") random_data <- rt(n, df = 5)
|
||||
else if (alt_dist == "gamma") random_data <- rgamma(n, shape = 2, rate = 1.5)
|
||||
shapiro.test(random_data)$p.value
|
||||
})
|
||||
powers[i] <- mean(p_values < sig_level)
|
||||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||||
if (powers[i] >= target_power) {
|
||||
sample_sizes <- sample_sizes[1:i]
|
||||
powers <- powers[1:i]
|
||||
break
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
list(
|
||||
sample_sizes = sample_sizes,
|
||||
powers = powers,
|
||||
target_power = target_power,
|
||||
sig_level = sig_level,
|
||||
alt_dist_name = names(dist_choices)[dist_choices == alt_dist]
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- simulation_results()
|
||||
first_index_above_power <- which(res$powers >= res$target_power)[1]
|
||||
if (!is.na(first_index_above_power)) {
|
||||
required_n <- res$sample_sizes[first_index_above_power]
|
||||
tagList(
|
||||
tags$p("Để phát hiện phân phối không chuẩn dạng", tags$b(res$alt_dist_name), "với power là", tags$b(res$target_power), "và mức ý nghĩa", tags$b(res$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", required_n)
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500).")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- simulation_results()
|
||||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) + geom_point(color = "#007bff", size = 3) +
|
||||
geom_hline(yintercept = res$target_power, linetype = "dashed", color = "red") +
|
||||
labs(title = paste("Power của Kiểm định Shapiro-Wilk vs. Phân phối", res$alt_dist_name), x = "Cỡ mẫu (n)", y = "Power thực nghiệm (1 - β)") +
|
||||
theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH ALPHA (CHẠY KHI BẤM NÚT) ---
|
||||
|
||||
alpha_analysis_results <- eventReactive(input$run_alpha_analysis, {
|
||||
# Lấy các tham số cố định từ input
|
||||
target_power <- input$power
|
||||
alt_dist <- input$alt_dist
|
||||
n_sims <- input$n_sims
|
||||
|
||||
# Dãy các giá trị alpha để phân tích
|
||||
alpha_values <- seq(0.01, 0.15, by = 0.01)
|
||||
required_n_values <- numeric(length(alpha_values))
|
||||
|
||||
withProgress(message = 'Đang chạy phân tích Alpha...', value = 0, {
|
||||
# Vòng lặp qua từng giá trị alpha
|
||||
for (j in 1:length(alpha_values)) {
|
||||
current_alpha <- alpha_values[j]
|
||||
|
||||
# Logic tìm cỡ mẫu cho alpha hiện tại
|
||||
sample_sizes <- seq(10, 500, by = 10) # Dùng bước nhảy lớn hơn để nhanh hơn
|
||||
required_n <- NA
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
p_values <- replicate(n_sims, {
|
||||
if (alt_dist == "chisq") random_data <- rchisq(n, df = 3)
|
||||
else if (alt_dist == "beta") random_data <- rbeta(n, shape1 = 2, shape2 = 5)
|
||||
else if (alt_dist == "t") random_data <- rt(n, df = 5)
|
||||
else if (alt_dist == "gamma") random_data <- rgamma(n, shape = 2, rate = 1.5)
|
||||
shapiro.test(random_data)$p.value
|
||||
})
|
||||
|
||||
current_power <- mean(p_values < current_alpha)
|
||||
|
||||
if (current_power >= target_power) {
|
||||
required_n <- n
|
||||
break
|
||||
}
|
||||
}
|
||||
required_n_values[j] <- required_n
|
||||
incProgress(1/length(alpha_values), detail = paste("Alpha =", current_alpha))
|
||||
}
|
||||
})
|
||||
|
||||
data.frame(Alpha = alpha_values, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$alpha_analysis_plot <- renderPlot({
|
||||
plot_data <- alpha_analysis_results()
|
||||
|
||||
ggplot(plot_data, aes(x = Alpha, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Mức ý nghĩa (Power cố định =", input$power, ")"),
|
||||
x = "Mức ý nghĩa (α)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
214
samplesize/SpearmanCorrelationTest/app.R
Normal file
214
samplesize/SpearmanCorrelationTest/app.R
Normal file
@@ -0,0 +1,214 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Tương quan hạng Spearman"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
sliderInput("rho",
|
||||
label = "Hệ số tương quan Spearman kỳ vọng (ρ):",
|
||||
value = 0.3, min = 0.1, max = 0.9, step = 0.05),
|
||||
helpText("Đây là effect size. Quy ước tương tự Pearson: 0.1 (nhỏ), 0.3 (trung bình), 0.5 (lớn)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Lưu ý: Tính toán dựa trên phép xấp xỉ bằng phân tích power của tương quan Pearson.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Tương quan Spearman"),
|
||||
p("Kiểm định này kiểm tra xem có mối tương quan đơn điệu (monotonic) giữa hai biến hay không. Hệ số tương quan hạng của tổng thể được ký hiệu là \\(\\rho_s\\)."),
|
||||
p("$$H_0: \\rho_s = 0$$"),
|
||||
p("$$H_a: \\rho_s \\neq 0 \\quad (\\text{hoặc } > 0 \\text{ hoặc } < 0\\text{)}$$"),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Khi nào sử dụng?"),
|
||||
p("Sử dụng kiểm định này thay cho tương quan Pearson khi:"),
|
||||
tags$ul(
|
||||
tags$li("Mối quan hệ giữa hai biến không phải là tuyến tính, nhưng có tính đơn điệu (cùng tăng hoặc cùng giảm)."),
|
||||
tags$li("Dữ liệu không tuân theo phân phối chuẩn."),
|
||||
tags$li("Dữ liệu ở dạng thứ hạng (ordinal)."),
|
||||
tags$li("Có các giá trị ngoại lai (outliers) ảnh hưởng đến kết quả của Pearson.")
|
||||
)
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Phân tích power cho tương quan Spearman thường được xấp xỉ bằng phân tích cho tương quan Pearson. Phương pháp này hoạt động tốt vì tương quan Spearman về bản chất chính là tương quan Pearson trên dữ liệu đã được xếp hạng. Ứng dụng này sử dụng hàm `pwr.r.test` để thực hiện phép xấp xỉ này."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà xã hội học muốn nghiên cứu mối liên hệ giữa tình trạng kinh tế-xã hội (được xếp hạng từ 1 đến 10) và mức độ tiếp cận dịch vụ y tế (cũng được xếp hạng từ 1 đến 10) của các cộng đồng dân cư."),
|
||||
p(tags$b("Tại sao dùng Spearman?")),
|
||||
p("Vì cả hai biến đều ở dạng thứ hạng (ordinal), tương quan Spearman là phương pháp phân tích phù hợp nhất."),
|
||||
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu kỳ vọng một mối tương quan dương ở mức 'trung bình', khoảng \\(\\rho_s = 0.35\\). Họ có thể nhập giá trị này vào ứng dụng để tìm ra số lượng cộng đồng cần khảo sát để có đủ power phát hiện mối liên hệ này.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$rho, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Sử dụng pwr.r.test như một phép xấp xỉ
|
||||
pwr_result <- tryCatch({
|
||||
pwr.r.test(
|
||||
r = input$rho,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 100, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.r.test(
|
||||
n = sample_sizes,
|
||||
r = input$rho,
|
||||
sig.level = input$sig_level,
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một mối tương quan Spearman (ρ) là", tags$b(input$rho), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu", x = "Cỡ mẫu (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 0.9, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(r_val) {
|
||||
res <- tryCatch({
|
||||
pwr.r.test(
|
||||
r = r_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Hệ số tương quan Spearman (ρ)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$rho, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$rho, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$rho, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
253
samplesize/TwowayANOVA/app.R
Normal file
253
samplesize/TwowayANOVA/app.R
Normal file
@@ -0,0 +1,253 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Phân tích phương sai hai yếu tố (Two-Way ANOVA)"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("a", "Số mức của Yếu tố A:", value = 2, min = 2),
|
||||
numericInput("b", "Số mức của Yếu tố B:", value = 3, min = 2),
|
||||
|
||||
selectInput("effect_of_interest", "Hiệu ứng cần tính cỡ mẫu:",
|
||||
choices = c("Hiệu ứng tương tác (A x B)" = "interaction",
|
||||
"Hiệu ứng chính của A" = "main_A",
|
||||
"Hiệu ứng chính của B" = "main_B")),
|
||||
|
||||
numericInput("f2",
|
||||
label = "Effect Size (Cohen's f-squared):",
|
||||
value = 0.15, min = 0.01, step = 0.01),
|
||||
helpText("Cohen's f-squared (f²) đo lường độ lớn của hiệu ứng. Quy ước: 0.02 (nhỏ), 0.15 (trung bình), 0.35 (lớn)."),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
h5("Bậc tự do của tử số (u):"),
|
||||
uiOutput("df_numerator_display")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Two-Way ANOVA"),
|
||||
p("Two-Way ANOVA kiểm tra ba bộ giả thuyết khác nhau:"),
|
||||
tags$ol(
|
||||
tags$li(tags$b("Hiệu ứng chính của Yếu tố A:"), "So sánh trung bình giữa các mức của yếu tố A. \\(H_0: \\mu_{A1} = \\mu_{A2} = \\dots\\)"),
|
||||
tags$li(tags$b("Hiệu ứng chính của Yếu tố B:"), "So sánh trung bình giữa các mức của yếu tố B. \\(H_0: \\mu_{B1} = \\mu_{B2} = \\dots\\)"),
|
||||
tags$li(tags$b("Hiệu ứng tương tác (A x B):"), "Kiểm tra xem hiệu ứng của yếu tố A có phụ thuộc vào mức của yếu tố B hay không (và ngược lại). \\(H_0: \\text{Không có sự tương tác}\\)")
|
||||
),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Bậc tự do của tử số (Numerator df - u):"),
|
||||
p("Giá trị `u` phụ thuộc vào hiệu ứng bạn đang kiểm tra:"),
|
||||
p("$$ u_{A} = a - 1 $$"),
|
||||
p("$$ u_{B} = b - 1 $$"),
|
||||
p("$$ u_{A \\times B} = (a - 1)(b - 1) $$"),
|
||||
p("Trong đó `a` và `b` là số mức của yếu tố A và B."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's f-squared):"),
|
||||
p("Cohen's f² đo lường tỷ lệ phương sai được giải thích bởi một hiệu ứng, so với phương sai không được giải thích."),
|
||||
p("$$ f^2 = \\frac{R^2_{effect}}{1 - R^2_{effect}} $$"),
|
||||
p("Trong đó \\(R^2_{effect}\\) là tỷ lệ phương sai được giải thích bởi hiệu ứng đang xét."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Các nhà nghiên cứu muốn đánh giá hiệu quả của một can thiệp mới (ví dụ: một ứng dụng di động về sức khỏe) trong việc tăng số bước đi trung bình hàng ngày. Họ cũng muốn biết liệu hiệu quả của can thiệp có khác nhau giữa nam và nữ hay không."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Yếu tố A (Can thiệp): Nhóm dùng app, Nhóm đối chứng (không dùng app). (a=2)"),
|
||||
tags$li("Yếu tố B (Giới tính): Nam, Nữ. (b=2)"),
|
||||
tags$li("Phân tích: Two-Way ANOVA."),
|
||||
tags$li(tags$b("Câu hỏi chính (Hiệu ứng tương tác):"), "Liệu ứng dụng có hiệu quả hơn đối với nam hay nữ không? Để trả lời câu hỏi này, họ cần tính cỡ mẫu để có đủ power phát hiện hiệu ứng tương tác.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu chọn 'Hiệu ứng tương tác' trong ứng dụng. Họ kỳ vọng một hiệu ứng ở mức 'trung bình', và chọn \\(f^2 = 0.15\\). Họ nhập các giá trị này vào ứng dụng để tìm ra số người cần thiết cho mỗi ô trong thiết kế (nam/dùng app, nữ/dùng app, nam/không dùng, nữ/không dùng).")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do tử số (u)
|
||||
u <- reactive({
|
||||
req(input$a, input$b, input$effect_of_interest)
|
||||
if (input$effect_of_interest == "main_A") {
|
||||
return(input$a - 1)
|
||||
} else if (input$effect_of_interest == "main_B") {
|
||||
return(input$b - 1)
|
||||
} else { # interaction
|
||||
return((input$a - 1) * (input$b - 1))
|
||||
}
|
||||
})
|
||||
|
||||
output$df_numerator_display <- renderUI({
|
||||
withMathJax(paste0("$$ u = ", u(), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(u(), input$f2, input$sig_level, input$power, input$a, input$b)
|
||||
|
||||
# pwr.f2.test giải ra v (bậc tự do mẫu số)
|
||||
pwr_result <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = input$f2,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
v <- pwr_result$v
|
||||
# Từ v, tính tổng cỡ mẫu N và cỡ mẫu mỗi ô n
|
||||
# v = N - a*b => N = v + a*b
|
||||
total_N <- ceiling(v + (input$a * input$b))
|
||||
required_n_per_cell <- ceiling(total_N / (input$a * input$b))
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
sample_sizes_per_cell <- seq(5, required_n_per_cell + 50, by = 1)
|
||||
|
||||
# Tính lại v cho mỗi n để tính power
|
||||
v_for_plot <- (sample_sizes_per_cell * input$a * input$b) - (input$a * input$b)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
v = v_for_plot,
|
||||
f2 = input$f2,
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n_per_cell, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n_per_cell,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes_per_cell, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một", tags$b(names(which(c("interaction"="Hiệu ứng tương tác (A x B)", "main_A"="Hiệu ứng chính của A", "main_B"="Hiệu ứng chính của B") == input$effect_of_interest))), "có độ lớn (f²) là", tags$b(input$f2), "với power là", tags$b(input$power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi ô (cell)")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * input$a * input$b, ".")
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi ô)", x = "Cỡ mẫu cho mỗi ô (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(u(), input$sig_level, input$power, input$a, input$b)
|
||||
|
||||
effect_sizes <- seq(0.01, 0.5, by = 0.01)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(f2_val) {
|
||||
res <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = f2_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$v
|
||||
}, error = function(e) NA)
|
||||
|
||||
if(is.na(res)) return(NA)
|
||||
|
||||
total_N <- res + (input$a * input$b)
|
||||
ceiling(total_N / (input$a * input$b))
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (f²)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi ô (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$f2, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$f2, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$f2, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
203
samplesize/Wilcoxon-Signed-Rank/app.R
Normal file
203
samplesize/Wilcoxon-Signed-Rank/app.R
Normal file
@@ -0,0 +1,203 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(sn) # Gói để tạo phân phối lệch
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Dấu-Hạng Wilcoxon"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
selectInput("dist_shape", "Hình dạng phân phối của sự khác biệt:",
|
||||
choices = c("Đối xứng, đuôi dày (t, df=5)" = "t_dist",
|
||||
"Lệch phải (Skew-Normal)" = "skew_right",
|
||||
"Đối xứng (Normal)" = "normal")),
|
||||
|
||||
numericInput("effect_size",
|
||||
label = "Effect Size (Median Shift / SD):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Đây là độ lớn của sự dịch chuyển của trung vị (median), được chuẩn hóa bằng độ lệch chuẩn của sự khác biệt."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
numericInput("n_sims",
|
||||
label = "Số lần lặp mô phỏng:",
|
||||
value = 500, min = 100, max = 5000),
|
||||
|
||||
hr(),
|
||||
actionButton("calculate", "Bắt đầu tính toán", class = "btn-primary"),
|
||||
helpText("Vì tính toán dựa trên mô phỏng, quá trình có thể mất vài giây.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Số cặp"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Dấu-Hạng Wilcoxon"),
|
||||
p("Đây là kiểm định phi tham số thay thế cho kiểm định t ghép cặp. Nó kiểm tra xem liệu trung vị (median) của sự khác biệt trong các cặp có bằng 0 hay không."),
|
||||
p("$$H_0: \\text{Median của sự khác biệt} = 0$$"),
|
||||
p("$$H_a: \\text{Median của sự khác biệt} \\neq 0 \\quad (\\text{hoặc } > 0 \\text{ hoặc } < 0\\text{)}$$"),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Khi nào sử dụng?"),
|
||||
p("Sử dụng kiểm định này thay cho kiểm định t ghép cặp khi giả định về phân phối chuẩn của sự khác biệt không được đáp ứng (ví dụ: dữ liệu bị lệch nhiều hoặc có các giá trị ngoại lai).")
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Phương pháp tính toán"),
|
||||
p("Vì không có công thức giải tích đơn giản, ứng dụng sử dụng phương pháp mô phỏng Monte Carlo để ước tính cỡ mẫu. Quá trình này bao gồm việc tạo ra hàng nghìn bộ dữ liệu giả định, áp dụng kiểm định cho từng bộ, và đếm tỷ lệ các kiểm định phát hiện ra hiệu ứng."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một chương trình can thiệp nhằm giảm số lượng đồ uống có đường mà thanh thiếu niên tiêu thụ mỗi tuần. Nhà nghiên cứu đo lường số lượng đồ uống trước và sau chương trình."),
|
||||
p(tags$b("Tại sao dùng Wilcoxon?")),
|
||||
p("Sự thay đổi trong hành vi này có thể không tuân theo phân phối chuẩn. Nhiều người có thể không thay đổi (khác biệt = 0), một số thay đổi ít, và một số ít thay đổi rất nhiều, tạo ra một phân phối bị lệch. Do đó, kiểm định trung vị (median) sẽ phù hợp và mạnh mẽ hơn là kiểm định trung bình (mean)."),
|
||||
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu cần xác định số lượng thanh thiếu niên cần tham gia. Họ kỳ vọng một sự thay đổi có effect size khoảng 0.4. Họ có thể nhập các giá trị này vào ứng dụng để tìm ra số cặp cần thiết cho nghiên cứu của mình.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
simulation_results <- eventReactive(input$calculate, {
|
||||
|
||||
inputs <- list(
|
||||
dist_shape = input$dist_shape,
|
||||
effect_size = input$effect_size,
|
||||
alternative = input$alternative,
|
||||
sig_level = input$sig_level,
|
||||
target_power = input$power,
|
||||
n_sims = input$n_sims
|
||||
)
|
||||
|
||||
sample_sizes <- seq(10, 500, by = 5)
|
||||
powers <- numeric(length(sample_sizes))
|
||||
|
||||
withProgress(message = 'Đang chạy mô phỏng...', value = 0, {
|
||||
|
||||
for (i in 1:length(sample_sizes)) {
|
||||
n <- sample_sizes[i]
|
||||
|
||||
p_values <- replicate(inputs$n_sims, {
|
||||
|
||||
# Tạo dữ liệu khác biệt từ phân phối đã chọn
|
||||
if (inputs$dist_shape == "t_dist") {
|
||||
random_data <- rt(n, df = 5) + inputs$effect_size
|
||||
} else if (inputs$dist_shape == "skew_right") {
|
||||
# Sử dụng gói 'sn' để tạo dữ liệu lệch
|
||||
random_data <- rsn(n, xi = inputs$effect_size, omega = 1, alpha = 4)
|
||||
} else { # normal
|
||||
random_data <- rnorm(n, mean = inputs$effect_size, sd = 1)
|
||||
}
|
||||
|
||||
# Thực hiện kiểm định Wilcoxon Signed-Rank
|
||||
# mu=0 là giả thuyết không
|
||||
wilcox.test(random_data, mu = 0, alternative = inputs$alternative)$p.value
|
||||
})
|
||||
|
||||
powers[i] <- mean(p_values < inputs$sig_level, na.rm = TRUE)
|
||||
|
||||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||||
|
||||
if (powers[i] >= inputs$target_power) {
|
||||
sample_sizes <- sample_sizes[1:i]
|
||||
powers <- powers[1:i]
|
||||
break
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
list(
|
||||
sample_sizes = sample_sizes,
|
||||
powers = powers,
|
||||
inputs = inputs
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- simulation_results()
|
||||
|
||||
required_n_index <- which(res$powers >= res$inputs$target_power)[1]
|
||||
|
||||
if (!is.na(required_n_index)) {
|
||||
required_n <- res$sample_sizes[required_n_index]
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size là", tags$b(res$inputs$effect_size), "với power là", tags$b(res$inputs$target_power), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(required_n, "cặp quan sát"))
|
||||
)
|
||||
} else {
|
||||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500).")
|
||||
}
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- simulation_results()
|
||||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||||
|
||||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_point(color = "#007bff", size = 3) +
|
||||
geom_hline(yintercept = res$inputs$target_power, linetype = "dashed", color = "red") +
|
||||
labs(title = "Power vs. Số cặp", x = "Số cặp (n)", y = "Power thực nghiệm (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
# Phân tích này rất nặng, nên có thể để trống hoặc đơn giản hóa
|
||||
# Hiện tại để trống để tránh thời gian chờ quá lâu
|
||||
ggplot() +
|
||||
labs(title = "Phân tích này không được thực hiện tự động do thời gian tính toán lâu.",
|
||||
subtitle = "Vui lòng chạy lại với các giá trị Effect Size khác nhau để so sánh.") +
|
||||
theme_minimal()
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
66
samplesize/aa/app.R
Normal file
66
samplesize/aa/app.R
Normal file
@@ -0,0 +1,66 @@
|
||||
library(shiny)
|
||||
library(pwr)
|
||||
library(ggplot2)
|
||||
library(latex2exp)
|
||||
|
||||
ui <- fluidPage(
|
||||
titlePanel("Tính cỡ mẫu cho kiểm định t-test một mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
numericInput("delta", "Hiệu ứng (mean difference):", value = 0.5, step = 0.1),
|
||||
numericInput("sd", "Độ lệch chuẩn (standard deviation):", value = 1, step = 0.1),
|
||||
numericInput("sig.level", "Mức ý nghĩa (alpha):", value = 0.05, min = 0.001, max = 0.1, step = 0.01),
|
||||
numericInput("power", "Độ mạnh kiểm định mong muốn (power):", value = 0.8, min = 0.5, max = 0.99, step = 0.01)
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
h4("Công thức tính cỡ mẫu (LaTeX):"),
|
||||
uiOutput("latexFormula"),
|
||||
h4("Kết quả tính cỡ mẫu:"),
|
||||
verbatimTextOutput("sampleSize"),
|
||||
h4("Biểu đồ: Power vs. Sample Size"),
|
||||
plotOutput("powerPlot")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
server <- function(input, output) {
|
||||
output$sampleSize <- renderPrint({
|
||||
result <- pwr.t.test(d = input$delta / input$sd,
|
||||
sig.level = input$sig.level,
|
||||
power = input$power,
|
||||
type = "one.sample",
|
||||
alternative = "two.sided")
|
||||
result$n
|
||||
})
|
||||
|
||||
output$latexFormula <- renderUI({
|
||||
withMathJax(
|
||||
helpText('$$n = \\left( \\frac{(z_{1-\\alpha/2} + z_{power}) \\cdot \\sigma}{\\delta} \\right)^2$$')
|
||||
)
|
||||
})
|
||||
|
||||
output$powerPlot <- renderPlot({
|
||||
sample_sizes <- seq(5, 100, by = 1)
|
||||
powers <- sapply(sample_sizes, function(n) {
|
||||
pwr.t.test(n = n,
|
||||
d = input$delta / input$sd,
|
||||
sig.level = input$sig.level,
|
||||
type = "one.sample",
|
||||
alternative = "two.sided")$power
|
||||
})
|
||||
|
||||
df <- data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
|
||||
ggplot(df, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "blue", size = 1) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
labs(title = "Quan hệ giữa Power và Cỡ mẫu",
|
||||
x = "Cỡ mẫu",
|
||||
y = "Power") +
|
||||
theme_minimal()
|
||||
})
|
||||
}
|
||||
|
||||
shinyApp(ui = ui, server = server)
|
||||
218
samplesize/anova/app.R
Normal file
218
samplesize/anova/app.R
Normal file
@@ -0,0 +1,218 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Phân tích phương sai một yếu tố (One-Way ANOVA)"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("k", "Số lượng nhóm so sánh (k):", value = 3, min = 2),
|
||||
|
||||
numericInput("f",
|
||||
label = "Effect Size (Cohen's f):",
|
||||
value = 0.25, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's f đo lường độ lớn của sự khác biệt giữa các trung bình nhóm. Quy ước: 0.1 (nhỏ), 0.25 (trung bình), 0.4 (lớn)."),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
h5("Công thức Effect Size (f):"),
|
||||
# Hiển thị công thức tính effect size
|
||||
uiOutput("effect_size_formula_display")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của One-Way ANOVA"),
|
||||
p("Phân tích phương sai một yếu tố (One-Way ANOVA) được sử dụng để so sánh trung bình của ba hay nhiều nhóm độc lập."),
|
||||
p("$$H_0: \\mu_1 = \\mu_2 = \\dots = \\mu_k$$"),
|
||||
p("$$H_a: \\text{Có ít nhất một cặp trung bình không bằng nhau}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (F-statistic):"),
|
||||
p("Giá trị thống kê F so sánh sự biến thiên giữa các nhóm (Mean Square Between) với sự biến thiên bên trong mỗi nhóm (Mean Square Within)."),
|
||||
p("$$ F = \\frac{MS_{between}}{MS_{within}} $$"),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's f):"),
|
||||
p("Cohen's f đo lường độ lớn của sự khác biệt giữa các trung bình nhóm, được chuẩn hóa bằng độ lệch chuẩn bên trong nhóm."),
|
||||
p("$$ f = \\frac{\\sigma_m}{\\sigma} $$"),
|
||||
p("Trong đó \\(\\sigma_m\\) là độ lệch chuẩn của các trung bình nhóm và \\(\\sigma\\) là độ lệch chuẩn bên trong mỗi nhóm."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu muốn so sánh hiệu quả của ba liệu pháp khác nhau (A: thuốc mới, B: thuốc tiêu chuẩn, C: giả dược) trong việc giảm mức cholesterol ở bệnh nhân."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Số lượng nhóm (k): 3."),
|
||||
tags$li("Phân tích: One-Way ANOVA sẽ được sử dụng để xem liệu có sự khác biệt đáng kể về mức giảm cholesterol trung bình giữa ba nhóm hay không.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi tuyển bệnh nhân, nhà nghiên cứu cần xác định số lượng cho mỗi nhóm. Dựa trên các nghiên cứu sơ bộ, họ kỳ vọng một sự khác biệt ở mức 'trung bình' giữa các liệu pháp. Họ chọn một effect size \\(f = 0.25\\)."),
|
||||
p("Họ có thể nhập các giá trị này (k=3, f=0.25, power=0.8, alpha=0.05) vào ứng dụng để tìm ra số bệnh nhân cần thiết cho mỗi nhóm trị liệu.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Hiển thị công thức tính effect size
|
||||
output$effect_size_formula_display <- renderUI({
|
||||
withMathJax("$$ f = \\sqrt{\\frac{\\sum_{i=1}^{k} p_i(\\mu_i - \\bar{\\mu})^2}{\\sigma^2}} $$")
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$k, input$f, input$sig_level, input$power)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.anova.test(
|
||||
k = input$k,
|
||||
f = input$f,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.anova.test(
|
||||
k = input$k,
|
||||
n = sample_sizes,
|
||||
f = input$f,
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một sự khác biệt giữa", tags$b(input$k), "nhóm có độ lớn (effect size f) là", tags$b(input$f), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * input$k, ".")
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$k, input$sig_level, input$power)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.6, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(f_val) {
|
||||
res <- tryCatch({
|
||||
pwr.anova.test(
|
||||
k = input$k,
|
||||
f = f_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (f)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$f, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$f, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$f, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
242
samplesize/chisquare/app.R
Normal file
242
samplesize/chisquare/app.R
Normal file
@@ -0,0 +1,242 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Độc lập Chi bình phương"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("w",
|
||||
label = "Effect Size (w):",
|
||||
value = 0.3, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's w đo lường độ lớn của mối liên hệ. Quy ước: 0.1 (nhỏ), 0.3 (trung bình), 0.5 (lớn)."),
|
||||
|
||||
numericInput("rows", "Số hàng của bảng:", value = 2, min = 2),
|
||||
numericInput("cols", "Số cột của bảng:", value = 2, min = 2),
|
||||
|
||||
# Hiển thị bậc tự do được tính toán
|
||||
uiOutput("df_display"),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.chisq.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Tổng Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy tổng cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Độc lập Chi bình phương"),
|
||||
p("Kiểm định này được sử dụng để xác định xem có mối liên hệ (association) giữa hai biến phân loại hay không."),
|
||||
p("$$H_0: \\text{Hai biến là độc lập (không có mối liên hệ)}$$"),
|
||||
p("$$H_a: \\text{Hai biến không độc lập (có mối liên hệ)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê \\(\\chi^2\\) được tính như sau:"),
|
||||
p("$$ \\chi^2 = \\sum \\frac{(O_{ij} - E_{ij})^2}{E_{ij}} $$"),
|
||||
p("Trong đó \\(O_{ij}\\) là tần số quan sát và \\(E_{ij}\\) là tần số kỳ vọng trong ô (hàng i, cột j) của bảng chéo."),
|
||||
|
||||
tags$b("2. Bậc tự do (Degrees of Freedom - df):"),
|
||||
p("$$ df = (\\text{số hàng} - 1) \\times (\\text{số cột} - 1) $$"),
|
||||
|
||||
tags$b("3. Effect Size (w):"),
|
||||
p("Cohen's w là một thước đo độ lớn của mối liên hệ, được tính từ giá trị Chi bình phương:"),
|
||||
p("$$ w = \\sqrt{ \\frac{\\chi^2}{N} } $$"),
|
||||
p("Trong đó N là tổng cỡ mẫu. Để tính toán cỡ mẫu, bạn cần ước tính giá trị `w` mà bạn kỳ vọng sẽ phát hiện được."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà dịch tễ học muốn nghiên cứu mối liên hệ giữa tình trạng hút thuốc lá và sự xuất hiện của bệnh ung thư phổi. Họ thu thập dữ liệu và lập một bảng chéo 2x2."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Biến 1 (Hàng): Tình trạng hút thuốc (Hút thuốc, Không hút thuốc)."),
|
||||
tags$li("Biến 2 (Cột): Tình trạng bệnh (Mắc ung thư phổi, Không mắc ung thư phổi)."),
|
||||
tags$li("Bảng chéo: 2 hàng và 2 cột."),
|
||||
tags$li("Bậc tự do (df): (2-1) x (2-1) = 1.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi tiến hành nghiên cứu, nhà dịch tễ học muốn biết cần bao nhiêu người tham gia. Dựa trên các tài liệu y văn, họ kỳ vọng sẽ tìm thấy một mối liên hệ ở mức độ 'trung bình', và chọn effect size \\(w = 0.3\\)."),
|
||||
p("Họ có thể nhập các giá trị này (w=0.3, df=1, power=0.8, alpha=0.05) vào ứng dụng để tìm ra tổng cỡ mẫu cần thiết cho nghiên cứu của mình.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do (df) một cách reactive
|
||||
df <- reactive({
|
||||
req(input$rows, input$cols)
|
||||
(input$rows - 1) * (input$cols - 1)
|
||||
})
|
||||
|
||||
# Hiển thị df ra giao diện
|
||||
output$df_display <- renderUI({
|
||||
tagList(
|
||||
tags$p(tags$b("Bậc tự do (df) = "), df())
|
||||
)
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$w, df(), input$sig_level, input$power)
|
||||
|
||||
# Bậc tự do phải > 0
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = input$w,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$N)
|
||||
|
||||
sample_sizes <- seq(10, required_n + 100, by = 2)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
N = sample_sizes,
|
||||
w = input$w,
|
||||
df = df(),
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$N, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
if (df() <= 0) {
|
||||
return(tags$div(class = "alert alert-warning", "Bậc tự do phải lớn hơn 0. Vui lòng kiểm tra lại số hàng và số cột."))
|
||||
}
|
||||
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một mối liên hệ có độ lớn (effect size w) là", tags$b(input$w), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một tổng cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
req(main_results(), main_results()$power_plot_data)
|
||||
res <- main_results()
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Tổng Cỡ mẫu", x = "Tổng Cỡ mẫu (N)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(df(), input$sig_level, input$power)
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.8, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(w_val) {
|
||||
res <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = w_val,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$N
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
req(effect_analysis_plot_data())
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (w)",
|
||||
y = "Tổng Cỡ mẫu cần thiết (N)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$w, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$w, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$w, y = res$required_n,
|
||||
label = paste("N =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
242
samplesize/chisquaregoodfit/app.R
Normal file
242
samplesize/chisquaregoodfit/app.R
Normal file
@@ -0,0 +1,242 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Mức độ phù hợp (Goodness-of-Fit)"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("w",
|
||||
label = "Effect Size (w):",
|
||||
value = 0.3, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's w đo lường mức độ khác biệt giữa tần số quan sát và tần số kỳ vọng. Quy ước: 0.1 (nhỏ), 0.3 (trung bình), 0.5 (lớn)."),
|
||||
|
||||
numericInput("k", "Số lượng nhóm/phân loại (k):", value = 4, min = 2),
|
||||
|
||||
# Hiển thị bậc tự do được tính toán
|
||||
uiOutput("df_display"),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.chisq.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Tổng Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy tổng cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định Mức độ phù hợp Chi bình phương"),
|
||||
p("Kiểm định này được sử dụng để xác định xem tần số quan sát của một biến phân loại có phù hợp với một phân phối kỳ vọng (lý thuyết) hay không."),
|
||||
p("$$H_0: \\text{Tần số quan sát phù hợp với tần số kỳ vọng}$$"),
|
||||
p("$$H_a: \\text{Tần số quan sát không phù hợp với tần số kỳ vọng}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê \\(\\chi^2\\) được tính như sau:"),
|
||||
p("$$ \\chi^2 = \\sum_{i=1}^{k} \\frac{(O_i - E_i)^2}{E_i} $$"),
|
||||
p("Trong đó \\(O_i\\) là tần số quan sát và \\(E_i\\) là tần số kỳ vọng cho nhóm thứ \\(i\\)."),
|
||||
|
||||
tags$b("2. Bậc tự do (Degrees of Freedom - df):"),
|
||||
p("$$ df = k - 1 $$"),
|
||||
p("Trong đó \\(k\\) là số lượng nhóm hoặc phân loại của biến."),
|
||||
|
||||
tags$b("3. Effect Size (w):"),
|
||||
p("Cohen's w đo lường độ lớn của sự khác biệt giữa tỷ lệ quan sát (\\(P_{1i}\\)) và tỷ lệ kỳ vọng (\\(P_{0i}\\)):"),
|
||||
p("$$ w = \\sqrt{ \\sum_{i=1}^{k} \\frac{(P_{1i} - P_{0i})^2}{P_{0i}} } $$"),
|
||||
p("Để tính toán cỡ mẫu, bạn cần ước tính giá trị `w` mà bạn kỳ vọng sẽ phát hiện được."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một cơ quan y tế công cộng muốn kiểm tra xem sự phân bố của 4 chủng cúm (A, B, C, D) trong mùa dịch năm nay có khác biệt so với dữ liệu lịch sử hay không. Dữ liệu lịch sử cho thấy tỷ lệ các chủng là: A (40%), B (30%), C (20%), D (10%)."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Biến phân loại: Chủng cúm."),
|
||||
tags$li("Số lượng nhóm (k): 4."),
|
||||
tags$li("Phân phối kỳ vọng (H0): Tỷ lệ là 0.4, 0.3, 0.2, 0.1."),
|
||||
tags$li("Bậc tự do (df): 4 - 1 = 3.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu nghi ngờ rằng chủng B đang trở nên phổ biến hơn. Họ giả định một phân phối mới có thể là: A (35%), B (40%), C (15%), D (10%). Họ có thể tính effect size `w` từ hai phân phối này và nhập vào ứng dụng, hoặc đơn giản là ước tính một effect size ở mức 'nhỏ' đến 'trung bình', ví dụ \\(w = 0.2\\)."),
|
||||
p("Họ có thể nhập các giá trị này (w=0.2, k=4, power=0.8, alpha=0.05) vào ứng dụng để tìm ra tổng số ca bệnh cần phân tích để phát hiện sự thay đổi này.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do (df) một cách reactive
|
||||
df <- reactive({
|
||||
req(input$k)
|
||||
input$k - 1
|
||||
})
|
||||
|
||||
# Hiển thị df ra giao diện
|
||||
output$df_display <- renderUI({
|
||||
tagList(
|
||||
tags$p(tags$b("Bậc tự do (df) = "), df())
|
||||
)
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$w, df(), input$sig_level, input$power)
|
||||
|
||||
# Bậc tự do phải > 0
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = input$w,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$N)
|
||||
|
||||
sample_sizes <- seq(10, required_n + 100, by = 2)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
N = sample_sizes,
|
||||
w = input$w,
|
||||
df = df(),
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$N, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
if (df() <= 0) {
|
||||
return(tags$div(class = "alert alert-warning", "Bậc tự do phải lớn hơn 0. Vui lòng kiểm tra lại số lượng nhóm."))
|
||||
}
|
||||
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một sự khác biệt có độ lớn (effect size w) là", tags$b(input$w), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một tổng cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
req(main_results(), main_results()$power_plot_data)
|
||||
res <- main_results()
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Tổng Cỡ mẫu", x = "Tổng Cỡ mẫu (N)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(df(), input$sig_level, input$power)
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.8, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(w_val) {
|
||||
res <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = w_val,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$N
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
req(effect_analysis_plot_data())
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (w)",
|
||||
y = "Tổng Cỡ mẫu cần thiết (N)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$w, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$w, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$w, y = res$required_n,
|
||||
label = paste("N =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
208
samplesize/onesamplettest/app.R
Normal file
208
samplesize/onesamplettest/app.R
Normal file
@@ -0,0 +1,208 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định t một mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt. Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.t.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định t một mẫu"),
|
||||
p("Kiểm định này so sánh trung bình của một mẫu duy nhất (\\(\\mu\\)) với một giá trị trung bình đã biết hoặc giả định (\\(\\mu_0\\))."),
|
||||
p("$$H_0: \\mu = \\mu_0$$"),
|
||||
p("$$H_a: \\mu \\neq \\mu_0 \\quad (\\text{hoặc } > \\text{ hoặc } <\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê t được tính như sau:"),
|
||||
p("$$ t = \\frac{\\bar{x} - \\mu_0}{s / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{x}\\) là trung bình mẫu, \\(s\\) là độ lệch chuẩn mẫu, và \\(n\\) là cỡ mẫu."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's d):"),
|
||||
p("Cohen's d cho trường hợp một mẫu được định nghĩa là:"),
|
||||
p("$$ d = \\frac{|\\mu_{alternative} - \\mu_0|}{\\sigma} $$"),
|
||||
p("Trong đó \\(\\mu_{alternative}\\) là trung bình thực sự dưới giả thuyết đối, và \\(\\sigma\\) là độ lệch chuẩn của tổng thể."),
|
||||
|
||||
tags$b("3. Tính toán Power:"),
|
||||
p("Ứng dụng này sử dụng hàm `pwr.t.test` với tham số `type = 'one.sample'`. Hàm này giải phương trình power dựa trên phân phối t phi trung tâm để tìm ra cỡ mẫu `n`.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "one.sample", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.t.test(
|
||||
n = sample_sizes,
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
type = "one.sample", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu", x = "Cỡ mẫu (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
res <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = d_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "one.sample", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results() # Lấy kết quả chính để đánh dấu
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Cỡ mẫu cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
# THÊM ĐÁNH DẤU TRỰC QUAN (IMPROVED)
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p # In đồ thị
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
221
samplesize/pairedztest/app.R
Normal file
221
samplesize/pairedztest/app.R
Normal file
@@ -0,0 +1,221 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Z ghép cặp"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt trung bình của các cặp, được chuẩn hóa bằng độ lệch chuẩn TỔNG THỂ của sự khác biệt (đã biết)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
h5("Công thức tính số cặp (n):"),
|
||||
# Hiển thị công thức tính mẫu trực tiếp
|
||||
uiOutput("sample_size_formula_display")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Số cặp"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy số cặp cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Sự khác biệt chính: Paired Z-test vs. Paired T-test"),
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Điểm mấu chốt:"),
|
||||
p("Sự lựa chọn giữa hai kiểm định này phụ thuộc vào việc bạn có biết độ lệch chuẩn của SỰ KHÁC BIỆT trong tổng thể (\\(\\sigma_D\\)) hay không."),
|
||||
tags$ul(
|
||||
tags$li(tags$b("Sử dụng Paired Z-test khi:"), "Độ lệch chuẩn của sự khác biệt trong tổng thể (\\(\\sigma_D\\)) đã biết. Giả định này cực kỳ hiếm trong thực tế."),
|
||||
tags$li(tags$b("Sử dụng Paired T-test khi:"), "Độ lệch chuẩn \\(\\sigma_D\\) không xác định và phải được ước tính từ độ lệch chuẩn của sự khác biệt trong mẫu (\\(s_d\\)). Đây là trường hợp tiêu chuẩn và phổ biến nhất.")
|
||||
)
|
||||
),
|
||||
hr(),
|
||||
h4("Giả thuyết của Kiểm định Z ghép cặp"),
|
||||
p("Kiểm định này phân tích sự khác biệt (D) trong mỗi cặp (ví dụ: D = Sau - Trước) để xem liệu trung bình của sự khác biệt (\\(\\mu_D\\)) có khác 0 hay không."),
|
||||
p("$$H_0: \\mu_D = 0$$"),
|
||||
p("$$H_a: \\mu_D \\neq 0 \\quad (\\text{hoặc } > 0 \\text{ hoặc } < 0\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê Z được tính trên sự khác biệt của các cặp:"),
|
||||
p("$$ Z = \\frac{\\bar{d} - 0}{\\sigma_D / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{d}\\) là trung bình của sự khác biệt trong mẫu, \\(\\sigma_D\\) là độ lệch chuẩn TỔNG THỂ của sự khác biệt, và \\(n\\) là số lượng cặp.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Hiển thị công thức tính cỡ mẫu
|
||||
output$sample_size_formula_display <- renderUI({
|
||||
if (input$alternative == "two.sided") {
|
||||
withMathJax(paste0("$$ n = \\frac{(Z_{1-\\alpha/2} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
} else {
|
||||
withMathJax(paste0("$$ n = \\frac{(Z_{1-\\alpha} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
}
|
||||
})
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI CHO Z-TEST GHÉP CẶP (tương tự 1 mẫu) ---
|
||||
calculate_z_power <- function(n, d, sig_level, alternative) {
|
||||
non_centrality_param <- d * sqrt(n)
|
||||
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_val_upper <- qnorm(1 - alpha)
|
||||
power <- pnorm(crit_val_upper - non_centrality_param, lower.tail = FALSE) +
|
||||
pnorm(-crit_val_upper - non_centrality_param, lower.tail = TRUE)
|
||||
} else { # one.sided
|
||||
crit_val <- qnorm(1 - sig_level)
|
||||
power <- pnorm(crit_val - abs(non_centrality_param), lower.tail = FALSE)
|
||||
}
|
||||
return(power)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Tìm số cặp cần thiết
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, input$d, input$sig_level, input$alternative)
|
||||
}
|
||||
required_n <- ifelse(n > 5000, NA, n)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
upper_bound <- if (!is.na(required_n)) required_n + 50 else 200
|
||||
sample_sizes <- seq(5, upper_bound, by = 1)
|
||||
|
||||
powers <- sapply(sample_sizes, function(s_n) {
|
||||
calculate_z_power(s_n, input$d, input$sig_level, input$alternative)
|
||||
})
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res) || is.na(res$required_n)) {
|
||||
return(tags$div(class = "alert alert-warning", "Không thể đạt được power mong muốn với cỡ mẫu tối đa (5000). Vui lòng xem xét lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cặp quan sát"))
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Số cặp quan sát", x = "Số cặp (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, d_val, input$sig_level, input$alternative)
|
||||
}
|
||||
ifelse(n > 5000, NA, n)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Số cặp cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Số cặp cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
223
samplesize/pairsamplettest/app.R
Normal file
223
samplesize/pairsamplettest/app.R
Normal file
@@ -0,0 +1,223 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định t ghép cặp"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt trung bình của các cặp. Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.t.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định t ghép cặp"),
|
||||
p("Kiểm định này được sử dụng khi các quan sát được thu thập theo cặp, ví dụ như đo lường trên cùng một đối tượng trước và sau một can thiệp. Kiểm định thực chất được thực hiện trên sự khác biệt (difference) của mỗi cặp."),
|
||||
p("Đặt \\(D = X_{sau} - X_{trước}\\), và \\(\\mu_D\\) là trung bình của sự khác biệt trong tổng thể."),
|
||||
p("$$H_0: \\mu_D = 0$$"),
|
||||
p("$$H_a: \\mu_D \\neq 0 \\quad (\\text{hoặc } > 0 \\text{ hoặc } < 0\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê t được tính trên sự khác biệt của các cặp:"),
|
||||
p("$$ t = \\frac{\\bar{d} - 0}{s_d / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{d}\\) là trung bình của sự khác biệt trong mẫu, \\(s_d\\) là độ lệch chuẩn của sự khác biệt, và \\(n\\) là số lượng cặp."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's d):"),
|
||||
p("Cohen's d cho trường hợp ghép cặp được định nghĩa là:"),
|
||||
p("$$ d = \\frac{|\\mu_D|}{\\sigma_D} $$"),
|
||||
p("Trong đó \\(\\mu_D\\) và \\(\\sigma_D\\) là trung bình và độ lệch chuẩn của sự khác biệt trong tổng thể."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một nhà nghiên cứu muốn đánh giá hiệu quả của một chương trình giáo dục dinh dưỡng mới nhằm giảm huyết áp tâm thu ở bệnh nhân cao huyết áp. Họ đo huyết áp của một nhóm bệnh nhân trước khi tham gia chương trình và đo lại trên chính những bệnh nhân đó sau khi chương trình kết thúc 3 tháng."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Đối tượng: Cùng một nhóm bệnh nhân."),
|
||||
tags$li("Đo lường: Huyết áp tâm thu."),
|
||||
tags$li("Thời điểm: Trước và Sau can thiệp."),
|
||||
tags$li("Phân tích: Kiểm định t ghép cặp được sử dụng để xem liệu có sự thay đổi huyết áp trung bình có ý nghĩa thống kê hay không.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi bắt đầu, nhà nghiên cứu muốn biết cần tuyển bao nhiêu bệnh nhân. Dựa trên các nghiên cứu trước, họ kỳ vọng chương trình sẽ giúp giảm huyết áp trung bình khoảng 5 mmHg (đây là \\(\\mu_D\\)) với độ lệch chuẩn của sự thay đổi là 10 mmHg (đây là \\(\\sigma_D\\))."),
|
||||
p("Do đó, Effect Size (Cohen's d) sẽ là: \\(d = | -5 | / 10 = 0.5\\)."),
|
||||
p("Nhà nghiên cứu có thể nhập d = 0.5, power = 0.8, và alpha = 0.05 vào ứng dụng này để tìm ra số lượng bệnh nhân (số cặp) cần thiết cho nghiên cứu của mình.")
|
||||
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "paired", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.t.test(
|
||||
n = sample_sizes,
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
type = "paired", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cặp quan sát"))
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Số cặp quan sát", x = "Số cặp (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
res <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = d_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "paired", # THAY ĐỔI QUAN TRỌNG
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results() # Lấy kết quả chính để đánh dấu
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Số cặp cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Số cặp cần thiết (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
# THÊM ĐÁNH DẤU TRỰC QUAN (IMPROVED)
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p # In đồ thị
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
209
samplesize/twosamplettest/app.R
Normal file
209
samplesize/twosamplettest/app.R
Normal file
@@ -0,0 +1,209 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
library(pwr)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định t hai mẫu độc lập"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt giữa hai trung bình. Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
helpText("Ứng dụng sử dụng hàm pwr.t.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Giả thuyết của Kiểm định t hai mẫu"),
|
||||
p("Kiểm định này so sánh trung bình của hai nhóm độc lập (\\(\\mu_1\\) và \\(\\mu_2\\))."),
|
||||
p("$$H_0: \\mu_1 = \\mu_2$$"),
|
||||
p("$$H_a: \\mu_1 \\neq \\mu_2 \\quad (\\text{hoặc } > \\text{ hoặc } <\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giả định phương sai bằng nhau, giá trị thống kê t được tính như sau:"),
|
||||
p("$$ t = \\frac{(\\bar{x}_1 - \\bar{x}_2)}{s_p \\sqrt{\\frac{1}{n_1} + \\frac{1}{n_2}}} $$"),
|
||||
p("Trong đó \\(\\bar{x}_1, \\bar{x}_2\\) là trung bình mẫu; \\(n_1, n_2\\) là cỡ mẫu; và \\(s_p\\) là độ lệch chuẩn gộp (pooled standard deviation)."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's d):"),
|
||||
p("Cohen's d cho trường hợp hai mẫu được định nghĩa là:"),
|
||||
p("$$ d = \\frac{|\\mu_1 - \\mu_2|}{\\sigma} $$"),
|
||||
p("Trong đó \\(\\sigma\\) là độ lệch chuẩn của tổng thể (giả định bằng nhau cho cả hai nhóm)."),
|
||||
|
||||
tags$b("3. Tính toán Power:"),
|
||||
p("Ứng dụng này sử dụng hàm `pwr.t.test` với tham số `type = 'two.sample'`. Hàm này giải phương trình power dựa trên phân phối t phi trung tâm để tìm ra cỡ mẫu `n` cần thiết cho mỗi nhóm.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "two.sample",
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
required_n <- ceiling(pwr_result$n)
|
||||
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.t.test(
|
||||
n = sample_sizes,
|
||||
d = input$d,
|
||||
sig.level = input$sig_level,
|
||||
type = "two.sample",
|
||||
alternative = input$alternative
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if(is.null(power_data)) return(list(required_n = required_n, power_plot_data = NULL))
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = power_data$n, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res)) {
|
||||
return(tags$div(class = "alert alert-danger", "Có lỗi xảy ra trong quá trình tính toán. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * 2, ".")
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
res <- tryCatch({
|
||||
pwr.t.test(
|
||||
d = d_val,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power,
|
||||
type = "two.sample",
|
||||
alternative = input$alternative
|
||||
)$n
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results() # Lấy kết quả chính để đánh dấu
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
# THÊM ĐÁNH DẤU TRỰC QUAN (IMPROVED)
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p # In đồ thị
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
227
samplesize/twosampleztest/app.R
Normal file
227
samplesize/twosampleztest/app.R
Normal file
@@ -0,0 +1,227 @@
|
||||
# Tải các thư viện cần thiết
|
||||
library(shiny)
|
||||
library(bslib)
|
||||
library(ggplot2)
|
||||
library(shinycssloaders)
|
||||
|
||||
# --- Giao diện người dùng (UI) ---
|
||||
ui <- fluidPage(
|
||||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||||
withMathJax(),
|
||||
|
||||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Z hai mẫu độc lập"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt giữa hai trung bình, được chuẩn hóa bằng độ lệch chuẩn TỔNG THỂ (đã biết)."),
|
||||
|
||||
selectInput("alternative", "Loại kiểm định:",
|
||||
choices = c("Hai phía (Two-sided)" = "two.sided",
|
||||
"Lớn hơn (Greater)" = "greater",
|
||||
"Nhỏ hơn (Less)" = "less")),
|
||||
|
||||
sliderInput("sig_level",
|
||||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||||
|
||||
sliderInput("power",
|
||||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||||
|
||||
hr(),
|
||||
h5("Công thức tính cỡ mẫu (mỗi nhóm):"),
|
||||
# Hiển thị công thức tính mẫu trực tiếp
|
||||
uiOutput("sample_size_formula_display")
|
||||
),
|
||||
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
id = "results_tabs",
|
||||
type = "pills",
|
||||
|
||||
tabPanel(
|
||||
"Kết quả & Diễn giải",
|
||||
h4("Kết quả tính toán"),
|
||||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Đồ thị Power vs. Cỡ mẫu",
|
||||
h4("Mối quan hệ giữa Power và Cỡ mẫu"),
|
||||
withSpinner(plotOutput("power_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Phân tích Effect Size",
|
||||
h4("Mối quan hệ giữa Cỡ mẫu và Effect Size"),
|
||||
p("Đồ thị này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Sự khác biệt chính: Z-test vs. T-test (cho hai mẫu)"),
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Điểm mấu chốt:"),
|
||||
p("Sự lựa chọn giữa Z-test và T-test phụ thuộc vào việc bạn có biết phương sai của tổng thể (\\(\\sigma^2\\)) hay không."),
|
||||
tags$ul(
|
||||
tags$li(tags$b("Sử dụng Z-test khi:"), "Phương sai của CẢ HAI tổng thể (\\(\\sigma_1^2\\) và \\(\\sigma_2^2\\)) đều đã biết. Đây là một giả định rất chặt và hiếm khi xảy ra trong thực tế."),
|
||||
tags$li(tags$b("Sử dụng T-test khi:"), "Phương sai của tổng thể không xác định và phải được ước tính từ dữ liệu mẫu. Đây là trường hợp gần như luôn luôn xảy ra trong nghiên cứu thực tế.")
|
||||
)
|
||||
),
|
||||
hr(),
|
||||
h4("Giả thuyết của Kiểm định Z hai mẫu"),
|
||||
p("Kiểm định này so sánh trung bình của hai nhóm độc lập (\\(\\mu_1\\) và \\(\\mu_2\\)), khi phương sai của chúng đã biết."),
|
||||
p("$$H_0: \\mu_1 = \\mu_2$$"),
|
||||
p("$$H_a: \\mu_1 \\neq \\mu_2 \\quad (\\text{hoặc } > \\text{ hoặc } <\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Test Statistic):"),
|
||||
p("Giá trị thống kê Z được tính như sau:"),
|
||||
p("$$ Z = \\frac{(\\bar{x}_1 - \\bar{x}_2) - 0}{\\sqrt{\\frac{\\sigma_1^2}{n_1} + \\frac{\\sigma_2^2}{n_2}}} $$"),
|
||||
p("Trong đó \\(\\sigma_1^2\\) và \\(\\sigma_2^2\\) là các phương sai TỔNG THỂ đã biết.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Hiển thị công thức tính cỡ mẫu
|
||||
output$sample_size_formula_display <- renderUI({
|
||||
alpha <- input$sig_level
|
||||
beta <- 1 - input$power
|
||||
d <- input$d
|
||||
|
||||
if (input$alternative == "two.sided") {
|
||||
withMathJax(paste0("$$ n = \\frac{2(Z_{1-\\alpha/2} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
} else {
|
||||
withMathJax(paste0("$$ n = \\frac{2(Z_{1-\\alpha} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
}
|
||||
})
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI CHO Z-TEST 2 MẪU ---
|
||||
calculate_z_power <- function(n, d, sig_level, alternative) {
|
||||
# Đối với 2 mẫu, mean của Z-statistic dưới Ha là d * sqrt(n/2)
|
||||
non_centrality_param <- d * sqrt(n / 2)
|
||||
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_val_upper <- qnorm(1 - alpha)
|
||||
power <- pnorm(crit_val_upper - non_centrality_param, lower.tail = FALSE) +
|
||||
pnorm(-crit_val_upper - non_centrality_param, lower.tail = TRUE)
|
||||
} else { # one.sided
|
||||
crit_val <- qnorm(1 - sig_level)
|
||||
power <- pnorm(crit_val - non_centrality_param, lower.tail = FALSE)
|
||||
}
|
||||
return(power)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Tìm cỡ mẫu cần thiết
|
||||
n <- 2 # Bắt đầu từ n nhỏ
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, input$d, input$sig_level, input$alternative)
|
||||
}
|
||||
required_n <- ifelse(n > 5000, NA, n)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
upper_bound <- if (!is.na(required_n)) required_n + 50 else 200
|
||||
sample_sizes <- seq(5, upper_bound, by = 1)
|
||||
|
||||
powers <- sapply(sample_sizes, function(s_n) {
|
||||
calculate_z_power(s_n, input$d, input$sig_level, input$alternative)
|
||||
})
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res) || is.na(res$required_n)) {
|
||||
return(tags$div(class = "alert alert-warning", "Không thể đạt được power mong muốn với cỡ mẫu tối đa (5000). Vui lòng xem xét lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", paste(res$required_n, "cho mỗi nhóm")),
|
||||
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", res$required_n * 2, ".")
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
res <- main_results()
|
||||
req(res$power_plot_data)
|
||||
|
||||
ggplot(res$power_plot_data, aes(x = SampleSize, y = Power)) +
|
||||
geom_line(color = "#007bff", size = 1.2) +
|
||||
geom_hline(yintercept = input$power, linetype = "dashed", color = "red") +
|
||||
geom_vline(xintercept = res$required_n, linetype = "dashed", color = "darkgreen") +
|
||||
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power (1 - β)") +
|
||||
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
|
||||
})
|
||||
|
||||
# --- PHẦN PHÂN TÍCH EFFECT SIZE ---
|
||||
effect_analysis_plot_data <- reactive({
|
||||
req(input$sig_level, input$power, input$alternative)
|
||||
|
||||
effect_sizes <- seq(0.1, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, d_val, input$sig_level, input$alternative)
|
||||
}
|
||||
ifelse(n > 5000, NA, n)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
plot_data <- effect_analysis_plot_data()
|
||||
res <- main_results()
|
||||
|
||||
p <- ggplot(plot_data, aes(x = EffectSize, y = RequiredN)) +
|
||||
geom_line(color = "#28a745", size = 1.2) +
|
||||
geom_point(color = "#28a745", size = 3, na.rm = TRUE) +
|
||||
labs(
|
||||
title = paste("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Cỡ mẫu cần thiết cho mỗi nhóm (n)"
|
||||
) +
|
||||
theme_minimal(base_size = 14)
|
||||
|
||||
if (!is.null(res) && !is.na(res$required_n)) {
|
||||
p <- p +
|
||||
geom_vline(xintercept = input$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, y = res$required_n,
|
||||
label = paste("n =", res$required_n), vjust = -1.5, color = "blue", fontface = "bold")
|
||||
}
|
||||
|
||||
p
|
||||
})
|
||||
}
|
||||
|
||||
# Chạy ứng dụng Shiny
|
||||
shinyApp(ui = ui, server = server)
|
||||
Reference in New Issue
Block a user