223 lines
8.8 KiB
R
223 lines
8.8 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 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)
|