204 lines
9.0 KiB
R
204 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(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)
|