inst/shiny/GNPC_app/app.R

In NPCDTools: The Nonparametric Classification Methods for Cognitive Diagnosis

###############################################################################
# NPC & GNPC Workshop Shiny App – NCME 2026
# Nonparametric Classification Methods
#
# Tabs:
#   1. NPC & GNPC          – simulate, fit, classify, compare
#   2. Simulation with Replications
#   3. Real Data Analysis  – ECPE data
###############################################################################

library(shiny)
library(shinydashboard)
library(shinyAce)
library(shinycssloaders)
library(DT)
library(NPCDTools)
library(GDINA)
library(CDM)


## ── Shared colour tokens (identical to TSQE & Q-completeness apps) ────────────
PRIMARY   <- "#2C5F8A"
PRIMARY_D <- "#1a3d5c"
PRIMARY_L <- "#eef3f8"


## ── Shared CSS ────────────────────────────────────────────────────────────────
unified_css <- sprintf("
  /* ── Google Font ──────────────────────────────────────────────── */
  @import url('https://fonts.googleapis.com/css2?family=Source+Sans+Pro:wght@400;600;700&display=swap');
  body, .content-wrapper, .main-sidebar, .sidebar { font-family: 'Source Sans Pro', sans-serif;
                                                     font-size: 15px; }

  /* ── Page headings ─────────────────────────────────────────────── */
  h2 { font-size: 1.6rem; font-weight: 700; margin-bottom: 12px; }
  h3 { font-size: 1.3rem; font-weight: 600; }
  h4 { font-size: 1.1rem; font-weight: 600; }
  p, li, label, .shiny-input-container { font-size: 15px; line-height: 1.65; }

  /* ── Section headings (1.1–1.4, 3.1–3.2) ──────────────────────── */
  .section-heading {
    font-size: 1.45rem;
    font-weight: 700;
    color: %s;
    margin: 22px 0 10px 0;
    padding-bottom: 5px;
    border-bottom: 2px solid %s;
  }

  /* ── Dashboard chrome ─────────────────────────────────────────── */
  .skin-blue .main-header .logo,
  .skin-blue .main-header .navbar            { background-color: %s !important; }
  .skin-blue .main-header .logo:hover        { background-color: %s !important; }
  .skin-blue .main-sidebar                   { background-color: %s !important; }
  .skin-blue .sidebar-menu > li.active > a,
  .skin-blue .sidebar-menu > li > a:hover    { background-color: rgba(255,255,255,0.12) !important; }
  .skin-blue .sidebar-menu > li > a          { color: #d0dff0; font-size: 14px; }
  .main-header .logo                         { font-weight: 700; font-size: 1.05rem; }

  /* ── Box headers ───────────────────────────────────────────────── */
  .box.box-primary > .box-header             { background-color: %s !important;
                                               border-color:     %s !important; }
  .box.box-info    > .box-header             { background-color: #5b9ec9 !important; }
  .box.box-success > .box-header             { background-color: #3a9a5c !important; }
  .box.box-warning > .box-header             { background-color: #d4860b !important; }
  .box                                       { box-shadow: 0 1px 4px rgba(0,0,0,0.08);
                                               border-radius: 6px; }
  .box-header h3.box-title                   { font-family: 'Source Sans Pro', sans-serif;
                                               font-weight: 700; font-size: 1.5rem !important; }
  .box-body p, .box-body li                  { font-size: 15px; line-height: 1.65; }

  /* ── Info banner ───────────────────────────────────────────────── */
  .info-box-custom {
    padding: 12px 16px;
    background: %s;
    border-left: 4px solid %s;
    border-radius: 4px;
    margin-bottom: 15px;
    font-size: 15px;
    line-height: 1.65;
    color: %s;
  }

  /* ── Run-success feedback banner ───────────────────────────────── */
  .run-success {
    background: #d4edda;
    border-left: 4px solid #28a745;
    color: #155724;
    padding: 8px 14px;
    border-radius: 4px;
    margin-top: 8px;
    font-size: 14px;
    font-weight: 600;
  }

  /* ── Sidebar citation panel ───────────────────────────────────── */
  .sidebar-citation {
    padding: 10px 14px;
    font-size: 12px;
    color: #a8c4d8;
    line-height: 1.6;
  }

  /* ── Code panels ──────────────────────────────────────────────── */
  .code-panel         { margin-top: 12px; }
  .code-panel summary { cursor: pointer; color: %s; font-size: 14px; font-weight: 600; }
  .code-panel summary:hover { text-decoration: underline; }

  /* ── Buttons ──────────────────────────────────────────────────── */
  .btn                 { font-size: 14px !important; }
  .btn-primary         { background-color: #ffffff !important;
                         border-color:     %s !important;
                         color:            %s !important; }
  .btn-primary:hover   { background-color: %s !important;
                         color:            #ffffff !important; }
  .btn-outline-primary { color:            %s !important;
                         border-color:     %s !important;
                         background-color: #ffffff !important; }
  .btn-outline-primary:hover { background-color: %s !important;
                                color:            #ffffff !important; }
  .btn-block           { width: 100%%; margin-top: 4px; }

  /* ── DT tables ─────────────────────────────────────────────────── */
  .dataTables_wrapper               { font-size: 14px; }
  .dataTables_wrapper th,
  .dataTables_wrapper td            { font-size: 14px !important; padding: 6px 10px !important; }
  table.dataTable thead th          { font-weight: 700; }

  /* ── Spinner ──────────────────────────────────────────────────── */
  .shiny-spinner-color { color: %s !important; }
",
                       # section-heading colour + border
                       PRIMARY_D, PRIMARY_L,
                       # chrome
                       PRIMARY, PRIMARY_D, PRIMARY_D,
                       # box-primary header
                       PRIMARY, PRIMARY,
                       # info-box-custom
                       PRIMARY_L, PRIMARY, PRIMARY_D,
                       # code-panel link
                       PRIMARY,
                       # buttons
                       PRIMARY, PRIMARY_D, PRIMARY_D,
                       PRIMARY, PRIMARY, PRIMARY_D,
                       # spinner
                       PRIMARY
)


###############################################################################
#                                    UI
###############################################################################
ui <- dashboardPage(
  skin = "blue",
  
  dashboardHeader(title = "NPC & GNPC Workshop", titleWidth = 260),
  
  dashboardSidebar(
    width = 260,
    sidebarMenu(
      id = "tabs",
      menuItem("NPC & GNPC",                   tabName = "npcgnpc",    icon = icon("chart-bar")),
      menuItem("Simulation with Replications",  tabName = "simulation", icon = icon("flask")),
      menuItem("Real Data Analysis",            tabName = "realdata",   icon = icon("database"))
    ),
    hr(),
    div(class = "sidebar-citation",
        HTML("Chiu, C.-Y., &amp; Douglas, J. A. (2013). <br>
              A nonparametric approach to cognitive diagnosis by proximity. <br>
              <em>Psychometrika, 78</em>(1), 154&ndash;184.<br>
              <br>
              Chiu, C.-Y., Sun, Y., &amp; Bian, Y. (2018). <br>
              Cognitive diagnosis for small educational programs. <br>
              <em>Psychometrika, 83</em>(2), 355&ndash;375."))
  ),
  
  dashboardBody(
    tags$head(
      tags$style(HTML(unified_css)),
      tags$link(
        rel  = "stylesheet",
        href = "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.4/css/all.min.css"
      )
    ),
    
    tabItems(
      
      # ════════════════════════════════════════════════════════════════════════
      #   TAB 1: NPC & GNPC
      # ════════════════════════════════════════════════════════════════════════
      tabItem(
        tabName = "npcgnpc",
        h2("Nonparametric Classification (NPC) and General NPC (GNPC) Methods"),
        div(class = "info-box-custom",
            HTML("<strong>Goal:</strong> Demonstrate how to use the NPC and GNPC methods
                  to classify data and compare results with a parametric CDM.<br>
                  <strong>Data:</strong> A Q-matrix with 30 items and 5 attributes
                  from the <code>GDINA</code> package is used to generate simulated data.")),
        
        # ── 1.1 Data Generation ─────────────────────────────────────────────
        div(class = "section-heading", "1.1  Simulate Data"),
        fluidRow(
          box(
            title = "Data Generation Settings", width = 3,
            status = "info", solidHeader = TRUE,
            sliderInput("N", "Number of Examinees (N):",
                        min = 1, max = 500, value = 100),
            h5(strong("s, g ~ Unif(a, b)")),
            sliderInput("a", "a =", min = 0, max = 0.5, value = 0.1),
            sliderInput("b", "b =", min = 0, max = 0.5, value = 0.2),
            radioButtons("model", "Generating Model:",
                         choices = c("DINA" = "DINA", "DINO" = "DINO",
                                     "ACDM" = "ACDM", "RRUM" = "RRUM",
                                     "G-DINA" = "GDINA"))
          ),
          box(
            title = "Q-Matrix & Simulated Data", width = 9,
            status = "primary", solidHeader = TRUE,
            fluidRow(
              column(4,
                     h4("Q-Matrix (sim30GDINA)"),
                     verbatimTextOutput("Q")),
              column(8,
                     actionButton("goButton1", "Generate Data",
                                  icon = icon("play"), class = "btn-primary"),
                     uiOutput("status_sim"),
                     br(),
                     actionButton("goButton2", "Show Sample Data (first 5 examinees)",
                                  icon = icon("table"), class = "btn-outline-primary"),
                     br(),
                     withSpinner(verbatimTextOutput("sampleData"), color = PRIMARY),
                     div(class = "code-panel",
                         tags$details(
                           tags$summary(tagList(icon("code"), " View R Code")),
                           aceEditor("code_sim_data", mode = "r", theme = "tomorrow",
                                     readOnly = TRUE, height = "180px",
                                     value = "# Click 'Generate Data' to see the code")
                         )))
            )
          )
        ),
        
        # ── 1.2 G-DINA Fit ──────────────────────────────────────────────────
        div(class = "section-heading", "1.2  Fit Data with a Parametric CDM"),
        div(class = "info-box-custom",
            HTML("The function <code>GDINA(dat, Q, model)</code> fits the data.
                  <code>personparm()</code> extracts the estimated attribute profiles.")),
        fluidRow(
          box(
            title = "G-DINA Settings", width = 3,
            status = "info", solidHeader = TRUE,
            radioButtons("fitted.model", "Fitted Model:",
                         choices = c("DINA" = "DINA", "G-DINA" = "GDINA"))
          ),
          box(
            title = "G-DINA Results", width = 9,
            status = "primary", solidHeader = TRUE,
            fluidRow(
              column(6,
                     actionButton("goButton3", "Fit Data",
                                  icon = icon("play"), class = "btn-primary"),
                     uiOutput("status_gdina"),
                     br(),
                     actionButton("goButton4", "Show Sample Estimates (first 5)",
                                  icon = icon("table"), class = "btn-outline-primary"),
                     br(),
                     withSpinner(verbatimTextOutput("sample.att.gdina"), color = PRIMARY)),
              column(6,
                     actionButton("goButton5", "Compute PAR & AAR",
                                  icon = icon("calculator"), class = "btn-outline-primary"),
                     br(),
                     verbatimTextOutput("rate.gdina"))
            ),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_gdina", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "180px",
                            value = "# Click 'Fit Data' to see the code")
                ))
          )
        ),
        
        # ── 1.3 NPC ─────────────────────────────────────────────────────────
        div(class = "section-heading", "1.3  Classify Using the NPC Method"),
        div(class = "info-box-custom",
            HTML("<code>NPC(Y, Q, distance = c('hamming', 'whamming', 'penalized'),
                  gate = c('AND', 'OR'), wg = 1, ws = 1)</code><br>
                  <strong>distance:</strong> distance measure &nbsp;|&nbsp;
                  <strong>gate:</strong> conjunctive (AND) or disjunctive (OR) &nbsp;|&nbsp;
                  <strong>wg, ws:</strong> penalty weights for guessing and slipping
                  (penalized only)")),
        fluidRow(
          box(
            title = "NPC Settings", width = 3,
            status = "info", solidHeader = TRUE,
            selectInput("gate", "Cognitive Structure:",
                        choices = c("AND" = "AND", "OR" = "OR")),
            selectInput("method", "Distance Measure:",
                        choices = c("Hamming"          = "hamming",
                                    "Weighted Hamming"  = "whamming",
                                    "Penalized Hamming" = "penalized"))
          ),
          box(
            title = "NPC Results", width = 9,
            status = "primary", solidHeader = TRUE,
            fluidRow(
              column(6,
                     actionButton("goButton7", "Run NPC",
                                  icon = icon("play"), class = "btn-primary"),
                     uiOutput("status_npc"),
                     br(),
                     actionButton("goButton8", "Show Sample Estimates (first 5)",
                                  icon = icon("table"), class = "btn-outline-primary"),
                     br(),
                     withSpinner(verbatimTextOutput("sample.npc.Att"), color = PRIMARY)),
              column(6,
                     actionButton("goButton9",  "Compute PAR",
                                  icon = icon("calculator"), class = "btn-outline-primary"),
                     br(),
                     textOutput("PAR"),
                     br(),
                     actionButton("goButton10", "Compute AAR",
                                  icon = icon("calculator"), class = "btn-outline-primary"),
                     br(),
                     textOutput("AAR"))
            ),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_npc", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "120px",
                            value = "# Click 'Run NPC' to see the code")
                ))
          )
        ),
        
        # ── 1.4 GNPC ────────────────────────────────────────────────────────
        div(class = "section-heading", "1.4  Classify Using the GNPC Method"),
        div(class = "info-box-custom",
            HTML("<code>GNPC(Y, Q, initial.dis = c('hamming', 'whamming'),
                  initial.gate = c('AND', 'OR'))</code><br>
                  The GNPC method iteratively estimates item-level weights,
                  generalizing beyond purely conjunctive or disjunctive structures.")),
        fluidRow(
          box(
            title = "GNPC Settings", width = 3,
            status = "info", solidHeader = TRUE,
            selectInput("distance", "Initial Distance Measure:",
                        choices = c("Hamming"         = "hamming",
                                    "Weighted Hamming" = "whamming")),
            selectInput("start", "Initial Cognitive Structure:",
                        choices = c("Conjunctive (AND)" = "AND",
                                    "Disjunctive (OR)"  = "OR"))
          ),
          box(
            title = "GNPC Results", width = 9,
            status = "primary", solidHeader = TRUE,
            fluidRow(
              column(6,
                     actionButton("goButton11", "Run GNPC",
                                  icon = icon("play"), class = "btn-primary"),
                     uiOutput("status_gnpc"),
                     br(),
                     actionButton("goButton12", "Show Weights (first 10 items)",
                                  icon = icon("sliders-h"), class = "btn-outline-primary"),
                     br(),
                     withSpinner(verbatimTextOutput("weight"), color = PRIMARY),
                     br(),
                     actionButton("goButton13", "Show Sample Estimates (first 5)",
                                  icon = icon("table"), class = "btn-outline-primary"),
                     br(),
                     withSpinner(verbatimTextOutput("sampleEstAtt.gnpc"), color = PRIMARY)),
              column(6,
                     actionButton("goButton14", "Compute PAR",
                                  icon = icon("calculator"), class = "btn-outline-primary"),
                     br(),
                     textOutput("PAR.gnpc"),
                     br(),
                     actionButton("goButton15", "Compute AAR",
                                  icon = icon("calculator"), class = "btn-outline-primary"),
                     br(),
                     textOutput("AAR.gnpc"))
            ),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_gnpc", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "120px",
                            value = "# Click 'Run GNPC' to see the code")
                ))
          )
        )
      ),
      
      # ════════════════════════════════════════════════════════════════════════
      #   TAB 2: Simulation with Replications
      # ════════════════════════════════════════════════════════════════════════
      tabItem(
        tabName = "simulation",
        h2("Simulation Study with Replications"),
        div(class = "info-box-custom",
            HTML("<strong>Goal:</strong> Compare PAR and AAR of G-DINA, NPC, and GNPC
                  across multiple replications under user-specified conditions.")),
        
        fluidRow(
          box(
            title = "Data Generation", width = 3,
            status = "info", solidHeader = TRUE,
            sliderInput("rep.N", "Number of Examinees (N):",
                        min = 1, max = 500, value = 100),
            h5(strong("s, g ~ Unif(a, b)")),
            sliderInput("rep.a", "a =", min = 0, max = 0.5, value = 0.1),
            sliderInput("rep.b", "b =", min = 0, max = 0.5, value = 0.2),
            radioButtons("gen.model", "Generating Model:",
                         choices = c("DINA" = "DINA", "DINO" = "DINO",
                                     "ACDM" = "ACDM", "RRUM" = "RRUM",
                                     "G-DINA" = "GDINA")),
            radioButtons("structure", "Attribute Structure:",
                         choices = c("Uniform"      = "Uniform",
                                     "Higher-Order" = "Higher-Order")),
            radioButtons("R", "Replications:",
                         choices = c("10" = 10, "20" = 20, "50" = 50))
          ),
          
          box(
            title = "Method Settings", width = 3,
            status = "info", solidHeader = TRUE,
            h4("G-DINA"),
            radioButtons("fitted.structure", "Fitted Attribute Structure:",
                         choices = c("Uniform"      = "Uniform",
                                     "Higher-Order" = "Higher-Order")),
            hr(),
            h4("NPC"),
            selectInput("rep.gate", "Cognitive Structure:",
                        choices = c("AND" = "AND", "OR" = "OR")),
            selectInput("rep.method", "Distance Measure:",
                        choices = c("Hamming"          = "hamming",
                                    "Weighted Hamming"  = "whamming",
                                    "Penalized Hamming" = "penalized")),
            hr(),
            h4("GNPC"),
            selectInput("rep.start", "Initial Cognitive Structure:",
                        choices = c("Conjunctive (AND)" = "AND",
                                    "Disjunctive (OR)"  = "OR")),
            selectInput("rep.distance", "Initial Distance Measure:",
                        choices = c("Hamming"         = "hamming",
                                    "Weighted Hamming" = "whamming"))
          ),
          
          box(
            title = "Results", width = 6,
            status = "primary", solidHeader = TRUE,
            actionButton("rep.goButton1", "Start Simulation",
                         icon = icon("play"), class = "btn-primary btn-block"),
            uiOutput("status_repsim"),
            br(),
            withSpinner(verbatimTextOutput("rep.sim"), color = PRIMARY),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_rep_sim", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "300px",
                            value = "# Click 'Start Simulation' to see the code")
                ))
          )
        )
      ),
      
      # ════════════════════════════════════════════════════════════════════════
      #   TAB 3: Real Data Analysis
      # ════════════════════════════════════════════════════════════════════════
      tabItem(
        tabName = "realdata",
        h2("Real Data Analysis: ECPE Data"),
        div(class = "info-box-custom",
            HTML("<strong>Data:</strong> Examination for the Certificate of Proficiency
                  in English (ECPE) &mdash; 2922 examinees, 28 items, 3 attributes.<br>
                  <strong>Goal:</strong> Compare G-DINA and GNPC attribute profile
                  estimates for selected examinees, focusing on inconsistencies
                  reported by Templin &amp; Hoffman (2013).")),
        
        # ── 3.1 Fixed examinees ─────────────────────────────────────────────
        div(class = "section-heading",
            "3.1  Examinees 1, 10, 14, 29, 33 (Templin & Hoffman, 2013)"),
        fluidRow(
          box(
            title = "Q-Matrix", width = 3,
            status = "info", solidHeader = TRUE,
            verbatimTextOutput("ELI.Q")
          ),
          box(
            title = "Response Data", width = 9,
            status = "primary", solidHeader = TRUE,
            actionButton("goButton.realdata1", "Show Responses",
                         icon = icon("table"), class = "btn-outline-primary"),
            br(),
            verbatimTextOutput("sample.ELI.data")
          )
        ),
        
        fluidRow(
          box(
            title = "Proportion Correct", width = 4,
            status = "success", solidHeader = TRUE,
            actionButton("goButton.realdata2", "Compute",
                         icon = icon("calculator"), class = "btn-outline-primary"),
            br(),
            verbatimTextOutput("prop.correct")
          ),
          box(
            title = "G-DINA Estimates", width = 4,
            status = "warning", solidHeader = TRUE,
            actionButton("goButton.realdata3", "Run G-DINA",
                         icon = icon("play"), class = "btn-primary"),
            uiOutput("status_eli_gdina"),
            br(),
            withSpinner(verbatimTextOutput("sample.gdina"), color = PRIMARY),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_eli_gdina", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "160px",
                            value = "# Click 'Run G-DINA' to see the code")
                ))
          ),
          box(
            title = "GNPC Estimates", width = 4,
            status = "warning", solidHeader = TRUE,
            actionButton("goButton.realdata4", "Run GNPC",
                         icon = icon("play"), class = "btn-primary"),
            uiOutput("status_eli_gnpc"),
            br(),
            withSpinner(verbatimTextOutput("sample.gnpc"), color = PRIMARY),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_eli_gnpc", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "160px",
                            value = "# Click 'Run GNPC' to see the code")
                ))
          )
        ),
        
        # ── 3.2 Random examinees ────────────────────────────────────────────
        div(class = "section-heading", "3.2  Randomly Selected Examinees"),
        div(class = "info-box-custom",
            HTML("Select 5 examinees at random to explore whether estimation
                  inconsistencies extend beyond the 5 cases highlighted by
                  Templin &amp; Hoffman (2013).")),
        
        # Full-width selection box
        fluidRow(
          box(
            title = "Random Selection", width = 12,
            status = "info", solidHeader = TRUE,
            fluidRow(
              column(4,
                     actionButton("goButton.realdata7", "Randomly Select 5 Examinees",
                                  icon = icon("random"), class = "btn-primary"),
                     uiOutput("status_random_select"),
                     br(),
                     textOutput("random.select")),
              column(8,
                     actionButton("goButton.realdata8", "Show Their Responses",
                                  icon = icon("table"), class = "btn-outline-primary"),
                     br(),
                     verbatimTextOutput("rsample.ELI.data"))
            )
          )
        ),
        
        # Three results boxes
        fluidRow(
          box(
            title = "Proportion Correct", width = 4,
            status = "success", solidHeader = TRUE,
            actionButton("goButton.realdata9", "Compute",
                         icon = icon("calculator"), class = "btn-outline-primary"),
            br(),
            verbatimTextOutput("rprop.correct")
          ),
          box(
            title = "G-DINA Estimates", width = 4,
            status = "warning", solidHeader = TRUE,
            actionButton("goButton.realdata10", "Show G-DINA Estimates",
                         icon = icon("table"), class = "btn-outline-primary"),
            br(),
            verbatimTextOutput("rsample.gdina")
          ),
          box(
            title = "GNPC Estimates", width = 4,
            status = "warning", solidHeader = TRUE,
            actionButton("goButton.realdata11", "Show GNPC Estimates",
                         icon = icon("table"), class = "btn-outline-primary"),
            br(),
            verbatimTextOutput("rsample.gnpc")
          )
        ),
        
        # ── 3.3 Classification Consistency Analysis ──────────────────────
        div(class = "section-heading",
            "3.3  Full-Sample Classification Consistency"),
        div(class = "info-box-custom",
            HTML("<strong>Idea:</strong> Section 3.1 showed that examinees with the
                  same proportion correct (e.g. 77%) can receive different
                  classifications under G-DINA. Here we generalize that observation
                  to the full sample: for each unique proportion-correct level and
                  each skill, what fraction of examinees are classified as
                  masters?<br>
                  A consistent method should give the same classification to
                  examinees who share the same empirical evidence.<br><br>
                  <strong>Prerequisite:</strong> Run G-DINA and GNPC in Section 3.1
                  first.")),
        
        fluidRow(
          box(
            title = "Settings", width = 3,
            status = "info", solidHeader = TRUE,
            selectInput("calib_skill", "Skill to Display:",
                        choices = c("Skill 1" = 1, "Skill 2" = 2, "Skill 3" = 3)),
            actionButton("goButton.calib", "Run Analysis",
                         icon = icon("chart-line"), class = "btn-primary btn-block"),
            uiOutput("status_calib"),
            hr(),
            sliderInput("calib_highlight", "Highlight Range (Prop. Correct):",
                        min = 0, max = 1, value = c(0.4, 0.8), step = 0.05),
            br(),
            div(class = "code-panel",
                tags$details(
                  tags$summary(tagList(icon("code"), " View R Code")),
                  aceEditor("code_calib", mode = "r", theme = "tomorrow",
                            readOnly = TRUE, height = "260px",
                            value = "# Click 'Run Analysis' to see the code")
                ))
          ),
          
          box(
            title = "Results", width = 9,
            status = "primary", solidHeader = TRUE,
            withSpinner(plotOutput("calib_plot", height = "360px"), color = PRIMARY),
            br(),
            withSpinner(DTOutput("calib_table"), color = PRIMARY)
          )
        )
      )
      
    ) # end tabItems
  )   # end dashboardBody
)     # end dashboardPage


###############################################################################
#                                   SERVER
###############################################################################
server = function(input, output, session) {
  
  ## ── Helper: success banner ─────────────────────────────────────────────────
  success_banner <- function(msg) {
    div(class = "run-success", icon("check-circle"), paste0(" ", msg))
  }
  
  Q   <- reactive({ sim30GDINA$simQ })
  output$Q <- renderPrint({ Q() })
  
  # ── 1.1 Simulate Data ───────────────────────────────────────────────────────
  sim <- isolate(eventReactive(input$goButton1, {
    K  <- dim(Q())[2]; J  <- dim(Q())[1]
    gs <- data.frame(guess = runif(J, input$a, input$b),
                     slip  = runif(J, input$a, input$b))
    simGDINA(input$N, Q(), gs.parm = gs, model = input$model,
             gs.args = list(type = "random", mono.constraint = TRUE),
             item.names = TRUE)
  }))
  
  output$status_sim <- renderUI({
    req(sim()); success_banner(paste0("Data generated: N = ", input$N,
                                      ", model = ", input$model))
  })
  
  observeEvent(input$goButton1, {
    N <- input$N; model <- input$model; a <- input$a; b <- input$b
    code <- sprintf(
      'library(GDINA)
library(NPCDTools)

Q  <- sim30GDINA$simQ        # 30 items x 5 attributes
J  <- nrow(Q); K <- ncol(Q)
gs <- data.frame(guess = runif(J, %.2f, %.2f),
                 slip  = runif(J, %.2f, %.2f))

set.seed(123)
sim <- simGDINA(%d, Q, gs.parm = gs, model = "%s",
                gs.args = list(type = "random", mono.constraint = TRUE),
                item.names = TRUE)

Y   <- extract(sim, what = "dat")
att <- extract(sim, what = "attribute")', a, b, a, b, N, model)
    updateAceEditor(session, "code_sim_data", value = code)
  })
  
  Y   <- isolate(reactive({ extract(sim(), what = "dat") }))
  att <- isolate(reactive({ extract(sim(), what = "attribute") }))
  
  sampleData <- isolate(eventReactive(input$goButton2, { Y()[1:5, ] }))
  output$sampleData <- renderPrint({ sampleData() })
  
  # ── 1.2 G-DINA ──────────────────────────────────────────────────────────────
  estAtt.gdina <- isolate(eventReactive(input$goButton3, {
    mod <- GDINA(dat = Y(), Q = Q(), model = input$fitted.model, verbose = 0)
    as.matrix(personparm(mod))
  }))
  
  output$status_gdina <- renderUI({
    req(estAtt.gdina())
    success_banner(paste0("G-DINA fitted: model = ", input$fitted.model))
  })
  
  observeEvent(input$goButton3, {
    model <- input$fitted.model
    code <- sprintf(
      '# Fit the simulated data with G-DINA
mod <- GDINA(dat = Y, Q = Q, model = "%s", verbose = 0)

# Extract estimated attribute profiles
att.est <- as.matrix(personparm(mod))

# Compute PAR and AAR against true attribute profiles
PAR(att.est, att)
AAR(att.est, att)', model)
    updateAceEditor(session, "code_gdina", value = code)
  })
  
  sample.att.gdina <- isolate(eventReactive(input$goButton4, {
    estAtt.gdina()[1:5, ]
  }))
  output$sample.att.gdina <- renderPrint({ sample.att.gdina() })
  
  rate.gdina <- isolate(eventReactive(input$goButton5, {
    rate        <- c(PAR(estAtt.gdina(), att()), AAR(estAtt.gdina(), att()))
    names(rate) <- c("PAR", "AAR"); rate
  }))
  output$rate.gdina <- renderPrint({ rate.gdina() })
  
  # ── 1.3 NPC ─────────────────────────────────────────────────────────────────
  estAtt <- isolate(eventReactive(input$goButton7, {
    est <- NPC(Y(), Q(), distance = input$method, gate = input$gate)
    as.matrix(est$att.est)
  }))
  
  output$status_npc <- renderUI({
    req(estAtt())
    success_banner(paste0("NPC complete: distance = ", input$method,
                          ", gate = ", input$gate))
  })
  
  observeEvent(input$goButton7, {
    method <- input$method; gate <- input$gate
    code <- sprintf(
      '# Classify using the NPC method
est <- NPC(Y, Q, distance = "%s", gate = "%s")

# Estimated attribute profiles
att.est <- as.matrix(est$att.est)

# Accuracy
PAR(att.est, att)
AAR(att.est, att)', method, gate)
    updateAceEditor(session, "code_npc", value = code)
  })
  
  sampleEstAtt <- isolate(eventReactive(input$goButton8, { estAtt()[1:5, ] }))
  output$sample.npc.Att <- renderPrint({ sampleEstAtt() })
  
  par <- isolate(eventReactive(input$goButton9,  { PAR(estAtt(), att()) }))
  aar <- isolate(eventReactive(input$goButton10, { AAR(estAtt(), att()) }))
  output$PAR <- renderText({ par() })
  output$AAR <- renderText({ aar() })
  
  # ── 1.4 GNPC ────────────────────────────────────────────────────────────────
  out.gnpc <- isolate(eventReactive(input$goButton11, {
    GNPC(Y(), Q(), initial.dis = input$distance, initial.gate = input$start)
  }))
  
  output$status_gnpc <- renderUI({
    req(out.gnpc())
    success_banner(paste0("GNPC converged: initial.dis = ", input$distance,
                          ", initial.gate = ", input$start))
  })
  
  observeEvent(input$goButton11, {
    dis <- input$distance; gate <- input$start
    code <- sprintf(
      '# Classify using the GNPC method
result <- GNPC(Y, Q, initial.dis = "%s", initial.gate = "%s")

# Estimated attribute profiles
att.est <- as.matrix(result$att.est)

# Item-level weights (J x K matrix)
head(result$weight, 10)

# Accuracy
PAR(att.est, att)
AAR(att.est, att)', dis, gate)
    updateAceEditor(session, "code_gnpc", value = code)
  })
  
  weight <- isolate(eventReactive(input$goButton12, {
    as.matrix((out.gnpc()$weight)[1:10, ])
  }))
  output$weight <- renderPrint({ weight() })
  
  sampleEstAtt.gnpc <- isolate(eventReactive(input$goButton13, {
    as.matrix((out.gnpc()$att.est)[1:5, ])
  }))
  output$sampleEstAtt.gnpc <- renderPrint({ sampleEstAtt.gnpc() })
  
  par.gnpc <- isolate(eventReactive(input$goButton14, { PAR(out.gnpc()$att.est, att()) }))
  aar.gnpc <- isolate(eventReactive(input$goButton15, { AAR(out.gnpc()$att.est, att()) }))
  output$PAR.gnpc <- renderText({ par.gnpc() })
  output$AAR.gnpc <- renderText({ aar.gnpc() })
  
  # ── Tab 2: Simulation with Replications ─────────────────────────────────────
  rep.sim <- isolate(eventReactive(input$rep.goButton1, {
    K      <- dim(Q())[2]; J <- dim(Q())[1]
    gs     <- data.frame(guess = runif(J, input$rep.a, input$rep.b),
                         slip  = runif(J, input$rep.a, input$rep.b))
    lambda <- data.frame(a = rep(1, K), b = seq(-2, 2, length.out = K))
    rate.gdina <- rate.npc <- rate.gnpc <- NULL
    
    withProgress(message = "Running simulation...", value = 0, {
      for (r in 1:as.integer(input$R)) {
        incProgress(1 / as.integer(input$R), detail = paste("Rep", r))
        if (input$structure == "Uniform") {
          sim_r <- simGDINA(input$rep.N, Q(), gs.parm = gs, model = input$gen.model,
                            gs.args = list(type = "random", mono.constraint = TRUE),
                            item.names = TRUE)
        } else {
          theta <- rnorm(input$rep.N)
          sim_r <- simGDINA(input$rep.N, Q(), gs.parm = gs, model = input$gen.model,
                            gs.args = list(type = "random", mono.constraint = TRUE),
                            att.dist = "higher.order",
                            higher.order.parm = list(theta = theta, lambda = lambda),
                            item.names = TRUE)
        }
        Y_r        <- extract(sim_r, what = "dat")
        true.att_r <- extract(sim_r, what = "attribute")
        
        if (input$fitted.structure == "Uniform") {
          est1 <- GDINA(dat = Y_r, Q = Q(), model = "GDINA", verbose = 0)
        } else {
          est1 <- GDINA(dat = Y_r, Q = Q(), model = "GDINA",
                        att.dist = "higher.order",
                        higher.order = list(model = "2PL"), verbose = 0)
        }
        estatt.gdina <- as.matrix(personparm(est1))
        rate.gdina   <- rbind(rate.gdina,
                              c(PAR(estatt.gdina, true.att_r), AAR(estatt.gdina, true.att_r)))
        
        est2       <- NPC(Y_r, Q(), distance = input$rep.method, gate = input$rep.gate)
        estatt.npc <- as.matrix(est2$att.est)
        rate.npc   <- rbind(rate.npc,
                            c(PAR(estatt.npc, true.att_r), AAR(estatt.npc, true.att_r)))
        
        est3        <- GNPC(Y_r, Q(), initial.dis = input$rep.distance,
                            initial.gate = input$rep.start)
        estatt.gnpc <- as.matrix(est3$att.est)
        rate.gnpc   <- rbind(rate.gnpc,
                             c(PAR(estatt.gnpc, true.att_r), AAR(estatt.gnpc, true.att_r)))
      }
    })
    
    out           <- rbind(colMeans(rate.gdina), colMeans(rate.npc), colMeans(rate.gnpc))
    rownames(out) <- c("G-DINA", "NPC", "GNPC")
    colnames(out) <- c("PAR", "AAR")
    out
  }))
  
  output$status_repsim <- renderUI({
    req(rep.sim())
    success_banner(paste0("Simulation complete: ", input$R, " replications, N = ",
                          input$rep.N, ", model = ", input$gen.model))
  })
  
  observeEvent(input$rep.goButton1, {
    N <- input$rep.N; R <- input$R; model <- input$gen.model
    struct <- input$structure; fit_struct <- input$fitted.structure
    npc_dist <- input$rep.method; npc_gate <- input$rep.gate
    gnpc_dis <- input$rep.distance; gnpc_gate <- input$rep.start
    a <- input$rep.a; b <- input$rep.b
    
    code <- sprintf(
      '# === Simulation with %s Replications ===
# N = %d, Generating Model = %s, Structure = %s
Q  <- sim30GDINA$simQ
J  <- nrow(Q); K <- ncol(Q)
gs <- data.frame(guess = runif(J, %.2f, %.2f),
                 slip  = runif(J, %.2f, %.2f))

rate.gdina <- rate.npc <- rate.gnpc <- NULL

for (r in 1:%s) {
  # Simulate data
  sim  <- simGDINA(%d, Q, gs.parm = gs, model = "%s", item.names = TRUE)
  Y    <- extract(sim, what = "dat")
  true.att <- extract(sim, what = "attribute")

  # G-DINA (%s structure)
  est1 <- GDINA(dat = Y, Q = Q, model = "GDINA", verbose = 0)
  rate.gdina <- rbind(rate.gdina,
    c(PAR(as.matrix(personparm(est1)), true.att),
      AAR(as.matrix(personparm(est1)), true.att)))

  # NPC (distance = %s, gate = %s)
  est2 <- NPC(Y, Q, distance = "%s", gate = "%s")
  rate.npc <- rbind(rate.npc,
    c(PAR(as.matrix(est2$att.est), true.att),
      AAR(as.matrix(est2$att.est), true.att)))

  # GNPC (initial.dis = %s, initial.gate = %s)
  est3 <- GNPC(Y, Q, initial.dis = "%s", initial.gate = "%s")
  rate.gnpc <- rbind(rate.gnpc,
    c(PAR(as.matrix(est3$att.est), true.att),
      AAR(as.matrix(est3$att.est), true.att)))
}

out <- rbind(colMeans(rate.gdina), colMeans(rate.npc), colMeans(rate.gnpc))
rownames(out) <- c("G-DINA", "NPC", "GNPC")
colnames(out) <- c("PAR", "AAR")
out',
    R, N, model, struct, a, b, a, b, R, N, model,
    fit_struct, npc_dist, npc_gate, npc_dist, npc_gate,
    gnpc_dis, gnpc_gate, gnpc_dis, gnpc_gate)
    updateAceEditor(session, "code_rep_sim", value = code)
  })
  
  output$rep.sim <- renderPrint({ rep.sim() })
  
  # ── Tab 3: Real Data ─────────────────────────────────────────────────────────
  ELI.data <- reactive({
    data           <- as.matrix(data.ecpe$data[, -1])
    rownames(data) <- paste0("sub.", 1:2922)
    data
  })
  ELI.Q <- reactive({ as.matrix(data.ecpe$q.matrix) })
  output$ELI.Q <- renderPrint({ ELI.Q() })
  
  sample.ELI <- eventReactive(input$goButton.realdata1, {
    ELI.data()[c(1, 10, 14, 29, 33), ]
  })
  output$sample.ELI.data <- renderPrint({ sample.ELI() })
  
  prop.correct <- isolate(eventReactive(input$goButton.realdata2, {
    round((ELI.data()[c(1, 10, 14, 29, 33), ] %*% ELI.Q()) /
            matrix(rep(colSums(ELI.Q()), 5), 5, 3, byrow = TRUE), 2)
  }))
  output$prop.correct <- renderPrint({ prop.correct() })
  
  estAtt.ELI.gdina <- isolate(eventReactive(input$goButton.realdata3, {
    mod            <- GDINA(dat = ELI.data(), Q = ELI.Q(), model = "GDINA", verbose = 0)
    att.gdina      <- as.matrix(personparm(mod))
    rownames(att.gdina) <- paste0("sub.", 1:2922)
    colnames(att.gdina) <- c("Skill1", "Skill2", "Skill3")
    att.gdina
  }))
  
  output$status_eli_gdina <- renderUI({
    req(estAtt.ELI.gdina()); success_banner("G-DINA fitted on ECPE data.")
  })
  
  observeEvent(input$goButton.realdata3, {
    updateAceEditor(session, "code_eli_gdina", value =
                      '# Fit the ECPE data with G-DINA
mod      <- GDINA(dat = ELI.data, Q = ELI.Q, model = "GDINA", verbose = 0)
att.gdina <- as.matrix(personparm(mod))
rownames(att.gdina) <- paste0("sub.", 1:2922)
colnames(att.gdina) <- c("Skill1", "Skill2", "Skill3")

# Inspect the 5 focal examinees
att.gdina[c(1, 10, 14, 29, 33), ]')
  })
  
  sample.gdina <- reactive({ estAtt.ELI.gdina()[c(1, 10, 14, 29, 33), ] })
  output$sample.gdina <- renderPrint({ sample.gdina() })
  
  estAtt.ELI.gnpc <- isolate(eventReactive(input$goButton.realdata4, {
    out            <- GNPC(ELI.data(), ELI.Q(), initial.dis = "hamming", initial.gate = "AND")
    att.gnpc       <- as.matrix(out$att.est)
    rownames(att.gnpc) <- paste0("sub.", 1:2922)
    colnames(att.gnpc) <- c("Skill1", "Skill2", "Skill3")
    att.gnpc
  }))
  
  output$status_eli_gnpc <- renderUI({
    req(estAtt.ELI.gnpc()); success_banner("GNPC converged on ECPE data.")
  })
  
  observeEvent(input$goButton.realdata4, {
    updateAceEditor(session, "code_eli_gnpc", value =
                      '# Classify ECPE data using GNPC
result   <- GNPC(ELI.data, ELI.Q, initial.dis = "hamming", initial.gate = "AND")
att.gnpc <- as.matrix(result$att.est)
rownames(att.gnpc) <- paste0("sub.", 1:2922)
colnames(att.gnpc) <- c("Skill1", "Skill2", "Skill3")

# Inspect the 5 focal examinees
att.gnpc[c(1, 10, 14, 29, 33), ]')
  })
  
  sample.gnpc <- reactive({ estAtt.ELI.gnpc()[c(1, 10, 14, 29, 33), ] })
  output$sample.gnpc <- renderPrint({ sample.gnpc() })
  
  # 3.2 Random examinees
  random.index <- eventReactive(input$goButton.realdata7, {
    sample(1:2922, 5, prob = rep(1 / 2922, 2922))
  })
  
  output$status_random_select <- renderUI({
    req(random.index()); success_banner("5 examinees selected at random.")
  })
  
  output$random.select <- renderText({
    paste("Selected examinees:", paste(random.index(), collapse = ", "))
  })
  
  rsample.ELI <- eventReactive(input$goButton.realdata8, {
    ELI.data()[random.index(), ]
  })
  output$rsample.ELI.data <- renderPrint({ rsample.ELI() })
  
  rprop.correct <- isolate(eventReactive(input$goButton.realdata9, {
    round((ELI.data()[random.index(), ] %*% ELI.Q()) /
            matrix(rep(colSums(ELI.Q()), 5), 5, 3, byrow = TRUE), 2)
  }))
  output$rprop.correct <- renderPrint({ rprop.correct() })
  
  rsample.gdina <- isolate(eventReactive(input$goButton.realdata10, {
    estAtt.ELI.gdina()[random.index(), ]
  }))
  output$rsample.gdina <- renderPrint({ rsample.gdina() })
  
  rsample.gnpc <- isolate(eventReactive(input$goButton.realdata11, {
    estAtt.ELI.gnpc()[random.index(), ]
  }))
  output$rsample.gnpc <- renderPrint({ rsample.gnpc() })
  
  # ── 3.3 Full-Sample Classification Consistency ────────────────────────────────
  calib_data <- eventReactive(input$goButton.calib, {
    req(estAtt.ELI.gdina(), estAtt.ELI.gnpc())
    
    Y    <- ELI.data()
    Qmat <- ELI.Q()
    K    <- ncol(Qmat)
    N    <- nrow(Y)
    
    # Proportion correct per skill for every examinee
    skill_totals <- colSums(Qmat)
    prop_mat     <- (Y %*% Qmat) /
      matrix(rep(skill_totals, each = N), N, K)
    
    att_gdina <- estAtt.ELI.gdina()
    att_gnpc  <- estAtt.ELI.gnpc()
    
    results <- list()
    for (k in 1:K) {
      pc    <- prop_mat[, k]
      uvals <- sort(unique(pc))
      
      tbl <- data.frame(
        PropCorrect    = uvals,
        n              = integer(length(uvals)),
        P_master_GDINA = numeric(length(uvals)),
        P_master_GNPC  = numeric(length(uvals)),
        stringsAsFactors = FALSE
      )
      
      for (i in seq_along(uvals)) {
        idx <- which(pc == uvals[i])
        tbl$n[i]              <- length(idx)
        tbl$P_master_GDINA[i] <- round(mean(att_gdina[idx, k]), 3)
        tbl$P_master_GNPC[i]  <- round(mean(att_gnpc[idx, k]), 3)
      }
      
      results[[k]] <- list(tbl = tbl)
    }
    results
  })
  
  output$status_calib <- renderUI({
    req(calib_data()); success_banner("Analysis complete.")
  })
  
  observeEvent(input$goButton.calib, {
    code <-
      '# === Full-Sample Classification Consistency ===
# Prerequisite: att.gdina and att.gnpc from Section 3.1
Y    <- as.matrix(data.ecpe$data[, -1])
Qmat <- as.matrix(data.ecpe$q.matrix)
N    <- nrow(Y); K <- ncol(Qmat)

# Proportion correct per skill
skill_totals <- colSums(Qmat)
prop_mat     <- (Y %*% Qmat) /
                matrix(rep(skill_totals, each = N), N, K)

k  <- 1   # change to 2 or 3 for other skills
pc <- prop_mat[, k]

# Group by exact proportion-correct value
uvals <- sort(unique(pc))
tbl   <- data.frame(
  PropCorrect = sprintf("%.0f%%", uvals * 100),
  n           = sapply(uvals, function(v) sum(pc == v)),
  P_GDINA     = round(sapply(uvals, function(v)
                   mean(att.gdina[pc == v, k])), 3),
  P_GNPC      = round(sapply(uvals, function(v)
                   mean(att.gnpc[pc == v, k])), 3)
)
print(tbl)

# Plot
plot(uvals, tbl$P_GDINA, type = "b", pch = 16, col = "orange",
     lwd = 2, xlim = c(0, 1), ylim = c(0, 1),
     xlab = "Proportion Correct", ylab = "P(alpha_hat = 1)",
     main = paste("Classification Curve - Skill", k))
lines(uvals, tbl$P_GNPC, type = "b", pch = 17, col = "steelblue", lwd = 2)
legend("topleft", c("G-DINA", "GNPC"),
       col = c("orange", "steelblue"), pch = c(16, 17), lwd = 2)'
  updateAceEditor(session, "code_calib", value = code)
  })

output$calib_plot <- renderPlot({
  req(calib_data())
  k   <- as.integer(input$calib_skill)
  tbl <- calib_data()[[k]]$tbl
  
  x   <- tbl$PropCorrect
  y_g <- tbl$P_master_GDINA
  y_n <- tbl$P_master_GNPC
  
  plot(x, y_g, type = "b", pch = 16, col = "#d4860b", lwd = 2.5, cex = 1.3,
       xlim = c(0, 1), ylim = c(0, 1.05),
       xlab = "Proportion Correct",
       ylab = expression(P(hat(alpha) == 1)),
       main = paste0("Classification Curve \u2014 Skill ", k),
       cex.lab = 1.2, cex.main = 1.3, cex.axis = 0.85, xaxt = "n")
  axis(1, at = seq(0, 1, by = 0.05),
       labels = paste0(seq(0, 100, by = 5), "%"), cex.axis = 0.85)
  
  # Highlight the two ends (outside the selected range)
  hl <- input$calib_highlight
  if (!is.null(hl)) {
    rect(0, -0.05, hl[1], 1.10,
         col = adjustcolor("#FFD700", alpha.f = 0.18),
         border = NA)
    rect(hl[2], -0.05, 1, 1.10,
         col = adjustcolor("#FFD700", alpha.f = 0.18),
         border = NA)
    abline(v = hl[1], col = "#DAA520", lty = 2, lwd = 1.5)
    abline(v = hl[2], col = "#DAA520", lty = 2, lwd = 1.5)
  }
  
  # Re-draw lines on top of shading
  lines(x, y_g, type = "b", pch = 16, col = "#d4860b", lwd = 2.5, cex = 1.3)
  lines(x, y_n, type = "b", pch = 17, col = PRIMARY, lwd = 2.5, cex = 1.3)
  
  legend("topleft",
         legend = c("G-DINA", "GNPC",
                    paste0("Outside: <", hl[1]*100, "% & >", hl[2]*100, "%")),
         col    = c("#d4860b", PRIMARY, adjustcolor("#DAA520", alpha.f = 0.5)),
         pch    = c(16, 17, 15), lty = c(1, 1, NA), lwd = 2,
         pt.cex = c(1, 1, 1.8),
         bg = "white", cex = 1.1)
})

output$calib_table <- renderDT({
  req(calib_data())
  k   <- as.integer(input$calib_skill)
  tbl <- calib_data()[[k]]$tbl
  
  # Flag rows OUTSIDE the highlight range (the two ends)
  hl <- input$calib_highlight
  outside_range <- tbl$PropCorrect < hl[1] | tbl$PropCorrect > hl[2]
  
  tbl$PropCorrect <- sprintf("%.0f%%", tbl$PropCorrect * 100)
  tbl$Highlight   <- ifelse(outside_range, "yes", "no")
  
  colnames(tbl) <- c("Prop. Correct", "n",
                     "P(\u03b1\u0302=1) G-DINA", "P(\u03b1\u0302=1) GNPC",
                     "Highlight")
  datatable(tbl, rownames = FALSE,
            options = list(pageLength = 20, dom = "t",
                           columnDefs = list(
                             list(className = "dt-center", targets = "_all"),
                             list(visible = FALSE, targets = 4)
                           ))) |>
    formatStyle(1:4, "Highlight",
                backgroundColor = styleEqual(c("yes", "no"),
                                             c("#FFF8DC", "transparent")),
                fontWeight      = styleEqual(c("yes", "no"),
                                             c("bold", "normal")))
})
}

###############################################################################
shinyApp(ui, server)