235 lines
9.0 KiB
R
235 lines
9.0 KiB
R
# 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)
|