240 lines
9.2 KiB
R
240 lines
9.2 KiB
R
# Tải các thư viện cần thiết
|
||
library(shiny)
|
||
library(bslib) # Để có giao diện hiện đại
|
||
library(ggplot2) # Để vẽ đồ thị
|
||
library(shinycssloaders) # Để thêm hiệu ứng tải
|
||
|
||
# Định nghĩa các lựa chọn phân phối một lần để sử dụng ở cả UI và Server
|
||
dist_choices <- c("Chi-squared (df=3)" = "chisq",
|
||
"Beta (alpha=2, beta=5)" = "beta",
|
||
"Phân phối t (df=5)" = "t",
|
||
"Gamma (shape=2, rate=1.5)" = "gamma")
|
||
|
||
# --- Giao diện người dùng (UI) ---
|
||
ui <- fluidPage(
|
||
# Sử dụng theme Bootstrap hiện đại
|
||
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
||
|
||
# MathJax để hiển thị công thức toán học
|
||
withMathJax(),
|
||
|
||
# Tiêu đề của ứng dụng
|
||
titlePanel("Tính toán Cỡ mẫu cho Kiểm định Chuẩn Shapiro-Wilk"),
|
||
|
||
# Bố cục sidebar
|
||
sidebarLayout(
|
||
sidebarPanel(
|
||
h4("Tham số đầu vào"),
|
||
|
||
# Chọn phân phối của giả thuyết đối (H1)
|
||
selectInput("alt_dist",
|
||
label = "Phân phối của giả thuyết đối (H1):",
|
||
choices = dist_choices,
|
||
selected = "chisq"),
|
||
|
||
# Thanh trượt cho mức ý nghĩa (alpha)
|
||
sliderInput("sig_level",
|
||
label = "Mức ý nghĩa (\\(\\alpha\\)):",
|
||
min = 0.01, max = 0.10, value = 0.05, step = 0.01),
|
||
|
||
# Thanh trượt cho power mong muốn
|
||
sliderInput("power",
|
||
label = "Power mong muốn (\\(1 - \\beta\\)):",
|
||
min = 0.50, max = 0.99, value = 0.80, step = 0.01),
|
||
|
||
# Số lần lặp mô phỏng
|
||
numericInput("n_sims",
|
||
label = "Số lần lặp mô phỏng:",
|
||
value = 500, min = 100, max = 5000),
|
||
|
||
hr(),
|
||
helpText("Kết quả chính và đồ thị Power sẽ tự động cập nhật. Chuyển sang tab 'Phân tích Mức ý nghĩa' để chạy các phân tích sâu hơn.")
|
||
),
|
||
|
||
mainPanel(
|
||
# Sử dụng tab để tổ chức kết quả
|
||
tabsetPanel(
|
||
id = "results_tabs",
|
||
type = "pills",
|
||
|
||
# Tab 1: Kết quả tính toán
|
||
tabPanel(
|
||
"Kết quả & Diễn giải",
|
||
h4("Kết quả ước tính"),
|
||
withSpinner(uiOutput("sample_size_output"), type = 6, color = "#007bff")
|
||
),
|
||
|
||
# Tab 2: Đồ thị Power
|
||
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")
|
||
),
|
||
|
||
# Tab 3: Phân tích Mức ý nghĩa (MỚI)
|
||
tabPanel(
|
||
"Phân tích Mức ý nghĩa",
|
||
h4("Mối quan hệ giữa Cỡ mẫu và Mức ý nghĩa (\\(\\alpha\\))"),
|
||
p("Phân tích này cho thấy cỡ mẫu cần thiết thay đổi như thế nào khi bạn điều chỉnh mức ý nghĩa alpha (với power và phân phối được giữ cố định từ các tham số chính)."),
|
||
p("Vì tính toán này khá nặng, vui lòng nhấn nút bên dưới để bắt đầu."),
|
||
actionButton("run_alpha_analysis", "Chạy phân tích Alpha", class = "btn-success mb-3"),
|
||
withSpinner(plotOutput("alpha_analysis_plot"), type = 6, color = "#007bff")
|
||
),
|
||
|
||
# Tab 4: Công thức và phương pháp
|
||
tabPanel(
|
||
"Giả thuyết và Phương pháp",
|
||
h4("Giả thuyết của Kiểm định Shapiro-Wilk"),
|
||
p("$$H_0: \\text{Dữ liệu tuân theo phân phối chuẩn}$$"),
|
||
p("$$H_a: \\text{Dữ liệu không tuân theo phân phối chuẩn}$$"),
|
||
hr(),
|
||
h4("Phương pháp tính toán"),
|
||
p("Chúng tôi sử dụng phương pháp mô phỏng Monte Carlo... (giải thích chi tiết)")
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
# --- Logic của máy chủ (Server) ---
|
||
server <- function(input, output, session) {
|
||
|
||
# --- PHẦN TÍNH TOÁN CHÍNH (TỰ ĐỘNG) ---
|
||
|
||
reactive_inputs <- reactive({
|
||
list(
|
||
sig_level = input$sig_level,
|
||
power = input$power,
|
||
alt_dist = input$alt_dist,
|
||
n_sims = input$n_sims
|
||
)
|
||
})
|
||
|
||
debounced_inputs <- debounce(reactive_inputs, 1000)
|
||
|
||
simulation_results <- reactive({
|
||
inputs <- debounced_inputs()
|
||
sig_level <- inputs$sig_level
|
||
target_power <- inputs$power
|
||
alt_dist <- inputs$alt_dist
|
||
n_sims <- inputs$n_sims
|
||
|
||
sample_sizes <- seq(10, 500, by = 5)
|
||
powers <- numeric(length(sample_sizes))
|
||
|
||
withProgress(message = 'Đang chạy mô phỏng chính...', value = 0, {
|
||
for (i in 1:length(sample_sizes)) {
|
||
n <- sample_sizes[i]
|
||
p_values <- replicate(n_sims, {
|
||
if (alt_dist == "chisq") random_data <- rchisq(n, df = 3)
|
||
else if (alt_dist == "beta") random_data <- rbeta(n, shape1 = 2, shape2 = 5)
|
||
else if (alt_dist == "t") random_data <- rt(n, df = 5)
|
||
else if (alt_dist == "gamma") random_data <- rgamma(n, shape = 2, rate = 1.5)
|
||
shapiro.test(random_data)$p.value
|
||
})
|
||
powers[i] <- mean(p_values < sig_level)
|
||
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
|
||
if (powers[i] >= target_power) {
|
||
sample_sizes <- sample_sizes[1:i]
|
||
powers <- powers[1:i]
|
||
break
|
||
}
|
||
}
|
||
})
|
||
|
||
list(
|
||
sample_sizes = sample_sizes,
|
||
powers = powers,
|
||
target_power = target_power,
|
||
sig_level = sig_level,
|
||
alt_dist_name = names(dist_choices)[dist_choices == alt_dist]
|
||
)
|
||
})
|
||
|
||
output$sample_size_output <- renderUI({
|
||
res <- simulation_results()
|
||
first_index_above_power <- which(res$powers >= res$target_power)[1]
|
||
if (!is.na(first_index_above_power)) {
|
||
required_n <- res$sample_sizes[first_index_above_power]
|
||
tagList(
|
||
tags$p("Để phát hiện phân phối không chuẩn dạng", tags$b(res$alt_dist_name), "với power là", tags$b(res$target_power), "và mức ý nghĩa", tags$b(res$sig_level), ", bạn cần một cỡ mẫu ước tính là:"),
|
||
tags$h3(style = "color: #007bff; text-align: center;", required_n)
|
||
)
|
||
} else {
|
||
tags$div(class = "alert alert-warning", "Không đạt được power mong muốn trong khoảng cỡ mẫu đã thử (tối đa 500).")
|
||
}
|
||
})
|
||
|
||
output$power_plot <- renderPlot({
|
||
res <- simulation_results()
|
||
plot_data <- data.frame(SampleSize = res$sample_sizes, Power = res$powers)
|
||
ggplot(plot_data, aes(x = SampleSize, y = Power)) +
|
||
geom_line(color = "#007bff", size = 1.2) + geom_point(color = "#007bff", size = 3) +
|
||
geom_hline(yintercept = res$target_power, linetype = "dashed", color = "red") +
|
||
labs(title = paste("Power của Kiểm định Shapiro-Wilk vs. Phân phối", res$alt_dist_name), x = "Cỡ mẫu (n)", y = "Power thực nghiệm (1 - β)") +
|
||
theme_minimal(base_size = 14)
|
||
})
|
||
|
||
# --- PHẦN PHÂN TÍCH ALPHA (CHẠY KHI BẤM NÚT) ---
|
||
|
||
alpha_analysis_results <- eventReactive(input$run_alpha_analysis, {
|
||
# Lấy các tham số cố định từ input
|
||
target_power <- input$power
|
||
alt_dist <- input$alt_dist
|
||
n_sims <- input$n_sims
|
||
|
||
# Dãy các giá trị alpha để phân tích
|
||
alpha_values <- seq(0.01, 0.15, by = 0.01)
|
||
required_n_values <- numeric(length(alpha_values))
|
||
|
||
withProgress(message = 'Đang chạy phân tích Alpha...', value = 0, {
|
||
# Vòng lặp qua từng giá trị alpha
|
||
for (j in 1:length(alpha_values)) {
|
||
current_alpha <- alpha_values[j]
|
||
|
||
# Logic tìm cỡ mẫu cho alpha hiện tại
|
||
sample_sizes <- seq(10, 500, by = 10) # Dùng bước nhảy lớn hơn để nhanh hơn
|
||
required_n <- NA
|
||
for (i in 1:length(sample_sizes)) {
|
||
n <- sample_sizes[i]
|
||
p_values <- replicate(n_sims, {
|
||
if (alt_dist == "chisq") random_data <- rchisq(n, df = 3)
|
||
else if (alt_dist == "beta") random_data <- rbeta(n, shape1 = 2, shape2 = 5)
|
||
else if (alt_dist == "t") random_data <- rt(n, df = 5)
|
||
else if (alt_dist == "gamma") random_data <- rgamma(n, shape = 2, rate = 1.5)
|
||
shapiro.test(random_data)$p.value
|
||
})
|
||
|
||
current_power <- mean(p_values < current_alpha)
|
||
|
||
if (current_power >= target_power) {
|
||
required_n <- n
|
||
break
|
||
}
|
||
}
|
||
required_n_values[j] <- required_n
|
||
incProgress(1/length(alpha_values), detail = paste("Alpha =", current_alpha))
|
||
}
|
||
})
|
||
|
||
data.frame(Alpha = alpha_values, RequiredN = required_n_values)
|
||
})
|
||
|
||
output$alpha_analysis_plot <- renderPlot({
|
||
plot_data <- alpha_analysis_results()
|
||
|
||
ggplot(plot_data, aes(x = Alpha, y = RequiredN)) +
|
||
geom_line(color = "#28a745", size = 1.2) +
|
||
geom_point(color = "#28a745", size = 3) +
|
||
labs(
|
||
title = paste("Cỡ mẫu cần thiết vs. Mức ý nghĩa (Power cố định =", input$power, ")"),
|
||
x = "Mức ý nghĩa (α)",
|
||
y = "Cỡ mẫu cần thiết (n)"
|
||
) +
|
||
theme_minimal(base_size = 14)
|
||
})
|
||
}
|
||
|
||
# Chạy ứng dụng Shiny
|
||
shinyApp(ui = ui, server = server)
|