suppressPackageStartupMessages({
  library(shiny)
  library(ggplot2)
  library(readxl)
  library(psych)
})

# Development: devtools::load_all() then run this script, or use Dcurvature::run_curvature_app()
if (!requireNamespace("Dcurvature", quietly = TRUE)) {
  stop("Install/load Dcurvature, then run Dcurvature::run_curvature_app() or devtools::load_all().", call. = FALSE)
}

norm_range <- function(x, upper) {
  rng <- range(x, na.rm=TRUE)
  if (diff(rng)==0) return(rep(0,length(x)))
  (x-rng[1])/diff(rng)*upper
}

mstar_fn <- function(kt) {
  # kt has boundary zeros at positions 1 and N
  # interior curvatures: ki[1] = kappa_1, ki[2] = kappa_2, ...
  ki <- kt[-c(1, length(kt))]
  N  <- length(ki)          # number of interior curvaturs = p (number of PCs)
  
  # Edge case: p = 1 -> only one component, trivially m* = 1
  if (N == 1) return(list(mstar=1L, order_used=0L))
  
  # First-order: |Delta kappa_m| = |kappa_{m+1} - kappa_m|
  # boundary zeros make diff at m=1 equal to kappa_1 directly (see paper)
  # Range m in {1, ..., N-1} but we work on ki so index shift +1 for boundary
  d1     <- abs(diff(ki))                  # length N-1
  mstar1 <- which.max(d1) + 1             # +1 for leading boundary zero
  
  # Adaptive rule
  if (mstar1 <= 2 || N < 3) {
    return(list(mstar=mstar1, order_used=1L))
  }
  
  # Second-order: |Delta^2 kappa_m| — range m in {3,...,N-2} on original index
  # on ki that is indices 3..N-2 => at least 4 interior points needed (N>=4)
  if (N < 4) return(list(mstar=mstar1, order_used=1L))
  d2     <- ki[3:N] - 2*ki[2:(N-1)] + ki[1:(N-2)]   # length N-2
  # d2[j] corresponds to m = j+2 in interior index -> m = j+2+1 = j+3 in full index
  mstar2 <- which.max(abs(d2)) + 2 + 1              # +2 offset + 1 boundary zero
  
  list(mstar=mstar2, order_used=2L)
}

kmo_overall <- function(df) {
  tryCatch({
    k <- psych::KMO(df)
    round(k$MSA, 4)
  }, error=function(e) NA)
}

# Per-variable MSA (KMO item statistics); needs >=2 variables for psych::KMO
kmo_msa_per_var <- function(df) {
  d <- na.omit(df)
  nc <- names(d)
  if (length(nc) < 1L) {
    return(setNames(numeric(), character()))
  }
  if (length(nc) < 2L) {
    return(setNames(rep(NA_real_, length(nc)), nc))
  }
  tryCatch({
    k <- psych::KMO(d)
    stats::setNames(as.numeric(k$MSAi), names(k$MSAi))
  }, error = function(e) {
    setNames(rep(NA_real_, length(nc)), nc)
  })
}

kmo_label <- function(v) {
  if (is.na(v)) return("N/A")
  if (v >= 0.90) return(paste0(v, " — Marvelous"))
  if (v >= 0.80) return(paste0(v, " — Meritorious"))
  if (v >= 0.70) return(paste0(v, " — Middling"))
  if (v >= 0.60) return(paste0(v, " — Mediocre"))
  if (v >= 0.50) return(paste0(v, " — Miserable"))
  paste0(v, " — Unacceptable")
}

read_data_table <- function(path, sheet = 1L) {
  ext <- tolower(tools::file_ext(path))
  if (identical(ext, "csv")) {
    read.csv(path, stringsAsFactors = FALSE, check.names = FALSE)
  } else {
    as.data.frame(readxl::read_excel(path, sheet = sheet))
  }
}

# Stops analysis on first failed rule, in order: (1) duplicate names, (2) NA/NaN, (3) non-numeric.
validate_uploaded_data <- function(df) {
  if (is.null(df) || ncol(df) < 1L) {
    return(list(ok = TRUE))
  }
  nm <- names(df)

  if (any(duplicated(nm))) {
    dups_unique <- unique(nm[duplicated(nm)])
    parts <- vapply(dups_unique, function(name) {
      n_occ <- sum(nm == name, na.rm = TRUE)
      paste0("\"", name, "\" appears ", n_occ, " times")
    }, character(1))
    return(list(
      ok = FALSE,
      msg = paste0(
        "The uploaded dataset has duplicate column names. Processing has stopped. ",
        "Each column name must be unique. Duplicated name(s): ",
        paste(parts, collapse = "; "), "."
      )
    ))
  }

  for (j in seq_len(ncol(df))) {
    col <- df[[j]]
    if (any(is.na(col))) {
      cn <- if (length(nm) >= j && nzchar(as.character(nm[j]))) nm[j] else paste0("column ", j)
      return(list(
        ok = FALSE,
        msg = paste0(
          "Missing values (NA or NaN) are not allowed in uploaded data. ",
          "Remove or replace them, then try again. First issue in column \"", cn, "\"."
        )
      ))
    }
  }
  bad <- nm[!vapply(df, is.numeric, logical(1))]
  if (length(bad)) {
    return(list(
      ok = FALSE,
      msg = paste0(
        "All columns must be numeric (integers or floating-point), not text or other types. ",
        "Non-numeric column(s): ", paste(bad, collapse = ", "), "."
      )
    ))
  }
  list(ok = TRUE)
}

first_numeric_col <- function(df) {
  nm <- names(df)
  for (n in nm) {
    if (is.numeric(df[[n]])) return(n)
    x <- suppressWarnings(as.numeric(df[[n]]))
    if (sum(is.finite(x)) > length(x) / 2L) return(n)
  }
  nm[[1]]
}

parse_variance_df <- function(df, col_ind, col_cum, col_comp) {
  vi <- suppressWarnings(as.numeric(df[[col_ind]]))
  ok <- is.finite(vi)
  if (!any(ok)) return(NULL)
  df2 <- df[ok, , drop = FALSE]
  vi <- vi[ok]
  if (length(vi) < 2L) return(NULL)
  if (nzchar(col_cum) && col_cum %in% names(df2)) {
    vc <- suppressWarnings(as.numeric(df2[[col_cum]]))
    if (any(!is.finite(vc))) vc <- cumsum(vi)
  } else {
    vc <- cumsum(vi)
  }
  if (nzchar(col_comp) && col_comp %in% names(df2)) {
    raw_comp <- df2[[col_comp]]
    comps_num <- suppressWarnings(as.numeric(raw_comp))
    if (length(comps_num) == length(vi) && all(is.finite(comps_num))) {
      comps <- as.integer(comps_num)
      comp_label <- trimws(as.character(raw_comp))
    } else {
      comps <- seq_along(vi)
      comp_label <- trimws(as.character(raw_comp))
    }
  } else {
    comps <- seq_along(vi)
    comp_label <- as.character(comps)
  }
  list(var_ind = vi, var_acum = vc, comps = comps, comp_label = comp_label)
}

my_theme <- theme_minimal(base_size=15) +
  theme(plot.title=element_text(face="bold",size=14),
        axis.title=element_text(size=13),
        axis.text=element_text(size=12),
        panel.grid.minor=element_blank())

# ── UI ────────────────────────────────────────────────────────────────────────

ui <- fluidPage(
  tags$head(tags$style(HTML("
    body{font-family:'Georgia',serif;background:#f8f6f0;color:#1a1a2e;}
    .title-box{background:#1a3a2a;color:white;padding:20px 28px 16px;
               border-radius:4px;margin-bottom:22px;}
    .title-box h2{margin:0;font-size:20px;}
    .title-box p{margin:6px 0 0;font-size:12px;color:#a8d5a2;}
    .side-panel{background:white;border-radius:4px;padding:18px;}
    .result-green{background:white;border-left:5px solid #27ae60;
                  padding:14px 18px;border-radius:3px;margin-top:14px;}
    .result-blue{background:white;border-left:5px solid #2471a3;
                 padding:14px 18px;border-radius:3px;margin-top:10px;margin-bottom:20px;}
    .kmo-box{background:white;border-left:5px solid #7d3c98;
             padding:12px 18px;border-radius:3px;margin-top:10px;}
    .result-green h4,.result-blue h4,.kmo-box h4{margin-top:0;color:#1a3a2a;}
    .result-green p,.result-blue p,.kmo-box p{font-size:13px;color:#444;line-height:1.6;}
    .dl-btn{margin-top:6px;width:100%;}
  "))),
  
  div(class="title-box",
      h2("Discrete Curvature Criterion for Principal Component Selection"),
      p("Formal elbow detection via circumcenter-based discrete curvature")
  ),
  
  sidebarLayout(
    sidebarPanel(width=3,
                 div(class="side-panel",
                     
                     h4("1. Data", style="margin-top:0"),
                     radioButtons(
                       "data_entry",
                       NULL,
                       choiceNames = list(
                         tags$span(strong("Use example dataset"), " — PCA and curvature run automatically"),
                         tags$span(strong("Upload my own data"))
                       ),
                       choiceValues = c("example", "upload"),
                       selected = "example"
                     ),
                     conditionalPanel(
                       condition = "input.data_entry == 'example'",
                       tags$p(
                         style = "color:#555;font-size:12px;line-height:1.45;margin-top:6px;",
                         "Uses bundled ", tags$code("data.xlsx"), ": PCA on numeric columns (exclude any below the charts), then discrete curvature."
                       )
                     ),
                     conditionalPanel(
                       condition = "input.data_entry == 'upload'",
                       tagList(
                         hr(),
                         radioButtons(
                           "upload_kind",
                           "What are you uploading?",
                           choiceNames = list(
                             tags$span(strong("Raw variables"), " — observations × variables; app runs PCA"),
                             tags$span(strong("Explained variance table"), " — individual % per component (cumulative optional)")
                           ),
                           choiceValues = c("raw", "variance"),
                           selected = "raw"
                         ),
                         fileInput(
                           "file_upload",
                           "File (.csv, .xlsx, .xls)",
                           accept = c(
                             ".csv", ".xlsx", ".xls", "text/csv",
                             "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
                           ),
                           buttonLabel = "Browse..."
                         ),
                         uiOutput("sheet_upload_ui"),
                         conditionalPanel(
                           condition = "input.data_entry == 'upload' && input.upload_kind == 'variance'",
                           tagList(
                             hr(),
                             uiOutput("variance_column_ui")
                           )
                         )
                       )
                     ),
                     uiOutput("kmo_box_sidebar"),
                     hr(),
                     
                     h4("Normalization"),
                     radioButtons("norm_type", NULL,
                                  choices=c("Min-max  [0, 1]"="01","Min-max  [0, p]"="0p"),
                                  selected="01"),
                     tags$small(style="color:#888;line-height:1.5;display:block;margin-top:-6px;",
                                "p = number of PCs (from your variance table or from PCA on selected variables)."),
                     hr(),
                     
                     h4("Plot focus (individual vs cumulative curve)"),
                     radioButtons("tipo_var", NULL,
                                  choices=c("Individual explained variance"="ind",
                                            "Cumulative explained variance"="acum"),
                                  selected="ind"),
                     hr(),
                     
                     h4("Minimum variance threshold (τ)"),
                     sliderInput("tau", NULL,
                                 min=70, max=99, value=80, step=1, post="%"),
                     tags$small(style="color:#888;line-height:1.5;display:block;margin-top:-6px;",
                                HTML("m** = max(m*, min{i : V<sub>i</sub> ≥ τ}). If m* already reaches τ, m** = m*.")),
                     hr(),
                     
                     conditionalPanel(
                       condition = "input.data_entry == 'upload'",
                       tagList(
                         actionButton(
                           "calcular", "Run analysis",
                           style = "background:#1a3a2a;border:none;color:white;font-weight:bold;
                                    padding:10px;width:100%;border-radius:3px;font-size:14px;cursor:pointer;"
                         ),
                         tags$small(
                           style = "color:#888;display:block;margin-top:8px;line-height:1.4;",
                           "Click after choosing your file and column mapping (variance mode). For raw data, adjust which variables stay in PCA below the charts."
                         )
                       )
                     )
                 )
    ),
    
    mainPanel(width=9,
              tabsetPanel(
                tabPanel("Curvature & Selection", br(),
                         fluidRow(
                           column(6,
                                  plotOutput("plot_var", height="360px"),
                                  downloadButton("dl_var","Download variance plot", class="dl-btn")
                           ),
                           column(6,
                                  plotOutput("plot_kappa", height="360px"),
                                  downloadButton("dl_kappa","Download curvature plot", class="dl-btn")
                           )
                         ),
                         conditionalPanel(
                           condition = "input.data_entry == 'example' || (input.data_entry == 'upload' && input.upload_kind == 'raw')",
                           wellPanel(
                             style = "margin-top:16px;background:#fff;border:1px solid #e0ddd4;",
                             h4("Dataset variables (KMO / MSA)", style = "margin-top:0;color:#1a3a2a;"),
                             tags$p(
                               style = "color:#555;font-size:12px;line-height:1.45;margin-bottom:10px;",
                               "Select variables to ",
                               strong("remove"), " from PCA; at least three must remain."
                             ),
                             selectizeInput(
                               "vars_exclude",
                               label = NULL,
                               choices = NULL,
                               multiple = TRUE,
                               options = list(
                                 placeholder = "Click to list variables — select any to exclude from PCA",
                                 plugins = list("remove_button")
                               ),
                               width = "100%"
                             )
                           )
                         )
                ),
                tabPanel("Results Table", br(),
                         tableOutput("tabla")
                )
              )
    )
  )
)

# ── SERVER ────────────────────────────────────────────────────────────────────

server <- function(input, output, session) {

  example_xlsx_path <- reactive({
    p <- system.file("extdata", "data.xlsx", package = "Dcurvature")
    if (nzchar(p) && file.exists(p)) {
      return(p)
    }
    NULL
  })

  uses_pca <- reactive({
    identical(input$data_entry, "example") ||
      (identical(input$data_entry, "upload") && identical(input$upload_kind, "raw"))
  })

  uses_variance_upload <- reactive({
    identical(input$data_entry, "upload") && identical(input$upload_kind, "variance")
  })

  # Sheet selector for uploaded Excel (raw or variance)
  output$sheet_upload_ui <- renderUI({
    req(identical(input$data_entry, "upload"))
    req(input$file_upload)
    path <- input$file_upload$datapath
    if (identical(tolower(tools::file_ext(path)), "csv")) {
      return(NULL)
    }
    sheets <- tryCatch(readxl::excel_sheets(path), error = function(e) character(0))
    if (length(sheets) > 1L) {
      selectInput("sheet_upload", "Sheet", choices = sheets, selected = sheets[1])
    }
  })

  variance_raw_df <- reactive({
    req(uses_variance_upload())
    req(input$file_upload)
    path <- input$file_upload$datapath
    sheet_sel <- if (!is.null(input$sheet_upload)) input$sheet_upload else 1L
    df <- tryCatch(
      read_data_table(path, sheet = sheet_sel),
      error = function(e) {
        showNotification(paste("Error reading file:", e$message), type = "error")
        NULL
      }
    )
    if (is.null(df)) {
      return(NULL)
    }
    v <- validate_uploaded_data(df)
    if (!isTRUE(v$ok)) {
      showNotification(v$msg, type = "error", duration = NULL, closeButton = TRUE)
      return(NULL)
    }
    df
  })

  output$variance_column_ui <- renderUI({
    req(uses_variance_upload())
    df <- variance_raw_df()
    req(df)
    nm <- names(df)
    def_ind <- first_numeric_col(df)
    cum_choices <- c("(compute cumulative from individual)" = "", nm)
    tagList(
      selectInput("var_col_ind", "Individual explained variance (%)", choices = nm, selected = def_ind),
      selectInput(
        "var_col_cum",
        "Cumulative explained variance (%) — optional",
        choices = cum_choices,
        selected = if ("Cumulative_pct" %in% nm) "Cumulative_pct" else ""
      ),
      selectInput(
        "var_col_comp",
        "Component index column — optional",
        choices = c("(row order → 1, 2, …)" = "", nm),
        selected = if ("PC" %in% nm) "PC" else ""
      )
    )
  })

  parsed_variance <- reactive({
    req(uses_variance_upload())
    df <- variance_raw_df()
    req(df, input$var_col_ind)
    col_cum <- if (!is.null(input$var_col_cum) && nzchar(input$var_col_cum)) input$var_col_cum else ""
    col_comp <- if (!is.null(input$var_col_comp) && nzchar(input$var_col_comp)) input$var_col_comp else ""
    parse_variance_df(df, input$var_col_ind, col_cum, col_comp)
  })

  datos_raw <- reactive({
    req(uses_pca())
    path <- if (identical(input$data_entry, "example")) {
      p <- example_xlsx_path()
      if (is.null(p)) {
        showNotification(
          "Example data not found. Reinstall the Dcurvature package.",
          type = "error"
        )
        return(NULL)
      }
      p
    } else {
      req(input$file_upload)
      input$file_upload$datapath
    }
    sheet_sel <- if (!is.null(input$sheet_upload)) input$sheet_upload else 1L
    ext <- tolower(tools::file_ext(path))
    df <- tryCatch(
      if (identical(ext, "csv")) {
        read_data_table(path, sheet = 1L)
      } else {
        as.data.frame(readxl::read_excel(path, sheet = sheet_sel))
      },
      error = function(e) {
        showNotification(paste("Error reading file:", e$message), type = "error")
        NULL
      }
    )
    if (is.null(df)) {
      return(NULL)
    }
    if (identical(input$data_entry, "upload")) {
      v <- validate_uploaded_data(df)
      if (!isTRUE(v$ok)) {
        showNotification(v$msg, type = "error", duration = NULL, closeButton = TRUE)
        return(NULL)
      }
    }
    df
  })

  num_cols <- reactive({
    req(uses_pca())
    req(datos_raw())
    d <- datos_raw()
    names(d)[sapply(d, is.numeric)]
  })

  observe({
    req(uses_pca())
    req(datos_raw())
    cand <- num_cols()
    req(length(cand) >= 1L)
    d <- datos_raw()[, cand, drop = FALSE]
    msa <- kmo_msa_per_var(d)
    mv <- sapply(cand, function(v) {
      if (length(msa) && v %in% names(msa)) as.numeric(msa[v]) else NA_real_
    })
    lab_ms <- ifelse(is.na(mv), "N/A", format(round(mv, 4), nsmall = 4))
    labs <- paste0(cand, " — MSA ", lab_ms)
    ch <- stats::setNames(cand, labs)
    prev <- isolate(input$vars_exclude)
    if (is.null(prev)) {
      prev <- character(0)
    }
    sel <- intersect(prev, cand)
    updateSelectizeInput(session, "vars_exclude", choices = ch, selected = sel, server = TRUE)
  })

  datos <- reactive({
    req(uses_pca())
    req(datos_raw())
    d0 <- datos_raw()
    cand <- num_cols()
    req(length(cand) >= 3L)
    exc <- input$vars_exclude
    if (is.null(exc)) {
      exc <- character(0)
    }
    exc <- intersect(exc, cand)
    keep <- setdiff(cand, exc)
    req(length(keep) >= 3L)
    na.omit(d0[, keep, drop = FALSE])
  })

  output$kmo_box_sidebar <- renderUI({
    req(uses_pca())
    req(datos())
    d <- datos()
    if (ncol(d) < 3L) {
      return(NULL)
    }
    kmo_val <- kmo_overall(d)
    div(
      class = "kmo-box", style = "margin-top:10px;",
      h4("Overall KMO", style = "margin-bottom:6px;"),
      p(strong(kmo_label(kmo_val)))
    )
  })

  calc_full_resultado <- function(var_ind, var_acum, comps, comp_label) {
    p <- length(comps)
    if (p < 2L) {
      return(NULL)
    }
    upper <- if (input$norm_type == "01") 1 else p

    calc_curv <- function(vy) {
      pts <- data.frame(x = comps / max(comps) * upper, y = norm_range(vy, upper))
      kt <- Dcurvature::curvature(as.matrix(pts))
      km <- max(kt, na.rm = TRUE)
      ki <- kt[-c(1, length(kt))]
      N <- length(ki)
      if (N >= 3) {
        d2_raw <- abs(ki[3:N] - 2 * ki[2:(N - 1)] + ki[1:(N - 2)])
        d2_full <- c(NA, NA, d2_raw, NA, NA)
      } else {
        d2_full <- rep(NA, length(kt))
      }
      d2m <- max(d2_full, na.rm = TRUE)
      d2_norm <- if (!is.na(d2m) && d2m > 0) d2_full / d2m else d2_full
      res <- mstar_fn(kt)
      list(
        kappa = kt, kappa_norm = if (km > 0) kt / km else kt,
        d2 = d2_full, d2_norm = d2_norm,
        mstar = res$mstar, order_used = res$order_used
      )
    }

    tau_val <- input$tau
    ri <- calc_curv(var_ind)
    ra <- calc_curv(var_acum)
    tau_comp <- which(var_acum >= tau_val)
    tau_min <- if (length(tau_comp) > 0) min(tau_comp) else length(comps)
    mss_i <- max(ri$mstar, tau_min, na.rm = TRUE)
    mss_a <- max(ra$mstar, tau_min, na.rm = TRUE)

    list(
      comps = comps,
      comp_label = comp_label,
      var_ind = var_ind,
      var_acum = var_acum,
      x_norm = comps / max(comps) * upper,
      y_ind_norm = norm_range(var_ind, upper),
      y_acum_norm = norm_range(var_acum, upper),
      tau = tau_val,
      tau_min = tau_min,
      mss_i = mss_i,
      mss_a = mss_a,
      p = p,
      upper = upper,
      ri = ri,
      ra = ra
    )
  }

  resultado_example <- reactive({
    req(identical(input$data_entry, "example"))
    req(datos())
    d <- datos()
    if (ncol(d) < 3L || nrow(d) < 3L) {
      return(NULL)
    }
    pca <- prcomp(d, center = TRUE, scale. = TRUE)
    var_ind <- (pca$sdev^2 / sum(pca$sdev^2)) * 100
    var_acum <- cumsum(var_ind)
    comps <- seq_along(var_ind)
    comp_label <- comps
    calc_full_resultado(var_ind, var_acum, comps, comp_label)
  })

  resultado_upload <- eventReactive(input$calcular, {
    req(identical(input$data_entry, "upload"))
    if (identical(input$upload_kind, "variance")) {
      pv <- parsed_variance()
      if (is.null(pv)) {
        showNotification("Could not parse explained variance columns.", type = "error")
        return(NULL)
      }
      ord <- order(pv$comps)
      var_ind <- pv$var_ind[ord]
      var_acum <- pv$var_acum[ord]
      comp_label <- pv$comp_label[ord]
      comps <- seq_along(var_ind)
      if (length(comps) < 2L) {
        showNotification("Need at least two components in the variance table.", type = "error")
        return(NULL)
      }
      calc_full_resultado(var_ind, var_acum, comps, comp_label)
    } else {
      req(datos())
      d <- datos()
      if (ncol(d) < 3L || nrow(d) < 3L) {
        showNotification("Need at least 3 variables and 3 observations.", type = "error")
        return(NULL)
      }
      p <- ncol(d)
      pca <- prcomp(d, center = TRUE, scale. = TRUE)
      var_ind <- (pca$sdev^2 / sum(pca$sdev^2)) * 100
      var_acum <- cumsum(var_ind)
      comps <- seq_len(length(var_ind))
      comp_label <- comps
      calc_full_resultado(var_ind, var_acum, comps, comp_label)
    }
  })

  resultado <- reactive({
    if (identical(input$data_entry, "example")) {
      resultado_example()
    } else {
      resultado_upload()
    }
  })
  
  # ── Plot builders ──────────────────────────────────────────────────────────
  make_var_plot <- function() {
    req(resultado())
    r <- resultado()
    if (input$tipo_var=="ind") {
      yv_raw <- r$var_ind;   yn <- r$y_ind_norm;  ms <- r$ri$mstar
      ytit <- "Individual explained variance"
    } else {
      yv_raw <- r$var_acum;  yn <- r$y_acum_norm; ms <- r$ra$mstar
      ytit <- "Cumulative explained variance"
    }
    xn  <- r$x_norm
    lbl <- if (r$upper==1) "[0, 1]" else paste0("[0, ", r$p, "]")
    df  <- data.frame(comp=xn, y=yn, comp_orig=r$comps)
    # annotation x position
    ax  <- xn[ms] + (max(xn)-min(xn))*0.03
    cl <- r$comp_label
    ggplot(df, aes(comp,y)) +
      geom_line(color="#1a3a2a", linewidth=1.1) +
      geom_point(color="#1a3a2a", size=3) +
      geom_vline(xintercept=xn[ms], color="#e74c3c",
                 linetype="dashed", linewidth=1.2) +
      geom_point(data=df[ms,], aes(comp,y),
                 color="#e74c3c", size=7, shape=18) +
      annotate("text", x=ax, y=max(yn)*0.96,
               label=paste0("m* = ", cl[ms]),
               color="#e74c3c", hjust=0, fontface="bold", size=6) +
      scale_x_continuous(
        breaks = xn[round(seq(1,length(xn), length.out=min(8,length(xn))))],
        labels = cl[round(seq(1,length(cl), length.out=min(8,length(cl))))]
      ) +
      labs(x = "Number of components",
           y = if(input$tipo_var=="ind") "Individual variance (normalized)"
           else "Cumulative variance (normalized)") +
      coord_cartesian(xlim=c(0, max(xn)*1.02),
                      ylim=c(0, max(yn)*1.05),
                      expand=FALSE) +
      my_theme +
      # m** line (tau threshold)
      { mss <- if (input$tipo_var=="ind") r$mss_i else r$mss_a
      if (!is.na(mss) && mss != ms) {
        list(
          geom_vline(xintercept=xn[mss], color="#8e44ad",
                     linetype="dotted", linewidth=1.2),
          geom_point(data=df[mss,], aes(comp,y),
                     color="#8e44ad", size=7, shape=18),
          annotate("text", x=xn[mss]+(max(xn)-min(xn))*0.03,
                   y=max(yn)*0.80,
                   label=paste0("m** = ", cl[mss],
                                "  (τ=", r$tau, "%)"),
                   color="#8e44ad", hjust=0, fontface="bold", size=5)
        )
      }
      }
  }
  
  make_kappa_plot <- function() {
    req(resultado())
    r   <- resultado()
    res <- if (input$tipo_var=="ind") r$ri else r$ra
    ms  <- res$mstar
    ord <- res$order_used
    
    # Choose series and y-label based on which order was used
    if (!is.na(ord) && ord == 1L) {
      # First-order: plot |Delta kappa| (first difference of curvature)
      # |Delta kappa| on full kt (boundary zeros included): length p-1, pad 1 NA
      kt_full <- res$kappa                          # length p
      d1_raw  <- abs(diff(kt_full))                 # length p-1
      d1      <- c(d1_raw, NA)                      # length p
      d1m     <- max(d1, na.rm=TRUE)
      val     <- if (d1m > 0) d1 / d1m else d1
      ylabel <- expression(abs(Delta*tilde(kappa)[m]))
    } else {
      # Second-order: plot |Delta^2 kappa|
      val    <- res$d2_norm
      ylabel <- expression(abs(Delta^2*tilde(kappa)[m]))
    }
    
    xn  <- r$x_norm
    ax  <- xn[ms] + (max(xn)-min(xn))*0.03
    df  <- data.frame(comp=xn, val=val)
    
    ggplot(df, aes(comp,val)) +
      geom_line(color="#d4860b", linewidth=1.1, linetype="dashed", na.rm=TRUE) +
      geom_point(color="#d4860b", size=3, na.rm=TRUE) +
      geom_vline(xintercept=xn[ms], color="#e74c3c",
                 linetype="dashed", linewidth=1.2) +
      geom_point(data=df[ms,], aes(comp,val),
                 color="#e74c3c", size=7, shape=18, na.rm=TRUE) +
      annotate("text", x=ax, y=max(val,na.rm=TRUE)*0.96,
               label=paste0("m* = ", r$comp_label[ms]),
               color="#e74c3c", hjust=0, fontface="bold", size=6) +
      scale_x_continuous(
        breaks = xn[round(seq(1,length(xn), length.out=min(8,length(xn))))],
        labels = r$comp_label[round(seq(1,length(r$comp_label), length.out=min(8,length(r$comp_label))))]
      ) +
      coord_cartesian(xlim=c(0, max(xn)*1.02),
                      ylim=c(0, max(val,na.rm=TRUE)*1.05),
                      expand=FALSE) +
      labs(x="Number of components", y=ylabel) +
      my_theme
  }
  
  output$plot_var   <- renderPlot({ make_var_plot()   })
  output$plot_kappa <- renderPlot({ make_kappa_plot() })
  
  output$dl_var <- downloadHandler(
    filename = function() paste0("variance_plot_", Sys.Date(), ".png"),
    content  = function(file) {
      ggsave(file, plot=make_var_plot(),   width=8, height=5, dpi=180)
    }
  )
  output$dl_kappa <- downloadHandler(
    filename = function() paste0("curvature_plot_", Sys.Date(), ".png"),
    content  = function(file) {
      ggsave(file, plot=make_kappa_plot(), width=8, height=5, dpi=180)
    }
  )
  
  # ── Results table ──────────────────────────────────────────────────────────
  output$tabla <- renderTable({
    req(resultado())
    r<-resultado()
    data.frame(
      Component                  = r$comp_label,
      `Indiv. var. (%)`          = round(r$var_ind,            3),
      `Cumul. var. (%)`          = round(r$var_acum,           3),
      `kappa (individual)`       = round(r$ri$kappa_norm,      5),
      `|D2 kappa| (individual)`  = round(r$ri$d2_norm,         5),
      `kappa (cumulative)`       = round(r$ra$kappa_norm,      5),
      `|D2 kappa| (cumulative)`  = round(r$ra$d2_norm,         5),
      `m* indiv.`                = ifelse(r$comps==r$ri$mstar, "\u25c4", ""),
      `m* cumul.`                = ifelse(r$comps==r$ra$mstar, "\u25c4", ""),
      `m** indiv.`               = ifelse(r$comps==r$mss_i,    "\u25c6", ""),
      `m** cumul.`               = ifelse(r$comps==r$mss_a,    "\u25c6", ""),
      check.names=FALSE
    )
  }, striped=TRUE, hover=TRUE, bordered=TRUE, digits=3)
}

shinyApp(ui, server)