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