Upload to Server
Uploading to server
This commit is contained in:
221
samplesize/pairedztest/app.R
Normal file
221
samplesize/pairedztest/app.R
Normal file
@@ -0,0 +1,221 @@
|
||||
# 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 Z ghép cặp"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("d",
|
||||
label = "Effect Size (Cohen's d):",
|
||||
value = 0.5, min = 0.1, step = 0.1),
|
||||
helpText("Cohen's d đo lường độ lớn của sự khác biệt trung bình của các cặp, được chuẩn hóa bằng độ lệch chuẩn TỔNG THỂ của sự khác biệt (đã 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),
|
||||
|
||||
hr(),
|
||||
h5("Công thức tính số cặp (n):"),
|
||||
# Hiển thị công thức tính mẫu trực tiếp
|
||||
uiOutput("sample_size_formula_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ố 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"),
|
||||
p("Đồ thị này cho thấy số cặp cần thiết thay đổi như thế nào khi Effect Size thay đổi."),
|
||||
withSpinner(plotOutput("effect_analysis_plot"), type = 6, color = "#007bff")
|
||||
),
|
||||
|
||||
tabPanel(
|
||||
"Giả thuyết và Công thức (Helper)",
|
||||
h4("Sự khác biệt chính: Paired Z-test vs. Paired T-test"),
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Điểm mấu chốt:"),
|
||||
p("Sự lựa chọn giữa hai kiểm định này phụ thuộc vào việc bạn có biết độ lệch chuẩn của SỰ KHÁC BIỆT trong tổng thể (\\(\\sigma_D\\)) hay không."),
|
||||
tags$ul(
|
||||
tags$li(tags$b("Sử dụng Paired Z-test khi:"), "Độ lệch chuẩn của sự khác biệt trong tổng thể (\\(\\sigma_D\\)) đã biết. Giả định này cực kỳ hiếm trong thực tế."),
|
||||
tags$li(tags$b("Sử dụng Paired T-test khi:"), "Độ lệch chuẩn \\(\\sigma_D\\) không xác định và phải được ước tính từ độ lệch chuẩn của sự khác biệt trong mẫu (\\(s_d\\)). Đây là trường hợp tiêu chuẩn và phổ biến nhất.")
|
||||
)
|
||||
),
|
||||
hr(),
|
||||
h4("Giả thuyết của Kiểm định Z ghép cặp"),
|
||||
p("Kiểm định này phân tích sự khác biệt (D) trong mỗi cặp (ví dụ: D = Sau - Trước) để xem liệu trung bình của sự khác biệt (\\(\\mu_D\\)) có khác 0 hay không."),
|
||||
p("$$H_0: \\mu_D = 0$$"),
|
||||
p("$$H_a: \\mu_D \\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 (Test Statistic):"),
|
||||
p("Giá trị thống kê Z được tính trên sự khác biệt của các cặp:"),
|
||||
p("$$ Z = \\frac{\\bar{d} - 0}{\\sigma_D / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{d}\\) là trung bình của sự khác biệt trong mẫu, \\(\\sigma_D\\) là độ lệch chuẩn TỔNG THỂ của sự khác biệt, và \\(n\\) là số lượng cặp.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Hiển thị công thức tính cỡ mẫu
|
||||
output$sample_size_formula_display <- renderUI({
|
||||
if (input$alternative == "two.sided") {
|
||||
withMathJax(paste0("$$ n = \\frac{(Z_{1-\\alpha/2} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
} else {
|
||||
withMathJax(paste0("$$ n = \\frac{(Z_{1-\\alpha} + Z_{1-\\beta})^2}{d^2} $$"))
|
||||
}
|
||||
})
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI CHO Z-TEST GHÉP CẶP (tương tự 1 mẫu) ---
|
||||
calculate_z_power <- function(n, d, sig_level, alternative) {
|
||||
non_centrality_param <- d * sqrt(n)
|
||||
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_val_upper <- qnorm(1 - alpha)
|
||||
power <- pnorm(crit_val_upper - non_centrality_param, lower.tail = FALSE) +
|
||||
pnorm(-crit_val_upper - non_centrality_param, lower.tail = TRUE)
|
||||
} else { # one.sided
|
||||
crit_val <- qnorm(1 - sig_level)
|
||||
power <- pnorm(crit_val - abs(non_centrality_param), lower.tail = FALSE)
|
||||
}
|
||||
return(power)
|
||||
}
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$d, input$sig_level, input$power, input$alternative)
|
||||
|
||||
# Tìm số cặp cần thiết
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, input$d, input$sig_level, input$alternative)
|
||||
}
|
||||
required_n <- ifelse(n > 5000, NA, n)
|
||||
|
||||
# Tạo dữ liệu cho đồ thị Power
|
||||
upper_bound <- if (!is.na(required_n)) required_n + 50 else 200
|
||||
sample_sizes <- seq(5, upper_bound, by = 1)
|
||||
|
||||
powers <- sapply(sample_sizes, function(s_n) {
|
||||
calculate_z_power(s_n, input$d, input$sig_level, input$alternative)
|
||||
})
|
||||
|
||||
list(
|
||||
required_n = required_n,
|
||||
power_plot_data = data.frame(SampleSize = sample_sizes, Power = powers)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
res <- main_results()
|
||||
|
||||
if (is.null(res) || is.na(res$required_n)) {
|
||||
return(tags$div(class = "alert alert-warning", "Không thể đạt được power mong muốn với cỡ mẫu tối đa (5000). Vui lòng xem xét lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một effect size (Cohen's d) là", tags$b(input$d), "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;", paste(res$required_n, "cặp quan sát"))
|
||||
)
|
||||
})
|
||||
|
||||
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ố cặp quan sát", x = "Số cặp (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, 1.5, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(d_val) {
|
||||
n <- 2
|
||||
power_val <- 0
|
||||
while (power_val < input$power && n <= 5000) {
|
||||
n <- n + 1
|
||||
power_val <- calculate_z_power(n, d_val, input$sig_level, input$alternative)
|
||||
}
|
||||
ifelse(n > 5000, NA, n)
|
||||
})
|
||||
|
||||
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("Số cặp cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
y = "Số cặp 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$d, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$d, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$d, 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