update

2025-10-18 11:56:59 +07:00
parent 33e9543b15
commit 9c4ce1ee57
67 changed files with 7078 additions and 2797 deletions
--- a/samplesize/diagnostest/app.R
+++ b/samplesize/diagnostest/app.R
@@ -0,0 +1,216 @@
+# ==============================================================================
+# Ứ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)