library(shiny)

la_ns_fun <- function(name) {
  get(name, envir = asNamespace("leafareaR"))
}

read_uploaded_data <- function(file_info, sep = ",", dec = ".") {
  req(file_info)
  ext <- tolower(tools::file_ext(file_info$name))
  
  if (ext %in% c("csv", "txt", "tsv")) {
    return(utils::read.table(
      file_info$datapath,
      header = TRUE,
      sep = sep,
      dec = dec,
      stringsAsFactors = FALSE
    ))
  }
  
  if (ext %in% c("xlsx", "xls")) {
    if (!requireNamespace("readxl", quietly = TRUE)) {
      stop("Package 'readxl' must be installed to import Excel files.", call. = FALSE)
    }
    return(as.data.frame(readxl::read_excel(file_info$datapath)))
  }
  
  stop("Unsupported file format. Please upload csv, txt, tsv, xls, or xlsx.", call. = FALSE)
}

rename_for_display <- function(df) {
  if (!is.data.frame(df)) {
    return(df)
  }
  
  labels <- tryCatch(
    la_ns_fun("la_feature_display_names")(named = TRUE),
    error = function(e) NULL
  )
  
  if (is.null(labels)) {
    return(df)
  }
  
  new_names <- names(df)
  idx <- new_names %in% names(labels)
  new_names[idx] <- unname(labels[new_names[idx]])
  names(df) <- new_names
  df
}

pretty_term <- function(x) {
  if (length(x) == 0 || is.na(x) || x == "") {
    return(x)
  }
  
  x <- gsub("L2_plus_W2", "L² + W²", x, fixed = TRUE)
  x <- gsub("L_plus_W", "L + W", x, fixed = TRUE)
  x <- gsub("L_div_W", "L / W", x, fixed = TRUE)
  x <- gsub("W_div_L", "W / L", x, fixed = TRUE)
  x <- gsub("sqrt_L", "√L", x, fixed = TRUE)
  x <- gsub("sqrt_W", "√W", x, fixed = TRUE)
  x <- gsub("log_L", "log(L)", x, fixed = TRUE)
  x <- gsub("log_W", "log(W)", x, fixed = TRUE)
  x <- gsub("inv_L", "1/L", x, fixed = TRUE)
  x <- gsub("inv_W", "1/W", x, fixed = TRUE)
  x <- gsub("LW", "L × W", x, fixed = TRUE)
  x <- gsub("L2", "L²", x, fixed = TRUE)
  x <- gsub("W2", "W²", x, fixed = TRUE)
  x <- gsub("L3", "L³", x, fixed = TRUE)
  x <- gsub("W3", "W³", x, fixed = TRUE)
  x
}

pretty_model_id <- function(x) {
  if (length(x) == 0 || is.na(x) || x == "") {
    return(x)
  }
  
  prefix_map <- c(
    lm_simple_ = "Linear - Simple: ",
    lm_no_intercept_ = "Linear - No intercept: ",
    lm_multiple_ = "Linear - Multiple: ",
    lm_quadratic_ = "Linear - Quadratic: ",
    lm_cubic_ = "Linear - Cubic: ",
    lmm_simple_ = "Mixed - Simple: ",
    lmm_multiple_ = "Mixed - Multiple: ",
    lmm_quadratic_ = "Mixed - Quadratic: ",
    lmm_cubic_ = "Mixed - Cubic: ",
    lmm_random_slope_ = "Mixed - Random slope: ",
    power_ = "Nonlinear - Power: ",
    exponential_ = "Nonlinear - Exponential: ",
    allometric_ = "Nonlinear - Allometric: "
  )
  
  out <- x
  for (pref in names(prefix_map)) {
    if (startsWith(out, pref)) {
      out <- paste0(prefix_map[[pref]], substring(out, nchar(pref) + 1))
      break
    }
  }
  
  out <- gsub("_", " + ", out, fixed = TRUE)
  out <- pretty_term(out)
  out
}

pretty_equation <- function(x) {
  if (length(x) == 0 || is.na(x) || x == "") {
    return(x)
  }
  pretty_term(x)
}

pretty_coefficients <- function(df) {
  if (!is.data.frame(df) || nrow(df) == 0) {
    return(df)
  }
  
  out <- df
  if ("parameter" %in% names(out)) {
    out$parameter <- vapply(
      out$parameter,
      function(z) if (z == "(Intercept)") z else pretty_term(z),
      character(1)
    )
  }
  if ("estimate" %in% names(out)) {
    out$estimate <- round(as.numeric(out$estimate), 4)
  }
  out
}

validate_and_standardize_data <- function(data, l_col, w_col, la_col,
                                          remove_na = TRUE,
                                          remove_nonpositive = TRUE) {
  out <- data
  names(out)[names(out) == l_col] <- "L"
  names(out)[names(out) == w_col] <- "W"
  names(out)[names(out) == la_col] <- "LA"
  
  out <- la_ns_fun("la_validate_input")(
    out,
    l_col = "L",
    w_col = "W",
    la_col = "LA",
    remove_na = remove_na,
    remove_nonpositive = remove_nonpositive,
    standardize_names = TRUE,
    keep_all_columns = TRUE
  )
  
  rownames(out) <- NULL
  out
}

infer_model_type_from_id <- function(model_id) {
  if (length(model_id) == 0 || is.na(model_id) || model_id == "") {
    return(NA_character_)
  }
  
  if (grepl("^lmm_", model_id)) return("mixed")
  if (grepl("^(power_|exponential_|allometric_)", model_id)) return("nonlinear")
  if (grepl("^lm_", model_id)) return("linear")
  NA_character_
}

normalize_model_type_columns <- function(df) {
  if (!is.data.frame(df) || nrow(df) == 0) {
    return(df)
  }
  
  out <- df
  if (!"model_type" %in% names(out)) {
    out$model_type <- NA_character_
  }
  
  fill_idx <- is.na(out$model_type) | trimws(as.character(out$model_type)) == ""
  if ("model_id" %in% names(out) && any(fill_idx)) {
    out$model_type[fill_idx] <- vapply(out$model_id[fill_idx], infer_model_type_from_id, character(1))
  }
  
  out
}

rbind_fill_df <- function(df_list) {
  df_list <- Filter(function(x) is.data.frame(x) && nrow(x) > 0, df_list)
  
  if (length(df_list) == 0) {
    return(data.frame())
  }
  
  all_cols <- unique(unlist(lapply(df_list, names), use.names = FALSE))
  out_list <- lapply(df_list, function(df) {
    missing_cols <- setdiff(all_cols, names(df))
    for (col in missing_cols) {
      df[[col]] <- NA
    }
    df[, all_cols, drop = FALSE]
  })
  
  out <- do.call(rbind, out_list)
  rownames(out) <- NULL
  out
}

merge_results_and_metadata <- function(metric_tables, metadata_tables) {
  metrics <- rbind_fill_df(metric_tables)
  meta <- rbind_fill_df(metadata_tables)
  
  if (nrow(metrics) == 0) {
    return(metrics)
  }
  
  metrics <- normalize_model_type_columns(metrics)
  
  if (nrow(meta) > 0) {
    meta <- normalize_model_type_columns(meta)
    
    keep_cols <- intersect(
      c("model_id", "equation", "random_effect"),
      names(meta)
    )
    meta <- unique(meta[, keep_cols, drop = FALSE])
    
    merged <- merge(
      metrics,
      meta,
      by = "model_id",
      all.x = TRUE,
      sort = FALSE
    )
  } else {
    merged <- metrics
  }
  
  normalize_model_type_columns(merged)
}

make_results_display <- function(df) {
  if (!is.data.frame(df) || nrow(df) == 0) {
    return(df)
  }
  
  out <- df
  
  if ("model_id" %in% names(out)) {
    out$model <- vapply(out$model_id, pretty_model_id, character(1))
  }
  if ("equation" %in% names(out)) {
    out$equation <- vapply(out$equation, pretty_equation, character(1))
  }
  
  drop_cols <- intersect(
    c(
      "model_id", "model_type", "model_form", "model_type.x", "model_type.y",
      "model_form.x", "model_form.y", "coefficients_text", "n", "p", "formula"
    ),
    names(out)
  )
  
  if (length(drop_cols) > 0) {
    out <- out[, setdiff(names(out), drop_cols), drop = FALSE]
  }
  
  if ("random_effect" %in% names(out)) {
    has_random <- any(!is.na(out$random_effect) & trimws(as.character(out$random_effect)) != "")
    if (!has_random) {
      out <- out[, setdiff(names(out), "random_effect"), drop = FALSE]
    }
  }
  
  first_cols <- intersect(c("model", "equation"), names(out))
  other_cols <- setdiff(names(out), first_cols)
  out <- out[, c(first_cols, other_cols), drop = FALSE]
  
  numeric_cols <- intersect(
    c("MSE", "RMSE", "MAE", "MAPE", "BIAS", "ABS_BIAS", "d", "r", "CCC", "R2", "NSE", "AIC", "BIC",
      "rank_simple", "rank_weighted", "rank_mean", "score_weighted", "mean_rank"),
    names(out)
  )
  for (col in numeric_cols) {
    out[[col]] <- round(as.numeric(out[[col]]), 4)
  }
  
  rename_for_display(out)
}

build_scatter_plot <- function(data, x_var) {
  la_ns_fun("la_plot_scatter")(data, x = x_var, y = "LA")
}

save_matrix_plot_png <- function(file, data, variables, color = "#28704a", font = "sans") {
  grDevices::png(filename = file, width = 8, height = 8, units = "in", res = 300, bg = "white")
  on.exit(grDevices::dev.off(), add = TRUE)
  par(family = font) 
  la_ns_fun("la_matrixplot")(data, variables = variables, hist = TRUE, col = color)
}

generate_linear_formulas <- function(predictors, subtypes) {
  formulas <- list()
  if (length(predictors) == 0 || length(subtypes) == 0) {
    return(formulas)
  }
  
  if ("simple" %in% subtypes) {
    for (pred in predictors) {
      formulas[[paste0("lm_simple_", pred)]] <- stats::as.formula(paste("LA ~", pred))
    }
  }
  
  if ("no_intercept" %in% subtypes) {
    for (pred in predictors) {
      formulas[[paste0("lm_no_intercept_", pred)]] <- stats::as.formula(paste("LA ~ 0 +", pred))
    }
  }
  
  if ("multiple" %in% subtypes && length(predictors) >= 2) {
    cmb2 <- combn(predictors, 2, simplify = FALSE)
    for (cmb in cmb2) {
      id <- paste0("lm_multiple_", paste(cmb, collapse = "_"))
      formulas[[id]] <- stats::as.formula(paste("LA ~", paste(cmb, collapse = " + ")))
    }
    if (length(predictors) >= 3) {
      cmb3 <- combn(predictors, 3, simplify = FALSE)
      for (cmb in cmb3) {
        id <- paste0("lm_multiple_", paste(cmb, collapse = "_"))
        formulas[[id]] <- stats::as.formula(paste("LA ~", paste(cmb, collapse = " + ")))
      }
    }
  }
  
  if ("quadratic" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lm_quadratic_", pred)
      formulas[[id]] <- stats::as.formula(paste0("LA ~ ", pred, " + I(", pred, "^2)"))
    }
  }
  
  if ("cubic" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lm_cubic_", pred)
      formulas[[id]] <- stats::as.formula(paste0("LA ~ ", pred, " + I(", pred, "^2) + I(", pred, "^3)"))
    }
  }
  
  formulas
}

generate_mixed_formulas <- function(predictors, subtypes, group_var) {
  formulas <- list()
  if (length(predictors) == 0 || length(subtypes) == 0 || !nzchar(group_var)) {
    return(formulas)
  }
  
  if ("simple" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lmm_simple_", pred)
      formulas[[id]] <- stats::as.formula(paste0("LA ~ ", pred, " + (1 | ", group_var, ")"))
    }
  }
  
  if ("multiple" %in% subtypes && length(predictors) >= 2) {
    cmb2 <- combn(predictors, 2, simplify = FALSE)
    for (cmb in cmb2) {
      id <- paste0("lmm_multiple_", paste(cmb, collapse = "_"))
      formulas[[id]] <- stats::as.formula(
        paste0("LA ~ ", paste(cmb, collapse = " + "), " + (1 | ", group_var, ")")
      )
    }
  }
  
  if ("quadratic" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lmm_quadratic_", pred)
      formulas[[id]] <- stats::as.formula(
        paste0("LA ~ ", pred, " + I(", pred, "^2) + (1 | ", group_var, ")")
      )
    }
  }
  
  if ("cubic" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lmm_cubic_", pred)
      formulas[[id]] <- stats::as.formula(
        paste0("LA ~ ", pred, " + I(", pred, "^2) + I(", pred, "^3) + (1 | ", group_var, ")")
      )
    }
  }
  
  if ("random_slope" %in% subtypes) {
    for (pred in predictors) {
      id <- paste0("lmm_random_slope_", pred)
      formulas[[id]] <- stats::as.formula(
        paste0("LA ~ ", pred, " + (1 + ", pred, " | ", group_var, ")")
      )
    }
  }
  
  formulas
}

generate_nonlinear_model_ids <- function(predictors, subtypes) {
  ids <- character(0)
  
  if ("power" %in% subtypes) {
    if ("L" %in% predictors) ids <- c(ids, "power_L")
    if ("W" %in% predictors) ids <- c(ids, "power_W")
    if ("LW" %in% predictors) ids <- c(ids, "power_LW")
  }
  
  if ("exponential" %in% subtypes) {
    if ("L" %in% predictors) ids <- c(ids, "exponential_L")
    if ("W" %in% predictors) ids <- c(ids, "exponential_W")
    if ("LW" %in% predictors) ids <- c(ids, "exponential_LW")
  }
  
  if ("allometric" %in% subtypes) {
    if ("LW" %in% predictors) ids <- c(ids, "allometric_LW")
  }
  
  unique(ids)
}

load_example_data <- function() {
  data_env <- new.env(parent = emptyenv())
  try(utils::data("leafarea_sample", package = "leafareaR", envir = data_env), silent = TRUE)
  
  if (exists("leafarea_sample", envir = data_env, inherits = FALSE)) {
    return(as.data.frame(get("leafarea_sample", envir = data_env, inherits = FALSE)))
  }
  
  csv_path <- system.file("extdata", "leafarea_sample.csv", package = "leafareaR")
  if (nzchar(csv_path) && file.exists(csv_path)) {
    return(utils::read.csv(csv_path, stringsAsFactors = FALSE))
  }
  
  local_path <- file.path("inst", "extdata", "leafarea_sample.csv")
  if (file.exists(local_path)) {
    return(utils::read.csv(local_path, stringsAsFactors = FALSE))
  }
  
  local_path_up <- file.path("..", "..", "inst", "extdata", "leafarea_sample.csv")
  if (file.exists(local_path_up)) {
    return(utils::read.csv(local_path_up, stringsAsFactors = FALSE))
  }
  
  stop(
    "Example dataset 'leafarea_sample.csv' was not found. Please ensure it is located in the 'inst/extdata' folder.",
    call. = FALSE
  )
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      :root {
        --la-bg: #f5f7f4;
        --la-panel: #ffffff;
        --la-panel-soft: #f9fbf8;
        --la-border: #dbe4dc;
        --la-ink: #17221b;
        --la-muted: #617067;
        --la-green: #28704a;
        --la-green-dark: #1f563a;
        --la-gold: #b07a28;
        --la-shadow: 0 12px 30px rgba(23, 34, 27, 0.08);
      }

      body {
        background: var(--la-bg);
        color: var(--la-ink);
        font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', sans-serif;
      }

      .la-page {
        max-width: 1480px;
        padding: 24px;
      }

      .la-app-header {
        align-items: center;
        background: #17221b;
        border-radius: 8px;
        box-shadow: var(--la-shadow);
        color: #ffffff;
        display: flex;
        justify-content: space-between;
        margin-bottom: 18px;
        min-height: 88px;
        padding: 18px 22px;
      }

      .la-brand {
        display: flex;
        flex-direction: column;
        gap: 4px;
      }

      .la-brand-title {
        font-size: 30px;
        font-weight: 700;
        letter-spacing: 0;
        line-height: 1.1;
      }

      .la-brand-subtitle {
        color: #cbd8cf;
        font-size: 14px;
        line-height: 1.35;
      }

      .la-header-badge {
        background: rgba(255, 255, 255, 0.12);
        border: 1px solid rgba(255, 255, 255, 0.18);
        border-radius: 999px;
        color: #eef5ef;
        font-size: 13px;
        font-weight: 600;
        padding: 7px 12px;
        white-space: nowrap;
      }

      .la-workspace {
        align-items: flex-start;
        display: flex;
      }

      .la-sidebar,
      .la-main {
        background: var(--la-panel);
        border: 1px solid var(--la-border);
        border-radius: 8px;
        box-shadow: var(--la-shadow);
      }

      .la-sidebar {
        padding: 16px;
      }

      .la-main {
        min-height: 760px;
        padding: 18px;
      }

      .la-section {
        background: var(--la-panel-soft);
        border: 1px solid var(--la-border);
        border-radius: 8px;
        margin-bottom: 14px;
        padding: 14px;
      }

      .la-section-title {
        color: var(--la-ink);
        font-size: 13px;
        font-weight: 700;
        letter-spacing: 0.02em;
        margin-bottom: 12px;
        text-transform: uppercase;
      }

      .la-action-row {
        align-items: center;
        display: flex;
        flex-wrap: wrap;
        gap: 8px;
        margin-bottom: 10px;
      }

      .la-source-status {
        background: #eef5ef;
        border-left: 4px solid var(--la-green);
        border-radius: 6px;
        color: var(--la-green-dark);
        font-size: 13px;
        margin-bottom: 14px;
        padding: 10px 12px;
      }

      .la-main .tab-content {
        padding-top: 18px;
      }

      .la-main .nav-tabs {
        border-bottom: 1px solid var(--la-border);
      }

      .la-main .nav-tabs > li > a {
        border: 0;
        border-radius: 6px 6px 0 0;
        color: var(--la-muted);
        font-weight: 600;
        margin-right: 4px;
      }

      .la-main .nav-tabs > li.active > a,
      .la-main .nav-tabs > li.active > a:focus,
      .la-main .nav-tabs > li.active > a:hover {
        background: #e7f1e9;
        border: 0;
        border-bottom: 3px solid var(--la-green);
        color: var(--la-green-dark);
      }

      .la-sidebar label,
      .la-main label {
        color: var(--la-ink);
        font-size: 13px;
        font-weight: 650;
      }

      .form-control,
      .selectize-input {
        border-color: #cbd8cf;
        border-radius: 6px;
        box-shadow: none;
        color: var(--la-ink);
      }

      .form-control:focus,
      .selectize-input.focus {
        border-color: var(--la-green);
        box-shadow: 0 0 0 3px rgba(40, 112, 74, 0.12);
      }

      .checkbox,
      .checkbox-inline {
        color: var(--la-muted);
        font-size: 13px;
      }

      .btn {
        border-radius: 6px;
        font-weight: 650;
      }

      #fit_models,
      #load_example_data {
        background: var(--la-green);
        border-color: var(--la-green);
        color: #ffffff;
      }

      #fit_models:hover,
      #load_example_data:hover {
        background: var(--la-green-dark);
        border-color: var(--la-green-dark);
      }

      .btn-default,
      .btn-download {
        background: #ffffff;
        border-color: #cbd8cf;
        color: var(--la-green-dark);
      }

      .btn-default:hover,
      .btn-download:hover {
        background: #f0f6f1;
        border-color: var(--la-green);
        color: var(--la-green-dark);
      }

      table {
        background: #ffffff;
        border-collapse: separate;
        border-spacing: 0;
        width: 100%;
      }

      /* CABEÇALHOS DA TABELA DIMINUIDOS E COMPACTADOS */
      table > thead > tr > th {
        background: #eef5ef;
        border-bottom: 1px solid var(--la-border);
        color: var(--la-ink);
        font-size: 11px;
        font-weight: 700;
        text-transform: uppercase;
        padding: 6px 10px;
        white-space: nowrap;
      }

      /* LINHAS DA TABELA DIMINUIDAS E COMPACTADAS */
      table > tbody > tr > td {
        border-top: 1px solid #edf2ed;
        color: #26342a;
        font-size: 11.5px;
        padding: 5px 10px;
        white-space: nowrap;
      }

      pre {
        background: #fbfcfb;
        border-color: var(--la-border);
        border-radius: 8px;
        color: #26342a;
      }

      .la-plot-grid {
        display: grid;
        gap: 16px;
        grid-template-columns: repeat(2, minmax(0, 1fr));
      }

      .la-plot-panel {
        border: 1px solid var(--la-border);
        border-radius: 8px;
        padding: 14px;
      }

      .la-downloads {
        align-items: center;
        display: flex;
        flex-wrap: wrap;
        gap: 8px;
        margin-bottom: 14px;
      }

      .instructions-box {
        padding: 24px;
        font-size: 15px;
        line-height: 1.6;
        color: #333;
      }
      .instructions-box h3 {
        color: var(--la-green-dark);
        font-weight: 700;
        margin-top: 0;
      }
      .instructions-box ol {
        padding-left: 20px;
      }
      .instructions-box li {
        margin-bottom: 12px;
      }

      .la-table-container {
        overflow-x: auto;
        width: 100%;
        margin-top: 10px;
        border: 1px solid var(--la-border);
        border-radius: 4px;
      }

      @media (max-width: 900px) {
        .la-page {
          padding: 12px;
        }

        .la-app-header {
          align-items: flex-start;
          flex-direction: column;
          gap: 12px;
        }

        .la-brand-title {
          font-size: 24px;
        }

        .la-sidebar {
          margin-bottom: 16px;
        }

        .la-plot-grid {
          grid-template-columns: 1fr;
        }
      }
    "))
  ),
  div(
    class = "la-page",
    div(
      class = "la-app-header",
      div(
        class = "la-brand",
        div(class = "la-brand-title", "leafareaR"),
        div(class = "la-brand-subtitle", "Leaf area modeling, evaluation, and prediction")
      ),
      div(class = "la-header-badge", "Interactive analysis")
    ),
    fluidRow(
      class = "la-workspace",
      column(
        width = 4,
        div(
          class = "la-sidebar",
          div(
            class = "la-section",
            div(class = "la-section-title", "Data source"),
            fileInput("data_file", "Upload data", accept = c(".csv", ".txt", ".tsv", ".xls", ".xlsx")),
            fluidRow(
              column(6, selectInput("txt_sep", "Column separator", choices = c("Comma (,)" = ",", "Semicolon (;)" = ";", "Tab" = "\t"), selected = ",")),
              column(6, selectInput("dec_sep", "Decimal separator", choices = c("Dot (.)" = ".", "Comma (,)" = ","), selected = "."))
            )
          ),
          div(
            class = "la-section",
            div(class = "la-section-title", "Example data"),
            div(
              class = "la-action-row",
              actionButton("load_example_data", "Load example"),
              downloadButton("download_example_csv", "Download CSV")
            ),
            div(class = "la-table-container", tableOutput("example_data_preview"))
          ),
          div(class = "la-source-status", textOutput("data_source_status")),
          div(
            class = "la-section",
            div(class = "la-section-title", "Columns"),
            uiOutput("column_mapping_ui"),
            checkboxInput("remove_na", "Remove missing values", value = TRUE),
            checkboxInput("remove_nonpositive", "Remove non-positive values", value = TRUE)
          ),
          div(
            class = "la-section",
            div(class = "la-section-title", "Predictors"),
            checkboxGroupInput("predictors", "Predictors for modeling", choices = NULL)
          ),
          div(
            class = "la-section",
            div(class = "la-section-title", "Models"),
            checkboxGroupInput(
              "model_families",
              "Model families",
              choices = c("Linear" = "linear", "Nonlinear" = "nonlinear", "Mixed" = "mixed"),
              selected = c("linear", "nonlinear")
            ),
            uiOutput("linear_subtypes_ui"),
            uiOutput("nonlinear_subtypes_ui"),
            uiOutput("mixed_subtypes_ui"),
            uiOutput("group_var_ui"),
            actionButton("fit_models", "Fit models")
          ),
          div(
            class = "la-section",
            div(class = "la-section-title", "Plot settings (Publication quality)"),
            selectInput("plot_font", "Font family", choices = c("Arial / Sans-serif" = "sans", "Times New Roman / Serif" = "serif", "Courier / Monospace" = "mono"), selected = "sans"),
            selectInput("plot_color", "Base color", choices = c("Green (Default)" = "#28704a", "Black" = "black", "Dark Grey" = "grey30", "Blue" = "#1b5b8a", "Red" = "#8a1b1b"), selected = "#28704a")
          )
        )
      ),
      column(
        width = 8,
        div(
          class = "la-main",
          tabsetPanel(
            tabPanel(
              "Instructions",
              div(class = "instructions-box",
                  h3("How to use leafareaR"),
                  tags$ol(
                    tags$li(strong("Upload your data:"), " Use the sidebar to upload your CSV or Excel file. If using CSV, make sure to adjust the Column and Decimal separators to match your file format."),
                    tags$li(strong("Map the columns:"), " Confirm that the software correctly identified your Length (L), Width (W), and Leaf Area (LA) columns."),
                    tags$li(strong("Select predictors and models:"), " Choose the predictors you wish to test (e.g., L, W, L², L × W) and select the model families (Linear, Nonlinear, or Mixed)."),
                    tags$li(strong("Fit models:"), " Click the green 'Fit models' button at the bottom of the sidebar. The software will compute and rank all possible models automatically based on their statistical strength."),
                    tags$li(strong("Review and Export:"), " Navigate to the 'Results' tab to see the full ranking. The 'Top model' tab displays the best equation and diagnostic plots. All tables and plots can be downloaded in publication-ready formats.")
                  ),
                  hr(),
                  p(strong("Pro tip for publications:"), " Use the 'Plot settings' section at the bottom of the sidebar to change the font family (e.g., Times New Roman) and switch colors to grayscale to meet scientific journal requirements.")
              )
            ),
            tabPanel("Data", 
                     div(class = "la-table-container", tableOutput("data_preview")), 
                     verbatimTextOutput("data_info")
            ),
            tabPanel("Derived", 
                     div(class = "la-table-container", tableOutput("derived_preview"))
            ),
            tabPanel("Descriptive", 
                     uiOutput("descriptive_vars_ui"), 
                     div(class = "la-table-container", tableOutput("descriptive_table"))
            ),
            tabPanel(
              "Plots",
              div(
                class = "la-plot-grid",
                div(
                  class = "la-plot-panel",
                  selectInput("scatter_x", "Scatter x variable", choices = NULL),
                  downloadButton("download_scatter_png", "Export scatter (PNG 300 dpi)"),
                  plotOutput("scatter_plot", height = 320)
                ),
                div(
                  class = "la-plot-panel",
                  uiOutput("matrix_vars_ui"),
                  downloadButton("download_matrix_png", "Export matrix plot (PNG 300 dpi)"),
                  plotOutput("matrix_plot", height = 320)
                )
              )
            ),
            tabPanel(
              "Results",
              div(
                class = "la-downloads",
                downloadButton("download_ranked_csv", "Export results (CSV)"),
                downloadButton("download_ranked_xlsx", "Export results (Excel)")
              ),
              div(class = "la-table-container", tableOutput("results_table"))
            ),
            tabPanel(
              "Top model",
              numericInput("rank_position", "Rank position", value = 1, min = 1, step = 1),
              verbatimTextOutput("top_model_equation"),
              div(class = "la-table-container", tableOutput("top_model_coefficients")),
              downloadButton("download_top_model_png", "Export top model plot (PNG 300 dpi)"),
              plotOutput("top_model_plot", height = 360),
              div(class = "la-table-container", tableOutput("top_model_table"))
            )
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {
  active_data <- reactiveVal(NULL)
  active_data_source <- reactiveVal("No data loaded. Upload a file or click 'Load Example Data'.")
  
  observeEvent(input$load_example_data, {
    dat <- tryCatch(load_example_data(), error = function(e) e)
    if (inherits(dat, "error")) {
      showNotification(conditionMessage(dat), type = "error")
      return()
    }
    
    active_data(dat)
    active_data_source("Loaded example dataset: leafarea_sample")
    showNotification("Example dataset loaded: leafarea_sample", type = "message")
  }, ignoreInit = TRUE)
  
  observeEvent(list(input$data_file, input$txt_sep, input$dec_sep), {
    req(input$data_file)
    
    dat <- tryCatch(
      read_uploaded_data(input$data_file, sep = input$txt_sep, dec = input$dec_sep),
      error = function(e) e
    )
    if (inherits(dat, "error")) {
      showNotification(conditionMessage(dat), type = "error")
      return()
    }
    
    active_data(dat)
    active_data_source(paste0("Loaded file: ", input$data_file$name))
    showNotification(paste0("Data loaded from file: ", input$data_file$name), type = "message")
  }, ignoreInit = TRUE)
  
  output$data_source_status <- renderText({
    active_data_source()
  })
  
  output$example_data_preview <- renderTable({
    utils::head(load_example_data()[, c("L", "W", "LA"), drop = FALSE], 4)
  }, digits = 3)
  
  output$download_example_csv <- downloadHandler(
    filename = function() {
      "leafarea_sample.csv"
    },
    content = function(file) {
      utils::write.csv(load_example_data(), file = file, row.names = FALSE, fileEncoding = "UTF-8-BOM")
    }
  )
  
  raw_data <- reactive({
    req(active_data())
    active_data()
  })
  
  feature_labels <- reactive({
    tryCatch(la_ns_fun("la_feature_display_names")(named = TRUE), error = function(e) character(0))
  })
  
  output$column_mapping_ui <- renderUI({
    req(raw_data())
    cols <- names(raw_data())
    
    default_l <- if ("L" %in% cols) "L" else cols[1]
    default_w <- if ("W" %in% cols) "W" else cols[min(2, length(cols))]
    default_la <- if ("LA" %in% cols) "LA" else cols[min(3, length(cols))]
    
    tagList(
      selectInput("l_col", "Length column (L)", choices = cols, selected = default_l),
      selectInput("w_col", "Width column (W)", choices = cols, selected = default_w),
      selectInput("la_col", "Leaf area column (LA)", choices = cols, selected = default_la)
    )
  })
  
  validated_data <- reactive({
    req(raw_data(), input$l_col, input$w_col, input$la_col)
    validate_and_standardize_data(
      data = raw_data(),
      l_col = input$l_col,
      w_col = input$w_col,
      la_col = input$la_col,
      remove_na = isTRUE(input$remove_na),
      remove_nonpositive = isTRUE(input$remove_nonpositive)
    )
  })
  
  observe({
    base_predictors <- c("L", "W")
    derived_choices <- tryCatch(la_ns_fun("la_list_derived")(), error = function(e) character(0))
    all_choices <- unique(c(base_predictors, derived_choices))
    labels <- feature_labels()
    
    display_labels <- all_choices
    idx <- all_choices %in% names(labels)
    display_labels[idx] <- labels[all_choices[idx]]
    names(all_choices) <- display_labels
    
    default_selected <- intersect(c("L", "W", "LW"), all_choices)
    updateCheckboxGroupInput(session, "predictors", choices = all_choices, selected = default_selected)
  })
  
  output$linear_subtypes_ui <- renderUI({
    req(input$model_families)
    if (!"linear" %in% input$model_families) return(NULL)
    checkboxGroupInput(
      "linear_subtypes",
      "Linear model types",
      choices = c(
        "Simple" = "simple",
        "Multiple" = "multiple",
        "Quadratic" = "quadratic",
        "Cubic" = "cubic",
        "No intercept" = "no_intercept"
      ),
      selected = c("simple", "multiple")
    )
  })
  
  output$nonlinear_subtypes_ui <- renderUI({
    req(input$model_families)
    if (!"nonlinear" %in% input$model_families) return(NULL)
    checkboxGroupInput(
      "nonlinear_subtypes",
      "Nonlinear model types",
      choices = c(
        "Power" = "power",
        "Exponential" = "exponential",
        "Allometric" = "allometric"
      ),
      selected = c("power", "exponential", "allometric")
    )
  })
  
  output$mixed_subtypes_ui <- renderUI({
    req(input$model_families)
    if (!"mixed" %in% input$model_families) return(NULL)
    checkboxGroupInput(
      "mixed_subtypes",
      "Mixed model types",
      choices = c(
        "Simple" = "simple",
        "Multiple" = "multiple",
        "Quadratic" = "quadratic",
        "Cubic" = "cubic",
        "Random slope" = "random_slope"
      ),
      selected = c("simple", "multiple")
    )
  })
  
  derived_data <- reactive({
    dat <- validated_data()
    predictors <- input$predictors
    req(predictors)
    
    derived_vars <- setdiff(predictors, c("L", "W", "LA"))
    if (length(derived_vars) == 0) {
      return(dat)
    }
    
    la_ns_fun("la_create_derived")(dat, variables = derived_vars, keep_original = TRUE)
  })
  
  output$group_var_ui <- renderUI({
    req(validated_data(), input$model_families)
    if (!"mixed" %in% input$model_families) return(NULL)
    
    extra_cols <- setdiff(names(validated_data()), c("L", "W", "LA"))
    default_group <- if ("species" %in% extra_cols) "species" else ""
    
    selectInput(
      "group_var",
      "Grouping variable for mixed models",
      choices = c("None" = "", extra_cols),
      selected = default_group
    )
  })
  
  output$data_preview <- renderTable({
    utils::head(rename_for_display(validated_data()), 10)
  })
  
  output$data_info <- renderPrint({
    cat("Source:", active_data_source(), "\n")
    if (is.null(active_data())) {
      cat("Rows: 0\n")
      cat("Columns: 0\n")
      return(invisible(NULL))
    }
    
    dat <- validated_data()
    cat("Rows:", nrow(dat), "\n")
    cat("Columns:", ncol(dat), "\n")
    cat("Variables:", paste(names(rename_for_display(dat)), collapse = ", "), "\n")
  })
  
  output$derived_preview <- renderTable({
    utils::head(rename_for_display(derived_data()), 10)
  })
  
  output$descriptive_vars_ui <- renderUI({
    req(derived_data())
    num_vars <- names(derived_data())[vapply(derived_data(), is.numeric, logical(1))]
    labels <- feature_labels()
    choices <- num_vars
    idx <- num_vars %in% names(labels)
    names(choices) <- choices
    names(choices)[idx] <- labels[num_vars[idx]]
    
    default_desc <- intersect(c("L", "W", "LA", "LW"), num_vars)
    
    selectInput("descriptive_vars", "Variables", choices = choices, selected = default_desc, multiple = TRUE)
  })
  
  output$descriptive_table <- renderTable({
    req(input$descriptive_vars)
    out <- la_ns_fun("la_descriptive_stats")(derived_data(), variables = input$descriptive_vars)
    out$variable <- ifelse(out$variable %in% names(feature_labels()), feature_labels()[out$variable], out$variable)
    
    rn <- out$variable
    out_t <- as.data.frame(t(out[, -1, drop = FALSE]))
    colnames(out_t) <- rn
    out_t$Statistic <- rownames(out_t)
    
    out_t <- out_t[, c("Statistic", rn), drop = FALSE]
    rownames(out_t) <- NULL
    out_t
  }, rownames = FALSE)
  
  observe({
    req(derived_data())
    num_vars <- names(derived_data())[vapply(derived_data(), is.numeric, logical(1))]
    x_choices <- setdiff(num_vars, "LA")
    labels <- feature_labels()
    named_choices <- x_choices
    names(named_choices) <- x_choices
    idx <- x_choices %in% names(labels)
    names(named_choices)[idx] <- labels[x_choices[idx]]
    
    default_x <- if ("LW" %in% x_choices) "LW" else x_choices[1]
    updateSelectInput(session, "scatter_x", choices = named_choices, selected = default_x)
  })
  
  output$matrix_vars_ui <- renderUI({
    req(derived_data())
    num_vars <- names(derived_data())[vapply(derived_data(), is.numeric, logical(1))]
    labels <- feature_labels()
    choices <- num_vars
    names(choices) <- choices
    idx <- num_vars %in% names(labels)
    names(choices)[idx] <- labels[num_vars[idx]]
    
    default_matrix <- intersect(c("L", "W", "LA", "LW"), num_vars)
    selectInput("matrix_vars", "Matrix variables", choices = choices, selected = default_matrix, multiple = TRUE)
  })
  
  output$scatter_plot <- renderPlot({
    req(input$scatter_x)
    p <- build_scatter_plot(derived_data(), input$scatter_x)
    
    if (inherits(p, "ggplot")) {
      p <- p + ggplot2::theme(text = ggplot2::element_text(family = input$plot_font))
      if (length(p$layers) > 0 && "colour" %in% names(p$layers[[1]]$aes_params)) {
        p$layers[[1]]$aes_params$colour <- input$plot_color
      }
    }
    print(p)
  })
  
  output$matrix_plot <- renderPlot({
    req(input$matrix_vars)
    par(family = input$plot_font) 
    
    p <- la_ns_fun("la_matrixplot")(derived_data(), variables = input$matrix_vars, hist = TRUE, col = input$plot_color)
    
    if (inherits(p, "ggplot") || inherits(p, "ggmatrix")) {
      p <- p + ggplot2::theme(text = ggplot2::element_text(family = input$plot_font))
      print(p)
    }
  })
  
  model_results <- eventReactive(input$fit_models, {
    dat <- derived_data()
    predictors <- input$predictors
    req(length(predictors) > 0)
    
    metric_tables <- list()
    metadata_tables <- list()
    fit_objects <- list()
    
    if ("linear" %in% input$model_families) {
      lin_forms <- generate_linear_formulas(predictors, input$linear_subtypes)
      if (length(lin_forms) > 0) {
        fit_linear <- la_ns_fun("la_fit_linear_models")(dat, formulas = lin_forms)
        fit_objects$linear <- fit_linear
        metric_tables$linear <- la_ns_fun("la_evaluate_linear_models")(fit_linear)
        if (is.data.frame(fit_linear$results)) {
          metadata_tables$linear <- fit_linear$results
        }
      }
    }
    
    if ("nonlinear" %in% input$model_families) {
      nl_ids <- generate_nonlinear_model_ids(predictors, input$nonlinear_subtypes)
      if (length(nl_ids) > 0) {
        fit_nl <- la_ns_fun("la_fit_nonlinear_models")(dat, models = nl_ids)
        fit_objects$nonlinear <- fit_nl
        metric_tables$nonlinear <- la_ns_fun("la_evaluate_nonlinear_models")(fit_nl)
        if (is.data.frame(fit_nl$summary)) {
          metadata_tables$nonlinear <- fit_nl$summary
        } else if (is.data.frame(fit_nl$results)) {
          metadata_tables$nonlinear <- fit_nl$results
        }
      }
    }
    
    if ("mixed" %in% input$model_families && nzchar(input$group_var)) {
      mix_forms <- generate_mixed_formulas(predictors, input$mixed_subtypes, input$group_var)
      if (length(mix_forms) > 0) {
        fit_mix <- la_ns_fun("la_fit_mixed_models")(dat, group_var = input$group_var, formulas = mix_forms)
        fit_objects$mixed <- fit_mix
        metric_tables$mixed <- la_ns_fun("la_evaluate_mixed_models")(fit_mix)
        if (is.data.frame(fit_mix$results)) {
          metadata_tables$mixed <- fit_mix$results
        }
      }
    }
    
    merged <- merge_results_and_metadata(metric_tables, metadata_tables)
    ranked <- la_ns_fun("la_rank_models")(merged)
    
    list(
      fit = fit_objects,
      ranked = ranked
    )
  })
  
  output$results_table <- renderTable({
    validate(
      need(input$fit_models > 0, "Please select your models in the sidebar and click the 'Fit models' button to generate the results.")
    )
    req(model_results())
    make_results_display(model_results()$ranked)
  })
  
  top_model_info <- reactive({
    req(model_results())
    ranked <- model_results()$ranked
    req(nrow(ranked) >= input$rank_position)
    
    row <- ranked[input$rank_position, , drop = FALSE]
    model_id <- as.character(row$model_id[1])
    model_type <- if ("model_type" %in% names(row)) as.character(row$model_type[1]) else infer_model_type_from_id(model_id)
    
    fit_obj <- model_results()$fit[[model_type]]
    req(!is.null(fit_obj))
    
    model <- fit_obj$models[[model_id]]
    pred <- la_ns_fun("la_predict_from_results")(
      fit_object = fit_obj,
      model_id = model_id,
      newdata = derived_data(),
      allow_new_levels = TRUE
    )
    
    list(
      summary_row = row,
      prediction = pred,
      equation = pretty_equation(la_ns_fun("la_build_equation")(model)),
      coefficients = pretty_coefficients(la_ns_fun("la_extract_coefficients")(model))
    )
  })
  
  output$top_model_equation <- renderText({
    req(top_model_info())
    top_model_info()$equation
  })
  
  output$top_model_coefficients <- renderTable({
    req(top_model_info())
    top_model_info()$coefficients
  })
  
  output$top_model_plot <- renderPlot({
    info <- top_model_info()
    p <- la_ns_fun("la_plot_observed_predicted")(
      observed = info$prediction$LA,
      predicted = info$prediction$LA_pred,
      model_name = pretty_model_id(as.character(info$summary_row$model_id[1]))
    )
    
    if (inherits(p, "ggplot")) {
      p <- p + ggplot2::theme(text = ggplot2::element_text(family = input$plot_font))
      if (length(p$layers) > 0 && "colour" %in% names(p$layers[[1]]$aes_params)) {
        p$layers[[1]]$aes_params$colour <- input$plot_color
      }
    }
    print(p)
  })
  
  output$top_model_table <- renderTable({
    req(top_model_info())
    make_results_display(top_model_info()$summary_row)
  })
  
  output$download_ranked_csv <- downloadHandler(
    filename = function() {
      paste0("leafareaR_results_", Sys.Date(), ".csv")
    },
    content = function(file) {
      req(model_results())
      utils::write.csv(
        make_results_display(model_results()$ranked),
        file = file,
        row.names = FALSE,
        fileEncoding = "UTF-8-BOM"
      )
    }
  )
  
  output$download_ranked_xlsx <- downloadHandler(
    filename = function() {
      paste0("leafareaR_results_", Sys.Date(), ".xlsx")
    },
    content = function(file) {
      req(model_results())
      
      if (!requireNamespace("writexl", quietly = TRUE)) {
        stop("Package 'writexl' must be installed to export Excel files.", call. = FALSE)
      }
      
      sheets <- list(
        ranked_results = make_results_display(model_results()$ranked),
        top_model = make_results_display(top_model_info()$summary_row),
        coefficients = top_model_info()$coefficients,
        equation = data.frame(equation = top_model_info()$equation, stringsAsFactors = FALSE)
      )
      
      writexl::write_xlsx(sheets, path = file)
    }
  )
  
  output$download_scatter_png <- downloadHandler(
    filename = function() {
      paste0("leafareaR_scatter_", Sys.Date(), ".png")
    },
    content = function(file) {
      req(input$scatter_x)
      p <- build_scatter_plot(derived_data(), input$scatter_x)
      if (inherits(p, "ggplot")) {
        p <- p + ggplot2::theme(text = ggplot2::element_text(family = input$plot_font))
        if (length(p$layers) > 0 && "colour" %in% names(p$layers[[1]]$aes_params)) {
          p$layers[[1]]$aes_params$colour <- input$plot_color
        }
      }
      ggplot2::ggsave(filename = file, plot = p, width = 8, height = 6, units = "in", dpi = 300, bg = "white")
    }
  )
  
  output$download_matrix_png <- downloadHandler(
    filename = function() {
      paste0("leafareaR_matrixplot_", Sys.Date(), ".png")
    },
    content = function(file) {
      req(input$matrix_vars)
      save_matrix_plot_png(file, derived_data(), input$matrix_vars, input$plot_color, input$plot_font)
    }
  )
  
  output$download_top_model_png <- downloadHandler(
    filename = function() {
      paste0("leafareaR_top_model_", Sys.Date(), ".png")
    },
    content = function(file) {
      info <- top_model_info()
      p <- la_ns_fun("la_plot_observed_predicted")(
        observed = info$prediction$LA,
        predicted = info$prediction$LA_pred,
        model_name = pretty_model_id(as.character(info$summary_row$model_id[1]))
      )
      if (inherits(p, "ggplot")) {
        p <- p + ggplot2::theme(text = ggplot2::element_text(family = input$plot_font))
        if (length(p$layers) > 0 && "colour" %in% names(p$layers[[1]]$aes_params)) {
          p$layers[[1]]$aes_params$colour <- input$plot_color
        }
      }
      ggplot2::ggsave(filename = file, plot = p, width = 8, height = 6, units = "in", dpi = 300, bg = "white")
    }
  )
}

shinyApp(ui = ui, server = server)