Upload to Server
Uploading to server
This commit is contained in:
239
samplesize/Shapiro-Wilk/app.R
Normal file
239
samplesize/Shapiro-Wilk/app.R
Normal file
@@ -0,0 +1,239 @@
|
||||
# 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)
|
||||
Reference in New Issue
Block a user