cuongpv/Shiny--Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Upload to Server

Browse Source 
Uploading to server
This commit is contained in:
Pham Viet Cuong
2025-08-02 05:15:23 +07:00
commit 33e9543b15
66 changed files with 7590 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

207
samplesize/Kruskal-Wallis-Test/app.R Normal file
View File

@@ -0,0 +1,207 @@
# 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 Kruskal-Wallis"),
sidebarLayout(
sidebarPanel(
h4("Tham số đầu vào"),
numericInput("k", "Số lượng nhóm so sánh (k):", value = 3, min = 2),
selectInput("dist_shape", "Hình dạng phân phối của dữ liệu:",
choices = c("Lệch phải (Log-Normal)" = "lnorm",
"Đối xứng, đuôi dày (t, df=5)" = "t_dist",
"Phân phối đều (Uniform)" = "unif")),
numericInput("effect_size",
label = "Effect Size (Median Shift / SD):",
value = 0.5, min = 0.1, step = 0.1),
helpText("Đây là độ lớn của sự dịch chuyển của trung vị (median) của một nhóm so với các nhóm còn lại, được chuẩn hóa bằng độ lệch chuẩn."),
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),
numericInput("n_sims",
label = "Số lần lặp mô phỏng:",
value = 500, min = 100, max = 5000),
hr(),
actionButton("calculate", "Bắt đầu tính toán", class = "btn-primary"),
helpText("Vì tính toán dựa trên mô phỏng, quá trình có thể mất vài giây.")
),
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 Kruskal-Wallis"),
p("Đây là kiểm định phi tham số thay thế cho One-Way ANOVA. Nó kiểm tra xem liệu có sự khác biệt về phân phối giữa ba hay nhiều nhóm độc lập hay không."),
p("$$H_0: \\text{Phân phối của tất cả các nhóm là như nhau}$$"),
p("$$H_a: \\text{Phân phối của ít nhất một nhóm khác biệt so với các nhóm còn lại}$$"),
tags$div(class = "alert alert-info",
tags$b("Khi nào sử dụng?"),
p("Sử dụng kiểm định này thay cho One-Way ANOVA khi giả định về phân phối chuẩn của dữ liệu trong các nhóm không được đáp ứng, hoặc khi dữ liệu ở dạng thứ hạng (ordinal).")
),
hr(),
h4("Phương pháp tính toán"),
p("Ứng dụng sử dụng phương pháp mô phỏng Monte Carlo để ước tính cỡ mẫu. Quá trình này bao gồm việc tạo ra hàng nghìn bộ dữ liệu giả định (trong đó một nhóm có phân phối bị dịch chuyển đi), áp dụng kiểm định cho từng bộ, và đếm tỷ lệ các kiểm định phát hiện ra hiệu ứng."),
hr(),
h4("Ví dụ ứng dụng trong Y tế công cộng"),
p(tags$b("Tình huống:")),
p("Một nhà nghiên cứu muốn so sánh mức độ hài lòng của bệnh nhân (đo bằng thang điểm từ 1 đến 10) đối với ba bệnh viện khác nhau (A, B, C)."),
p(tags$b("Tại sao dùng Kruskal-Wallis?")),
p("Dữ liệu về mức độ hài lòng thường không tuân theo phân phối chuẩn (nó là dữ liệu thứ hạng và bị chặn ở hai đầu). Do đó, so sánh phân phối dựa trên hạng (rank) sẽ phù hợp hơn là so sánh trung bình."),
p(tags$b("Tính toán cỡ mẫu:")),
p("Nhà nghiên cứu cần xác định số lượng bệnh nhân cần khảo sát ở mỗi bệnh viện. Họ kỳ vọng một sự khác biệt có effect size khoảng 0.4. Họ có thể nhập các giá trị này vào ứng dụng để tìm ra cỡ mẫu cần thiết cho nghiên cứu của mình.")
)
)
)
)
)
# --- Logic của máy chủ (Server) ---
server <- function(input, output, session) {
simulation_results <- eventReactive(input$calculate, {
inputs <- list(
k = input$k,
dist_shape = input$dist_shape,
effect_size = input$effect_size,
sig_level = input$sig_level,
target_power = input$power,
n_sims = input$n_sims
)
sample_sizes <- seq(10, 500, by = 5)
powers <- numeric(length(sample_sizes))
withProgress(message = 'Đang chạy mô phỏng...', value = 0, {
for (i in 1:length(sample_sizes)) {
n <- sample_sizes[i]
p_values <- replicate(inputs$n_sims, {
# Tạo dữ liệu cho k nhóm
data_list <- lapply(1:inputs$k, function(group_idx) {
# Nhóm đầu tiên có phân phối bị dịch chuyển, các nhóm còn lại thì không
shift <- if (group_idx == 1) inputs$effect_size else 0
if (inputs$dist_shape == "t_dist") {
return(rt(n, df = 5) + shift)
} else if (inputs$dist_shape == "lnorm") {
return(rlnorm(n, meanlog = shift, sdlog = 1))
} else { # unif
return(runif(n, 0, 1) + shift)
}
})
# Chuyển thành dataframe phù hợp cho kruskal.test
df <- data.frame(
value = unlist(data_list),
group = factor(rep(1:inputs$k, each = n))
)
# Thực hiện kiểm định Kruskal-Wallis
kruskal.test(value ~ group, data = df)$p.value
})
powers[i] <- mean(p_values < inputs$sig_level, na.rm = TRUE)
incProgress(1/length(sample_sizes), detail = paste("Cỡ mẫu n =", n))
if (powers[i] >= inputs$target_power) {
sample_sizes <- sample_sizes[1:i]
powers <- powers[1:i]
break
}
}
})
list(
sample_sizes = sample_sizes,
powers = powers,
inputs = inputs
)
})
output$sample_size_output <- renderUI({
res <- simulation_results()
required_n_index <- which(res$powers >= res$inputs$target_power)[1]
if (!is.na(required_n_index)) {
required_n <- res$sample_sizes[required_n_index]
tagList(
tags$p("Để phát hiện một effect size là", tags$b(res$inputs$effect_size), "giữa", tags$b(res$inputs$k), "nhóm với power là", tags$b(res$inputs$target_power), ", bạn cần một cỡ mẫu ước tính là:"),
tags$h3(style = "color: #007bff; text-align: center;", paste(required_n, "cho mỗi nhóm")),
tags$p(style = "text-align: center; font-style: italic;", "Tổng cỡ mẫu là ", required_n * res$inputs$k, ".")
)
} 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$inputs$target_power, linetype = "dashed", color = "red") +
labs(title = "Power vs. Cỡ mẫu (cho mỗi nhóm)", x = "Cỡ mẫu cho mỗi nhóm (n)", y = "Power thực nghiệm (1 - β)") +
scale_y_continuous(limits = c(0, 1)) + theme_minimal(base_size = 14)
})
output$effect_analysis_plot <- renderPlot({
ggplot() +
labs(title = "Phân tích này không được thực hiện tự động do thời gian tính toán lâu.",
subtitle = "Vui lòng chạy lại với các giá trị Effect Size khác nhau để so sánh.") +
theme_minimal()
})
}
# Chạy ứng dụng Shiny
shinyApp(ui = ui, server = server)