216 lines
11 KiB
R
216 lines
11 KiB
R
# ==============================================================================
|
|
# ỨNG DỤNG SHINY TÍNH CỠ MẪU CHO NGHIÊN CỨU GIÁ TRỊ CHẨN ĐOÁN
|
|
# - Bao gồm tính toán cỡ mẫu và phân tích ảnh hưởng của tỷ lệ hiện mắc.
|
|
# Author: Gemini & User Collaboration
|
|
# Date: 2025-10-17
|
|
# ==============================================================================
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# THIẾT LẬP: Tải các thư viện cần thiết
|
|
# ------------------------------------------------------------------------------
|
|
library(shiny)
|
|
library(bslib)
|
|
library(ggplot2)
|
|
library(shinycssloaders)
|
|
library(dplyr)
|
|
library(purrr)
|
|
library(scales)
|
|
|
|
# ==============================================================================
|
|
# PHẦN 2: GIAO DIỆN NGƯỜI DÙNG (USER INTERFACE - UI)
|
|
# ==============================================================================
|
|
|
|
ui <- fluidPage(
|
|
theme = bs_theme(version = 5, bootswatch = "cerulean"),
|
|
withMathJax(),
|
|
|
|
titlePanel("Công Cụ Tính Cỡ Mẫu Cho Nghiên Cứu Giá trị Chẩn đoán"),
|
|
|
|
sidebarLayout(
|
|
sidebarPanel(
|
|
width = 4,
|
|
h4("Nhập Tham Số"),
|
|
br(),
|
|
|
|
h5("Thông số Xét nghiệm Dự kiến"),
|
|
sliderInput("sens", "Độ nhạy (Sensitivity) dự kiến:", value = 0.90, min = 0.5, max = 0.99, step = 0.01),
|
|
sliderInput("spec", "Độ đặc hiệu (Specificity) dự kiến:", value = 0.98, min = 0.5, max = 0.99, step = 0.01),
|
|
|
|
hr(),
|
|
h5("Thông số Quần thể & Độ chính xác"),
|
|
sliderInput("prev", "Tỷ lệ hiện mắc (Prevalence) của bệnh:", value = 0.02, min = 0.001, max = 0.99, step = 0.001),
|
|
sliderInput("d", "Độ chính xác mong muốn (Sai số d):", value = 0.05, min = 0.01, max = 0.15, step = 0.005),
|
|
sliderInput("conf_level", "Độ tin cậy:", value = 0.95, min = 0.80, max = 0.99, step = 0.01),
|
|
|
|
hr(),
|
|
actionButton("go_diag", "Tính toán & Phân tích", class = "btn-primary w-100", icon = icon("calculator"))
|
|
),
|
|
|
|
mainPanel(
|
|
width = 8,
|
|
tabsetPanel(
|
|
id = "diag_results_tabs",
|
|
type = "pills",
|
|
|
|
tabPanel("Kết quả & Diễn giải",
|
|
withSpinner(uiOutput("diag_result_text"), type = 6, color = "#007bff")),
|
|
|
|
tabPanel("Phân tích & Đồ thị",
|
|
withSpinner(plotOutput("diag_prevalence_plot"), type = 6, color = "#007bff")),
|
|
|
|
tabPanel("Giải thích Tham số",
|
|
uiOutput("diag_params_ui")),
|
|
|
|
tabPanel("Công thức & Ví dụ",
|
|
h4("Công thức tính toán"),
|
|
p("Quá trình tính toán gồm 2 bước:"),
|
|
p(strong("Bước 1: Tính số người có bệnh (\\(n_{dis}\\)) và không bệnh (\\(n_{hea}\\)) cần thiết")),
|
|
withMathJax(HTML("Công thức chung: $$n = \\frac{Z^2_{1-\\alpha/2} \\cdot p(1-p)}{d^2}$$")),
|
|
tags$ul(
|
|
withMathJax(tags$li("Để tính \\(n_{dis}\\), thay \\(p\\) bằng Độ nhạy dự kiến (Se).")),
|
|
withMathJax(tags$li("Để tính \\(n_{hea}\\), thay \\(p\\) bằng Độ đặc hiệu dự kiến (Sp)."))
|
|
),
|
|
|
|
p(strong("Bước 2: Tính tổng cỡ mẫu (N) cần sàng lọc từ tỷ lệ hiện mắc (Prevalence)")),
|
|
withMathJax(HTML("$$N_{sens} = \\frac{n_{dis}}{\\text{Prevalence}}$$")),
|
|
withMathJax(HTML("$$N_{spec} = \\frac{n_{hea}}{1 - \\text{Prevalence}}$$")),
|
|
withMathJax(HTML("Cỡ mẫu cuối cùng là giá trị lớn hơn: $$N = \\max(N_{sens}, N_{spec})$$")),
|
|
|
|
hr(),
|
|
h4("Ví dụ trong Y tế công cộng"),
|
|
p(strong("Bối cảnh nghiên cứu:")),
|
|
p("Một nhà nghiên cứu muốn đánh giá độ chính xác của một xét nghiệm nhanh mới để phát hiện bệnh lao (TB) tại cộng đồng."),
|
|
tags$ul(
|
|
tags$li(strong("Độ nhạy & đặc hiệu dự kiến:"), withMathJax(HTML(" Dựa trên y văn, họ kỳ vọng Se = 90% và Sp = 98%."))),
|
|
tags$li(strong("Độ chính xác mong muốn (d):"), withMathJax(HTML(" Khoảng tin cậy 95% cho các ước tính này không được rộng hơn \\(\\pm 5\\)% (d=0.05)."))),
|
|
tags$li(strong("Tỷ lệ hiện mắc (Prevalence):"), withMathJax(HTML(" Tỷ lệ mắc lao trong vùng nghiên cứu là 2% (Prevalence = 0.02).")))
|
|
),
|
|
p("Các giá trị này đã được đặt làm mặc định trong ứng dụng để bạn dễ hình dung.")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
# ==============================================================================
|
|
# PHẦN 3: LOGIC MÁY CHỦ (SERVER)
|
|
# ==============================================================================
|
|
server <- function(input, output, session) {
|
|
|
|
rv_diag <- reactiveValues()
|
|
|
|
observeEvent(input$go_diag, {
|
|
# Tính toán cơ bản
|
|
z_alpha <- qnorm(1 - (1 - input$conf_level) / 2)
|
|
|
|
n_disease <- ceiling((z_alpha^2 * input$sens * (1 - input$sens)) / input$d^2)
|
|
n_healthy <- ceiling((z_alpha^2 * input$spec * (1 - input$spec)) / input$d^2)
|
|
|
|
n_from_sens <- ceiling(n_disease / input$prev)
|
|
n_from_spec <- ceiling(n_healthy / (1 - input$prev))
|
|
|
|
n_total <- max(n_from_sens, n_from_spec)
|
|
|
|
rv_diag$n_disease <- n_disease
|
|
rv_diag$n_healthy <- n_healthy
|
|
rv_diag$N <- n_total
|
|
|
|
# Dữ liệu cho biểu đồ phân tích độ nhạy
|
|
prev_range <- seq(0.001, 0.99, length.out = 200)
|
|
|
|
plot_data <- tibble(
|
|
prevalence = prev_range,
|
|
N_from_sens = ceiling(n_disease / prevalence),
|
|
N_from_spec = ceiling(n_healthy / (1 - prevalence))
|
|
) %>%
|
|
mutate(N_total = pmax(N_from_sens, N_from_spec))
|
|
|
|
rv_diag$plot_data <- plot_data
|
|
})
|
|
|
|
output$diag_result_text <- renderUI({
|
|
if (input$go_diag == 0) {
|
|
return(tags$div(class="alert alert-info", "Nhập các tham số và nhấn 'Tính toán & Phân tích' để xem kết quả."))
|
|
}
|
|
|
|
req(rv_diag$N)
|
|
|
|
tagList(
|
|
h4("Kết quả tính toán"),
|
|
p("Dựa trên các tham số bạn đã nhập, để đạt được độ chính xác mong muốn, nghiên cứu của bạn cần:"),
|
|
|
|
fluidRow(
|
|
column(6, tags$div(class="alert alert-warning", style="text-align: center;",
|
|
h5("Số người CÓ BỆNH tối thiểu"),
|
|
h3(rv_diag$n_disease)
|
|
)),
|
|
column(6, tags$div(class="alert alert-success", style="text-align: center;",
|
|
h5("Số người KHÔNG BỆNH tối thiểu"),
|
|
h3(rv_diag$n_healthy)
|
|
))
|
|
),
|
|
|
|
hr(),
|
|
h4("Tổng số người cần sàng lọc"),
|
|
p(paste0("Với tỷ lệ hiện mắc của bệnh là ", scales::percent(input$prev, accuracy = 0.1),
|
|
", để tìm đủ số lượng người bệnh và không bệnh nói trên, bạn cần phải sàng lọc tổng cộng:")),
|
|
|
|
tags$h2(style = "color: #007bff; text-align: center; margin-top: 20px;", rv_diag$N, " người")
|
|
)
|
|
})
|
|
|
|
output$diag_prevalence_plot <- renderPlot({
|
|
req(rv_diag$plot_data)
|
|
|
|
# Giới hạn trục y để dễ nhìn hơn
|
|
max_y <- min(quantile(rv_diag$plot_data$N_total, 0.99, na.rm=TRUE) * 1.2, max(rv_diag$plot_data$N_total, na.rm=TRUE))
|
|
if(is.infinite(max_y)) max_y <- 5 * rv_diag$N
|
|
|
|
|
|
ggplot(rv_diag$plot_data, aes(x = prevalence)) +
|
|
geom_line(aes(y = N_from_sens, color = "Dựa trên Độ nhạy"), size = 1.2) +
|
|
geom_line(aes(y = N_from_spec, color = "Dựa trên Độ đặc hiệu"), size = 1.2) +
|
|
geom_vline(xintercept = input$prev, linetype = "dashed", color = "red", size = 1) +
|
|
annotate("text", x = input$prev, y = max_y * 0.9,
|
|
label = paste0("Tỷ lệ hiện mắc đã chọn\n(", scales::percent(input$prev, accuracy = 0.1), ")"),
|
|
color = "red", hjust = if_else(input$prev > 0.5, 1.1, -0.1)) +
|
|
scale_color_manual(values = c("Dựa trên Độ nhạy" = "orange", "Dựa trên Độ đặc hiệu" = "seagreen")) +
|
|
scale_x_continuous(labels = scales::percent) +
|
|
scale_y_log10(labels = scales::comma) + # Trục log giúp dễ nhìn hơn với các giá trị lớn
|
|
coord_cartesian(ylim = c(10, max_y)) +
|
|
labs(
|
|
title = "Ảnh hưởng của Tỷ lệ hiện mắc lên Tổng Cỡ mẫu (N)",
|
|
subtitle = "Đường cong cho thấy số người cần sàng lọc để đạt đủ số ca bệnh (cam) hoặc ca không bệnh (xanh)",
|
|
x = "Tỷ lệ hiện mắc (Prevalence)",
|
|
y = "Tổng Cỡ mẫu cần sàng lọc (trục Log)",
|
|
color = "Cỡ mẫu yêu cầu:"
|
|
) +
|
|
theme_minimal(base_size = 14) +
|
|
theme(legend.position = "bottom")
|
|
})
|
|
|
|
output$diag_params_ui <- renderUI({
|
|
tagList(
|
|
h4("Giải thích các tham số chính"),
|
|
tags$div(class="alert alert-light",
|
|
h5("Độ nhạy (Sensitivity)"),
|
|
p("Là khả năng của xét nghiệm phát hiện chính xác những người ", tags$b("thực sự có bệnh."), " Nó được tính bằng (Số ca dương tính thật) / (Tổng số người có bệnh). Một độ nhạy 90% nghĩa là xét nghiệm sẽ phát hiện được 90 trong số 100 người có bệnh.")
|
|
),
|
|
tags$div(class="alert alert-light",
|
|
h5("Độ đặc hiệu (Specificity)"),
|
|
p("Là khả năng của xét nghiệm xác định chính xác những người ", tags$b("thực sự không có bệnh."), " Nó được tính bằng (Số ca âm tính thật) / (Tổng số người không có bệnh). Một độ đặc hiệu 98% nghĩa là xét nghiệm sẽ cho kết quả âm tính đúng cho 98 trong số 100 người không có bệnh.")
|
|
),
|
|
tags$div(class="alert alert-light",
|
|
h5("Tỷ lệ hiện mắc (Prevalence)"),
|
|
p("Là tỷ lệ phần trăm người đang mắc bệnh trong một quần thể tại một thời điểm nhất định. Tham số này ", tags$strong("cực kỳ quan trọng"), " vì nó quyết định bạn phải sàng lọc bao nhiêu người để tìm đủ số ca bệnh cần thiết cho nghiên cứu, đặc biệt là với các bệnh hiếm.")
|
|
)
|
|
)
|
|
})
|
|
|
|
}
|
|
|
|
|
|
# ==============================================================================
|
|
# PHẦN 4: CHẠY ỨNG DỤNG
|
|
# ==============================================================================
|
|
shinyApp(ui, server) |