Upload to Server
Uploading to server
This commit is contained in:
244
samplesize/RepeatAnova/app.R
Normal file
244
samplesize/RepeatAnova/app.R
Normal file
@@ -0,0 +1,244 @@
|
||||
# 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 Repeated Measures ANOVA"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("k", "Số lần đo lường lặp lại (k):", value = 3, min = 2),
|
||||
helpText("Ví dụ: đo lường tại 3 thời điểm (Baseline, 3 tháng, 6 tháng) thì k=3."),
|
||||
|
||||
numericInput("f",
|
||||
label = "Effect Size (Cohen's f):",
|
||||
value = 0.25, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's f đo lường độ lớn của sự khác biệt giữa các lần đo. Quy ước: 0.1 (nhỏ), 0.25 (trung bình), 0.4 (lớn)."),
|
||||
|
||||
sliderInput("epsilon",
|
||||
label = "Hệ số điều chỉnh Sphericity (ε):",
|
||||
min = 0.5, max = 1, value = 1, step = 0.05),
|
||||
helpText("Epsilon = 1 nếu giả định sphericity được đáp ứng. Giá trị nhỏ hơn cho thấy sự vi phạm. Sử dụng ước tính từ các nghiên cứu trước nếu có."),
|
||||
|
||||
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(),
|
||||
h5("Bậc tự do của tử số (u):"),
|
||||
uiOutput("df_numerator_display")
|
||||
),
|
||||
|
||||
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ố đối tượng"),
|
||||
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 Repeated Measures ANOVA"),
|
||||
p("Kiểm định này so sánh trung bình của ba hay nhiều lần đo lường trên cùng một nhóm đối tượng."),
|
||||
p("$$H_0: \\mu_1 = \\mu_2 = \\dots = \\mu_k$$"),
|
||||
p("$$H_a: \\text{Có ít nhất một cặp trung bình không bằng nhau}$$"),
|
||||
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Giả định Sphericity:"),
|
||||
p("Đây là một giả định quan trọng, cho rằng phương sai của sự khác biệt giữa các cặp đo lường là bằng nhau. Nếu giả định này bị vi phạm, kết quả có thể không chính xác. Hệ số điều chỉnh Epsilon (ε) được sử dụng để điều chỉnh bậc tự do, làm cho kiểm định trở nên chặt chẽ hơn. Epsilon = 1 có nghĩa là giả định được đáp ứng hoàn hảo.")
|
||||
),
|
||||
hr(),
|
||||
|
||||
h4("Công thức tính toán"),
|
||||
p("Cỡ mẫu được tính toán dựa trên hàm `pwr.f2.test`, một công cụ cho các mô hình tuyến tính tổng quát."),
|
||||
tags$b("1. Bậc tự do của tử số (Numerator df - u):"),
|
||||
p("Bậc tự do này được điều chỉnh bởi epsilon:"),
|
||||
p("$$ u = (k - 1) \\times \\epsilon $$"),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's f):"),
|
||||
p("Tương tự như One-Way ANOVA, `f` đo lường độ lớn của sự khác biệt giữa các trung bình của các lần đo."),
|
||||
|
||||
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óm nghiên cứu muốn đánh giá hiệu quả lâu dài của một loại vaccine mới. Họ đo nồng độ kháng thể trong máu của cùng một nhóm tình nguyện viên tại 3 thời điểm: 1 tháng, 6 tháng, và 12 tháng sau khi tiêm."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Thiết kế: Đo lường lặp lại (within-subjects)."),
|
||||
tags$li("Số lần đo (k): 3."),
|
||||
tags$li("Phân tích: Repeated Measures ANOVA sẽ được sử dụng để xem liệu nồng độ kháng thể trung bình có thay đổi một cách có ý nghĩa theo thời gian hay không.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi bắt đầu, họ cần biết cần bao nhiêu tình nguyện viên. Họ kỳ vọng một sự thay đổi ở mức 'trung bình' theo thời gian, và chọn effect size \\(f = 0.25\\). Họ cũng không chắc về giả định sphericity, nên dựa trên các nghiên cứu tương tự, họ ước tính một cách thận trọng với \\(\\epsilon = 0.85\\)."),
|
||||
p("Họ có thể nhập các giá trị này vào ứng dụng để tìm ra số lượng tình nguyện viên cần thiết cho nghiên cứu.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do tử số (u)
|
||||
u <- reactive({
|
||||
req(input$k, input$epsilon)
|
||||
(input$k - 1) * input$epsilon
|
||||
})
|
||||
|
||||
output$df_numerator_display <- renderUI({
|
||||
withMathJax(paste0("$$ u = (k-1)\\epsilon = ", round(u(), 2), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(u(), input$f, input$sig_level, input$power, input$k, input$epsilon)
|
||||
|
||||
f2 <- input$f^2
|
||||
|
||||
# pwr.f2.test giải ra v (bậc tự do mẫu số)
|
||||
pwr_result <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = f2,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, error = function(e) NULL)
|
||||
|
||||
if (is.null(pwr_result)) return(NULL)
|
||||
|
||||
v <- pwr_result$v
|
||||
# Từ v, tính số đối tượng n
|
||||
# v = (n-1)*(k-1)*epsilon => n = v/((k-1)*epsilon) + 1
|
||||
required_n <- ceiling(v / ((input$k - 1) * input$epsilon) + 1)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
sample_sizes <- seq(5, required_n + 50, by = 1)
|
||||
|
||||
# Tính lại v cho mỗi n để tính power
|
||||
v_for_plot <- (sample_sizes - 1) * (input$k - 1) * input$epsilon
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
v = v_for_plot,
|
||||
f2 = f2,
|
||||
sig.level = input$sig_level
|
||||
)
|
||||
}, 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 = sample_sizes, 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 sự khác biệt giữa các lần đo có độ lớn (f) là", tags$b(input$f), "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, "đối tượng"))
|
||||
)
|
||||
})
|
||||
|
||||
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. Số đối tượng", x = "Số đối tượng (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(u(), input$sig_level, input$power, input$k, input$epsilon)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.6, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(f_val) {
|
||||
res <- tryCatch({
|
||||
pwr.f2.test(
|
||||
u = u(),
|
||||
f2 = f_val^2,
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$v
|
||||
}, error = function(e) NA)
|
||||
|
||||
if(is.na(res)) return(NA)
|
||||
|
||||
ceiling(res / ((input$k - 1) * input$epsilon) + 1)
|
||||
})
|
||||
|
||||
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 (f)",
|
||||
y = "Số đối tượng 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$f, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$f, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$f, 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)
|
||||
Reference in New Issue
Block a user