215 lines
8.6 KiB
R
215 lines
8.6 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 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)
|