Upload to Server
Uploading to server
This commit is contained in:
238
samplesize/1ProportionTest/app.R
Normal file
238
samplesize/1ProportionTest/app.R
Normal file
@@ -0,0 +1,238 @@
|
||||
# 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 Kiểm định Tỷ lệ một mẫu"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
sliderInput("p0",
|
||||
label = "Tỷ lệ giả định dưới H0 (p0):",
|
||||
min = 0.01, max = 0.99, value = 0.5, step = 0.01),
|
||||
|
||||
sliderInput("p1",
|
||||
label = "Tỷ lệ kỳ vọng dưới Ha (p1):",
|
||||
min = 0.01, max = 0.99, value = 0.6, step = 0.01),
|
||||
|
||||
# Hiển thị effect size được tính toán
|
||||
h5("Effect Size (Cohen's h):"),
|
||||
uiOutput("effect_size_display"),
|
||||
|
||||
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("Ứng dụng sử dụng hàm pwr.p.test() từ gói 'pwr'.")
|
||||
),
|
||||
|
||||
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ỷ lệ một mẫu"),
|
||||
p("Kiểm định này so sánh một tỷ lệ quan sát được trong mẫu với một tỷ lệ giả định hoặc đã biết trong tổng thể (\\(p_0\\))."),
|
||||
p("$$H_0: p = p_0$$"),
|
||||
p("$$H_a: p \\neq p_0 \\quad (\\text{hoặc } > p_0 \\text{ hoặc } < p_0\\text{)}$$"),
|
||||
hr(),
|
||||
h4("Công thức tính toán"),
|
||||
|
||||
tags$b("1. Thống kê kiểm định (Z-statistic):"),
|
||||
p("Giá trị thống kê Z được tính như sau:"),
|
||||
p("$$ Z = \\frac{\\hat{p} - p_0}{\\sqrt{\\frac{p_0(1-p_0)}{n}}} $$"),
|
||||
p("Trong đó \\(\\hat{p}\\) là tỷ lệ trong mẫu, \\(p_0\\) là tỷ lệ giả định, và \\(n\\) là cỡ mẫu."),
|
||||
|
||||
tags$b("2. Effect Size (Cohen's h):"),
|
||||
p("Để tính toán power, sự khác biệt giữa hai tỷ lệ được chuyển đổi bằng phép biến đổi arcsin để ổn định phương sai. Cohen's h được định nghĩa là:"),
|
||||
p("$$ h = |2 \\arcsin(\\sqrt{p_1}) - 2 \\arcsin(\\sqrt{p_0})| $$"),
|
||||
p("Quy ước: 0.2 (nhỏ), 0.5 (trung bình), 0.8 (lớn)."),
|
||||
|
||||
hr(),
|
||||
h4("Ví dụ ứng dụng trong Y tế công cộng"),
|
||||
p(tags$b("Tình huống:")),
|
||||
p("Một cơ quan y tế biết rằng tỷ lệ tiêm chủng vắc-xin cúm trong cộng đồng năm ngoái là 40% (\\(p_0\\)). Năm nay, họ thực hiện một chiến dịch truyền thông mới và muốn kiểm tra xem chiến dịch có hiệu quả hay không. Họ muốn có đủ power để phát hiện nếu tỷ lệ tiêm chủng tăng lên ít nhất là 50% (\\(p_1\\))."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Kiểm định: Tỷ lệ một mẫu."),
|
||||
tags$li("Giả thuyết không (H0): Tỷ lệ tiêm chủng vẫn là 40%."),
|
||||
tags$li("Giả thuyết đối (Ha): Tỷ lệ tiêm chủng lớn hơn 40%.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Trước khi tiến hành khảo sát, họ cần biết cần khảo sát bao nhiêu người. Họ nhập các giá trị vào ứng dụng:"),
|
||||
tags$ul(
|
||||
tags$li("\\(p_0 = 0.40\\)"),
|
||||
tags$li("\\(p_1 = 0.50\\)"),
|
||||
tags$li("Loại kiểm định: Lớn hơn (Greater)"),
|
||||
tags$li("Power = 0.8, Alpha = 0.05")
|
||||
),
|
||||
p("Ứng dụng sẽ tự động tính effect size `h` và cho ra cỡ mẫu cần thiết để thực hiện nghiên cứu này.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán effect size h
|
||||
h <- reactive({
|
||||
req(input$p0, input$p1)
|
||||
abs(ES.h(input$p1, input$p0))
|
||||
})
|
||||
|
||||
# Hiển thị h ra giao diện
|
||||
output$effect_size_display <- renderUI({
|
||||
withMathJax(paste0("$$ h = ", round(h(), 3), " $$"))
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(h(), input$sig_level, input$power, input$alternative)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.p.test(
|
||||
h = h(),
|
||||
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(10, required_n + 100, by = 2)
|
||||
|
||||
power_data <- tryCatch({
|
||||
pwr.p.test(
|
||||
n = sample_sizes,
|
||||
h = h(),
|
||||
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. Hãy chắc chắn p0 và p1 không quá gần nhau."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện sự khác biệt giữa tỷ lệ", tags$b(input$p0), "và", tags$b(input$p1), "(effect size h =", tags$b(round(h(), 3)), ") 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;", 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.05, 1, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(h_val) {
|
||||
res <- tryCatch({
|
||||
pwr.p.test(
|
||||
h = h_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 = "Effect Size (h)",
|
||||
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 = h(), linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = h(), y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = h(), 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