Upload to Server
Uploading to server
This commit is contained in:
242
samplesize/chisquaregoodfit/app.R
Normal file
242
samplesize/chisquaregoodfit/app.R
Normal file
@@ -0,0 +1,242 @@
|
||||
# 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 Mức độ phù hợp (Goodness-of-Fit)"),
|
||||
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
h4("Tham số đầu vào"),
|
||||
|
||||
numericInput("w",
|
||||
label = "Effect Size (w):",
|
||||
value = 0.3, min = 0.05, step = 0.05),
|
||||
helpText("Cohen's w đo lường mức độ khác biệt giữa tần số quan sát và tần số kỳ vọng. Quy ước: 0.1 (nhỏ), 0.3 (trung bình), 0.5 (lớn)."),
|
||||
|
||||
numericInput("k", "Số lượng nhóm/phân loại (k):", value = 4, min = 2),
|
||||
|
||||
# Hiển thị bậc tự do được tính toán
|
||||
uiOutput("df_display"),
|
||||
|
||||
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.chisq.test() từ gói 'pwr'. Kết quả và đồ thị sẽ tự động cập nhật ngay lập tức.")
|
||||
),
|
||||
|
||||
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à Tổng 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"),
|
||||
p("Đồ thị này cho thấy tổng cỡ mẫu 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("Giả thuyết của Kiểm định Mức độ phù hợp Chi bình phương"),
|
||||
p("Kiểm định này được sử dụng để xác định xem tần số quan sát của một biến phân loại có phù hợp với một phân phối kỳ vọng (lý thuyết) hay không."),
|
||||
p("$$H_0: \\text{Tần số quan sát phù hợp với tần số kỳ vọng}$$"),
|
||||
p("$$H_a: \\text{Tần số quan sát không phù hợp với tần số kỳ vọng}$$"),
|
||||
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ê \\(\\chi^2\\) được tính như sau:"),
|
||||
p("$$ \\chi^2 = \\sum_{i=1}^{k} \\frac{(O_i - E_i)^2}{E_i} $$"),
|
||||
p("Trong đó \\(O_i\\) là tần số quan sát và \\(E_i\\) là tần số kỳ vọng cho nhóm thứ \\(i\\)."),
|
||||
|
||||
tags$b("2. Bậc tự do (Degrees of Freedom - df):"),
|
||||
p("$$ df = k - 1 $$"),
|
||||
p("Trong đó \\(k\\) là số lượng nhóm hoặc phân loại của biến."),
|
||||
|
||||
tags$b("3. Effect Size (w):"),
|
||||
p("Cohen's w đo lường độ lớn của sự khác biệt giữa tỷ lệ quan sát (\\(P_{1i}\\)) và tỷ lệ kỳ vọng (\\(P_{0i}\\)):"),
|
||||
p("$$ w = \\sqrt{ \\sum_{i=1}^{k} \\frac{(P_{1i} - P_{0i})^2}{P_{0i}} } $$"),
|
||||
p("Để tính toán cỡ mẫu, bạn cần ước tính giá trị `w` mà bạn kỳ vọng sẽ phát hiện được."),
|
||||
|
||||
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ế công cộng muốn kiểm tra xem sự phân bố của 4 chủng cúm (A, B, C, D) trong mùa dịch năm nay có khác biệt so với dữ liệu lịch sử hay không. Dữ liệu lịch sử cho thấy tỷ lệ các chủng là: A (40%), B (30%), C (20%), D (10%)."),
|
||||
p(tags$b("Thiết kế nghiên cứu:")),
|
||||
tags$ul(
|
||||
tags$li("Biến phân loại: Chủng cúm."),
|
||||
tags$li("Số lượng nhóm (k): 4."),
|
||||
tags$li("Phân phối kỳ vọng (H0): Tỷ lệ là 0.4, 0.3, 0.2, 0.1."),
|
||||
tags$li("Bậc tự do (df): 4 - 1 = 3.")
|
||||
),
|
||||
p(tags$b("Tính toán cỡ mẫu:")),
|
||||
p("Nhà nghiên cứu nghi ngờ rằng chủng B đang trở nên phổ biến hơn. Họ giả định một phân phối mới có thể là: A (35%), B (40%), C (15%), D (10%). Họ có thể tính effect size `w` từ hai phân phối này và nhập vào ứng dụng, hoặc đơn giản là ước tính một effect size ở mức 'nhỏ' đến 'trung bình', ví dụ \\(w = 0.2\\)."),
|
||||
p("Họ có thể nhập các giá trị này (w=0.2, k=4, power=0.8, alpha=0.05) vào ứng dụng để tìm ra tổng số ca bệnh cần phân tích để phát hiện sự thay đổi này.")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# Tính toán bậc tự do (df) một cách reactive
|
||||
df <- reactive({
|
||||
req(input$k)
|
||||
input$k - 1
|
||||
})
|
||||
|
||||
# Hiển thị df ra giao diện
|
||||
output$df_display <- renderUI({
|
||||
tagList(
|
||||
tags$p(tags$b("Bậc tự do (df) = "), df())
|
||||
)
|
||||
})
|
||||
|
||||
# --- PHẦN TÍNH TOÁN CHÍNH ---
|
||||
main_results <- reactive({
|
||||
req(input$w, df(), input$sig_level, input$power)
|
||||
|
||||
# Bậc tự do phải > 0
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
pwr_result <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = input$w,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)
|
||||
}, 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.chisq.test(
|
||||
N = sample_sizes,
|
||||
w = input$w,
|
||||
df = df(),
|
||||
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 = power_data$N, Power = power_data$power)
|
||||
)
|
||||
})
|
||||
|
||||
output$sample_size_output <- renderUI({
|
||||
if (df() <= 0) {
|
||||
return(tags$div(class = "alert alert-warning", "Bậc tự do phải lớn hơn 0. Vui lòng kiểm tra lại số lượng nhóm."))
|
||||
}
|
||||
|
||||
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. Vui lòng kiểm tra lại các tham số."))
|
||||
}
|
||||
|
||||
tagList(
|
||||
tags$p("Để phát hiện một sự khác biệt có độ lớn (effect size w) là", tags$b(input$w), "với power là", tags$b(input$power), "và mức ý nghĩa", tags$b(input$sig_level), ", bạn cần một tổng cỡ mẫu ước tính là:"),
|
||||
tags$h3(style = "color: #007bff; text-align: center;", res$required_n)
|
||||
)
|
||||
})
|
||||
|
||||
output$power_plot <- renderPlot({
|
||||
req(main_results(), main_results()$power_plot_data)
|
||||
res <- main_results()
|
||||
|
||||
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. Tổng Cỡ mẫu", x = "Tổng 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(df(), input$sig_level, input$power)
|
||||
if (df() <= 0) return(NULL)
|
||||
|
||||
effect_sizes <- seq(0.05, 0.8, by = 0.05)
|
||||
|
||||
required_n_values <- sapply(effect_sizes, function(w_val) {
|
||||
res <- tryCatch({
|
||||
pwr.chisq.test(
|
||||
w = w_val,
|
||||
df = df(),
|
||||
sig.level = input$sig_level,
|
||||
power = input$power
|
||||
)$N
|
||||
}, error = function(e) NA)
|
||||
ceiling(res)
|
||||
})
|
||||
|
||||
data.frame(EffectSize = effect_sizes, RequiredN = required_n_values)
|
||||
})
|
||||
|
||||
output$effect_analysis_plot <- renderPlot({
|
||||
req(effect_analysis_plot_data())
|
||||
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 (w)",
|
||||
y = "Tổng 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$w, linetype = "dotted", color = "blue", size = 1) +
|
||||
geom_point(aes(x = input$w, y = res$required_n), color = "blue", size = 5, shape = 18) +
|
||||
annotate("text", x = input$w, 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