Upload to Server
Uploading to server
This commit is contained in:
211
samplesize/Onesampleztest/app.R
Normal file
211
samplesize/Onesampleztest/app.R
Normal file
@@ -0,0 +1,211 @@
|
||||
# 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 một mẫu"),
|
||||
|
||||
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, được chuẩn hóa bằng độ lệch chuẩn TỔNG THỂ (đã 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(),
|
||||
helpText("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à 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 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("Sự khác biệt chính: Z-test vs. T-test"),
|
||||
tags$div(class = "alert alert-info",
|
||||
tags$b("Điểm mấu chốt:"),
|
||||
p("Sự lựa chọn giữa Z-test và T-test phụ thuộc vào việc bạn có biết độ lệch chuẩn của tổng thể (\\(\\sigma\\)) hay không."),
|
||||
tags$ul(
|
||||
tags$li(tags$b("Sử dụng Z-test khi:"), "Độ lệch chuẩn của tổng thể (\\(\\sigma\\)) đã biết. Điều này hiếm khi xảy ra trong thực tế, nhưng có thể xảy ra khi có một lượng lớn dữ liệu lịch sử (ví dụ: điểm thi chuẩn hóa toàn quốc, thông số trong một quy trình sản xuất đã được kiểm soát chặt chẽ)."),
|
||||
tags$li(tags$b("Sử dụng T-test khi:"), "Độ lệch chuẩn của tổng thể (\\(\\sigma\\)) không xác định và phải được ước tính từ độ lệch chuẩn của mẫu (\\(s\\)). Đây là trường hợp phổ biến nhất trong nghiên cứu.")
|
||||
),
|
||||
p("Khi cỡ mẫu rất lớn (thường > 30 hoặc > 100), phân phối t sẽ xấp xỉ phân phối chuẩn, và kết quả của hai kiểm định sẽ rất giống nhau.")
|
||||
),
|
||||
hr(),
|
||||
h4("Giả thuyết của Kiểm định Z một mẫu"),
|
||||
p("Kiểm định này so sánh trung bình của một mẫu duy nhất (\\(\\mu\\)) với một giá trị trung bình đã biết hoặc giả định (\\(\\mu_0\\)), khi \\(\\sigma\\) đã biết."),
|
||||
p("$$H_0: \\mu = \\mu_0$$"),
|
||||
p("$$H_a: \\mu \\neq \\mu_0 \\quad (\\text{hoặc } > \\text{ hoặc } <\\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 như sau:"),
|
||||
p("$$ Z = \\frac{\\bar{x} - \\mu_0}{\\sigma / \\sqrt{n}} $$"),
|
||||
p("Trong đó \\(\\bar{x}\\) là trung bình mẫu, \\(\\sigma\\) là độ lệch chuẩn TỔNG THỂ, và \\(n\\) là cỡ mẫu."),
|
||||
|
||||
tags$b("2. Tính toán Power:"),
|
||||
p("Power được tính toán dựa trên phân phối chuẩn. Dưới giả thuyết đối \\(H_a\\), thống kê Z tuân theo phân phối chuẩn với trung bình là \\(d\\sqrt{n}\\).")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# --- Logic của máy chủ (Server) ---
|
||||
server <- function(input, output, session) {
|
||||
|
||||
# --- HÀM TÍNH POWER LÕI CHO Z-TEST ---
|
||||
calculate_z_power <- function(n, d, sig_level, alternative) {
|
||||
if (alternative == "two.sided") {
|
||||
alpha <- sig_level / 2
|
||||
crit_val_upper <- qnorm(1 - alpha)
|
||||
power <- pnorm(crit_val_upper - d * sqrt(n), lower.tail = FALSE) + pnorm(-crit_val_upper - d * sqrt(n), lower.tail = TRUE)
|
||||
} else { # one.sided (greater or less)
|
||||
crit_val <- qnorm(1 - sig_level)
|
||||
power <- pnorm(crit_val - abs(d) * sqrt(n), 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 cỡ mẫu cần thiết
|
||||
n <- 2 # Bắt đầu từ n nhỏ
|
||||
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;", 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.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("Cỡ mẫu cần thiết vs. Effect Size (Power cố định =", input$power, ")"),
|
||||
x = "Effect Size (Cohen's d)",
|
||||
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 = 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