#' Identify Core Microbiome Using Bray-Curtis Similarity
#' biological samples. Core taxa are selected using either a "last % increase"
#' or "elbow" method implementing the method developed by Shade
#' and Stopnisek (2019) Curr Opin Microbiol, see below for details.
#'
#' @param physeq_obj A `phyloseq` object with at least `otu_table` and
#' `sample_data`.
#' If the `phyloseq` object is already rarefied (i.e., all samples have the
#' same sequencing depth), you can omit `rarefied_list` and the function will
#' automatically use the OTU table from `physeq_obj` as a single iteration. If
#' the data is not rarefied, you must provide a `rarefied_list` generated by
#' `multi_rarefy`. Alternatively you can use `update_otu_table` to replace the
#' OTU table with a rarefied version before running `identify_core`.
#' @param rarefied_list A list of data frames, each representing a rarefied OTU
#' table (taxa x samples) generated by `multi_rarefy`. Required if `physeq_obj`
#' is not already rarefied. If `physeq_obj` is rarefied, this can be omitted
#' and the function will use the OTU table from `physeq_obj` as a single
#' iteration.
#' @param priority_var The column name in the `sample_data` (e.g.
#' sampling_date", "site") that is used for prioritizing the core microbiome.
#' @param increase_value Increase value (numeric, scalar) used in the
#' calculation (default 0.02) for "increase". The "elbow" is always calculated
#' and returned as \code{elbow_core} (see below for details).
#' @param abundance_weight Numeric in `[0,1]`; how much to weight mean relative
#' abundance in the ranking score. `0` (default) uses occupancy/composite only.
#' `1` ranks purely by abundance. Values in between blend the two (e.g.,
#' abundance_weight = 0.3 gives 70% occupancy/composite + 30% abundance).
#' @param max_otus Optional integer to limit analysis to the top N ranked OTUs.
#' If NULL (default), all OTUs are analyzed. Useful for large datasets
#' (>5000 OTUs)
#' @param depth_level Integer. The sequencing depth used for normalization in
#' Bray-Curtis calculations. If data is rarefied, this is automatically set
#' to the rarefaction depth. For unrarefied data, samples with depth below
#' this threshold are excluded from pairwise comparisons.
#' @param seed Optional integer to set the RNG seed for reproducibility.
#'
#' @return A list with:
#' \itemize{
#'   \item \code{bray_curtis_ranked} tibble with `rank`, mean Bray-Curtis
#'  similarity across sample pairs (`MeanBC`) at each cumulative `rank`,
#'  normalized proportion (`proportionBC`), the multiplicative `IncreaseBC`,
#' and the elbow metric (`elbow_slope_diffs`).
#' (`proportionBC`), the multiplicative `IncreaseBC`, and the elbow metric
#' (`elbow_slope_diffs`).
#'   \item \code{otu_ranked} tibble with ranked OTU/ASVs .
#'   \item \code{abundance_occupancy} tibble with OTU/ASVs names, occupancy
#'      (`otu_occ`), and mean relative abundance (`otu_rel`).
#'   \item \code{priority_var} character, the variable used for prioritizing
#' the core.
#'   \item \code{elbow} core set identified by elbow method (integer).
#'   \item \code{bc_increase} core set identified by last % BC-increase
#' (integer).
#'   \item \code{increase_value} increase value (numeric, scalar) used in the
#' calculation (e.g. 0.02).
#'   \item \code{elbow_core} core OTU/ASVs using elbow method (character
#' vector).
#'   \item \code{increase_core} core OTU/ASVs using last % BC-increase method
#'  (character vector).
#'   \item \code{otu_table} otu_table counts (otu x samples) used (data.frame).
#'   \item \code{sample_metadata} samples metadata (data.frame).
#'   \item \code{taxonomy_table} taxonomy if present (data.frame); otherwise
#'  NULL.
#' }
#'
#' @details
#' The core set is defined using two separate methods:
#'
#' The function rank OTU/ASVs by occupancy (optionally with abundance
#' weighting: `rank_score = (1 - weight) * rank + weight * scaled_abundance`,
#' where scaled_abundance is mean relative abundance rescaled to `[0,1]`). For
#' each `k = 1..K`, recompute `S_k` as the mean Bray-Curtis similarity across
#' all sample pairs using only the first `k` ranked OTUs; when `k = K`, this
#' yields `S_K`, the value computed with all OTUs. Normalizing by `S_K`
#' gives `C_k = S_k / S_K`.
#'
#' The **elbow** is the point of diminishing returns: for each `k`, compare the
#' average *left* slope `(S_k - S_1) / (k - 1)` to the average *right* slope
#' `(S_K - S_k) / (K - k)`, and choose the `k` that maximizes `(left - right)`.
#'
#' The **last percent Bray-Curtis increase** method uses the same accumulation
#' curve, examine the multiplicative step when adding the `k-th` OTU:
#' `Increase_k = S_k / S_{k-1}` (equivalently, `Increase_k = C_k / C_{k-1}`).
#' Choose the largest `k` such that `Increase_k >= 1 + p`, where `p` is your
#' chosen percent threshold (increase_value; recommended `p >= 0.02` or `2%`).
#' This selects the final rank for which adding one more taxon still increases
#' the explained Bray-Curtis similarity by at least `p`.
#'
#' @references Shade A, Stopnisek N (2019) Abundance-occupancy
#' distributions to prioritize plant core microbiome membership. Current
#' Opinion in Microbiology, 49:50-58
#' <doi:10.1016/j.mib.2019.09.008>
#'
#' @section Dependencies:
#' Requires \pkg{phyloseq}, \pkg{dplyr}, \pkg{tidyr}, \pkg{tibble}, \pkg{rlang},
#' and \pkg{vegan}.
#'
#' @seealso [multi_rarefy()], [plot_identified_core()], and
#' [plot_core_distribution()]
#'
#' @examples
#' \donttest{
#' library(BRCore)
#'
#' # With rarefied data
#' res <- identify_core(
#'   physeq_obj     = switchgrass,
#'   priority_var   = "sampling_date",
#'   increase_value = 0.02,
#'   seed           = 091825
#' )
#'
#' str(res)
#'
#' # With unrarefied data (requires multi_rarefy step)
#' rarefied_list <- multi_rarefy(
#'   physeq_obj = bcse,
#'   depth_level = 1000,
#'   num_iter = 3,
#'   .as = "list",
#'   set_seed = 7642
#' )
#'
#'
#' res_rare <- identify_core(
#'   physeq_obj = bcse,
#'   rarefied_list = rarefied_list,
#'   priority_var = "Crop",
#'   increase_value = 0.02,
#'   seed = 091825
#' )
#'
#' str(res_rare)
#' }
#'
#' @importFrom phyloseq sample_sums taxa_are_rows otu_table sample_data
#' @importFrom phyloseq tax_table
#' @importFrom dplyr left_join group_by summarise transmute arrange desc mutate
#' @importFrom dplyr n last select slice_head
#' @importFrom tidyr pivot_longer
#' @importFrom tibble rownames_to_column column_to_rownames
#' @importFrom rlang ensym as_name .data
#' @importFrom vegan decostand
#' @importFrom cli cli_text cli_warn cli_abort cli_alert_success cli_alert_info
#' @importFrom utils combn tail
#' @export
identify_core <- function(
  physeq_obj,
  rarefied_list = NULL,
  priority_var,
  increase_value = 0.02,
  abundance_weight = 0,
  max_otus = NULL,
  depth_level = 1000,
  seed = NULL
) {
  # Input checks ----
  cli::cli_text("\nSeed used: {seed}\n")

  if (is.null(seed)) {
    cli::cli_warn("No seed was set. Results may not be reproducible.")
  } else {
    set.seed(seed)
  }

  .phyloseq_class_check(physeq_obj)

  # Define arguments ----
  # Check if samples are rarefied (all have same depth, accounting for
  # floating-point precision)
  ## Validate / generate rarefied_list ----
  min_sum <- min(sample_sums(physeq_obj))
  max_sum <- max(sample_sums(physeq_obj))
  is_rarefied <- abs(min_sum - max_sum) < 1e-6

  if (!is.null(rarefied_list)) {
    if (!is.list(rarefied_list) || length(rarefied_list) <= 1) {
      cli::cli_abort(
        c(
          "A list of 2 or more rarefied iterations is required when {.arg physeq_obj} is not already rarefied.",
          "i" = "Provide the output of {.fn multi_rarefy} via {.arg rarefied_list} with at least 2 iterations.",
          "i" = "Alternatively, use {.fn update_otu_table} to replace the OTU table with a rarefied version."
        )
      )
    }
    cli::cli_alert_info(
      "Using provided {.arg rarefied_list} ({length(rarefied_list)} iterations)."
    )
  } else if (is_rarefied) {
    # physeq_obj is already rarefied — wrap its OTU table as a single-iteration list
    cli::cli_alert_info(
      "No {.arg rarefied_list} provided. {.arg physeq_obj} is already rarefied; wrapping as a single iteration."
    )
    otu_for_list <- .extract_otu_matrix(physeq_obj, samples_as_rows = TRUE)
    rarefied_list <- list(as.data.frame(otu_for_list))
  } else {
    cli::cli_abort(
      c(
        "{.arg physeq_obj} is not rarefied and no {.arg rarefied_list} was provided.",
        "i" = "Provide the output of {.fn multi_rarefy} via {.arg rarefied_list} with at least 2 iterations.",
        "i" = "Alternatively, use {.fn update_otu_table} to replace the OTU table with a rarefied version."
      )
    )
  }

  ## Extract OTU table, sample metadata, and taxonomy (if present) ----
  otu <- .extract_otu_matrix(physeq_obj, samples_as_rows = FALSE)
  map <- sample_data(physeq_obj) |> as("data.frame")
  map$sample_id <- rownames(map)

  ### check for a tax_table if present, if not just print a warning and continue.
  taxa <- NULL
  tx <- tryCatch(tax_table(physeq_obj), error = function(e) NULL)

  if (!is.null(tx)) {
    txm <- tryCatch(as(tx, "matrix"), error = function(e) NULL)
    if (!is.null(txm) && is.matrix(txm) && ncol(txm) > 0L) {
      taxa <- as.data.frame(txm, stringsAsFactors = FALSE)
    }
  }

  if (is.null(taxa)) {
    cli::cli_alert_info(
      "No taxonomy found (or empty). Continuing without taxonomy."
    )
  }

  ## Core prioritizing variable ----
  data_var <- priority_var
  cli::cli_alert_success("Core prioritizing variable: {data_var}")

  ## Validate abundance_weight ----
  if (
    !is.numeric(abundance_weight) ||
      length(abundance_weight) != 1L ||
      is.na(abundance_weight)
  ) {
    stop("`abundance_weight` must be a single numeric in [0,1].")
  }
  if (abundance_weight < 0 || abundance_weight > 1) {
    cli::cli_warn(
      "`abundance_weight`={abundance_weight} is outside [0,1]; clamping."
    )
    abundance_weight <- max(0, min(1, abundance_weight))
  }

  # Abundance occupancy ----
  otu_PA <- 1 * (otu > 0)
  otu_occ <- rowSums(otu_PA) / ncol(otu_PA)
  otu_rel <- apply(
    decostand(otu, method = "total", MARGIN = 2),
    1,
    mean
  )

  occ_abun <- data.frame(otu_occ = otu_occ, otu_rel = otu_rel) |>
    tibble::rownames_to_column("otu")

  # PresenceSum ----
  PresenceSum <- data.frame(
    otu = as.factor(rownames(otu)),
    otu,
    check.names = FALSE
  ) |>
    pivot_longer(-otu, names_to = "sample_id", values_to = "abun") |>
    left_join(map, by = "sample_id") |>
    group_by(otu, .data[[data_var]]) |>
    summarise(
      time_freq = sum(.data$abun > 0) / length(.data$abun), # frequency within date
      coreTime = ifelse(.data$time_freq == 1, 1, 0), # 1 if occupancy=1 at that date
      .groups = "drop"
    ) |>
    group_by(otu) |>
    summarise(
      sumF = sum(.data$time_freq),
      sumG = sum(.data$coreTime),
      nS = length(unique(.data[[data_var]])), # unique time points, not 2 * all rows
      rank = (.data$sumF + .data$sumG) / .data$nS, # can be up to 2 (original behavior)
      .groups = "drop"
    )

  # Rank and weight in abundance ----
  otu_ranked <- occ_abun |>
    left_join(PresenceSum, by = "otu")

  rank_method <- if (abundance_weight > 0) {
    occupancy_weight <- 1 - abundance_weight
    paste0(
      "Occupancy: ",
      occupancy_weight,
      " and Abundance: ",
      abundance_weight
    )
  } else {
    "Rank only"
  }

  if (abundance_weight == 0) {
    # No abundance weighting - use rank directly
    otu_ranked <- otu_ranked |>
      arrange(desc(rank))

    cli::cli_alert_info(
      "Ranked by {rank_method}"
    )
  } else {
    otu_ranked <- otu_ranked |>
      mutate(
        occ_norm = .data$otu_occ / max(.data$otu_occ, na.rm = TRUE),
        abun_norm = .data$otu_rel / max(.data$otu_rel, na.rm = TRUE),
        spatial_weight = (abundance_weight * .data$abun_norm) +
          ((1 - abundance_weight) * .data$occ_norm),
        rank = spatial_weight * .data$rank
      ) |>
      arrange(desc(.data$rank), .data$otu) |>
      select(
        "otu",
        "rank",
        "spatial_weight",
        "occ_norm",
        "abun_norm",
        "otu_occ",
        "otu_rel"
      )
    cli::cli_alert_info("Ranked by {rank_method}")
  }

  # Optional: Limit analysis to top N OTUs
  if (!is.null(max_otus)) {
    if (!is.numeric(max_otus) || max_otus < 1) {
      cli::cli_abort("`max_otus` must be a positive integer.")
    }

    max_otus <- as.integer(max_otus)

    if (max_otus < nrow(otu_ranked)) {
      total_otus <- nrow(otu_ranked)
      otu_ranked <- otu_ranked |> slice_head(n = max_otus)
      cli::cli_alert_info(
        "Limiting analysis to top {max_otus} of {total_otus} OTUs (ranked by {rank_method})."
      )
    } else {
      cli::cli_alert_info(
        "max_otus ({max_otus}) >= total OTUs ({nrow(otu_ranked)}). Using all OTUs (ranked by {rank_method})."
      )
    }
  }

  otu_ranked_ordered <- otu_ranked$otu

  # BC accumulation ----
  cli::cli_alert_info(
    "Ranking OTUs based on BC dissimilarity, starting at {Sys.time()}"
  )

  # Pre-compute sample pairs ONCE from the first rarefied iteration
  # (all iterations share the same samples after multi_rarefy filtering)
  sample_names <- colnames(as.matrix(t(rarefied_list[[1]])))

  sample_pairs <- utils::combn(length(sample_names), 2)
  pair_names <- apply(sample_pairs, 2, function(x) {
    paste(sample_names[x], collapse = " - ")
  })

  n_iter <- length(rarefied_list)
  n_pairs <- ncol(sample_pairs)

  # Rank 1
  bc_start <- .mean_bc_over_iters(
    otu_ranked_ordered[1],
    depth_level,
    rarefied_list,
    sample_pairs,
    n_iter,
    n_pairs
  )

  BCaddition <- NULL
  BCaddition <- data.frame(
    pair_names = pair_names,
    `1` = bc_start,
    check.names = FALSE
  )

  if (nrow(otu_ranked) > 1) {
    progressbar_calc_bc <- cli::cli_progress_bar(
      name = "Calculating BC rankings",
      total = nrow(otu_ranked) - 1,
      format = "{cli::pb_bar} {cli::pb_percent} | ETA: {cli::pb_eta}",
      .auto_close = TRUE
    )

    cumulative_otus <- otu_ranked_ordered[1]

    for (i in 2:nrow(otu_ranked)) {
      cumulative_otus <- c(cumulative_otus, otu_ranked_ordered[i])

      bc_i <- .mean_bc_over_iters(
        cumulative_otus,
        depth_level,
        rarefied_list,
        sample_pairs,
        n_iter,
        n_pairs
      )

      BCaddition <- left_join(
        BCaddition,
        data.frame(
          pair_names = pair_names,
          value = bc_i,
          check.names = FALSE
        ),
        by = "pair_names"
      )
      names(BCaddition)[ncol(BCaddition)] <- as.character(i)

      cli::cli_progress_update()
    }
  }
  temp_BC_matrix <- NULL
  temp_BC_matrix <- BCaddition |>
    tibble::column_to_rownames("pair_names") |>
    as.matrix()

  BC_ranked <- NULL
  BC_ranked <- data.frame(
    rank = as.factor(rownames(t(temp_BC_matrix))),
    t(temp_BC_matrix),
    check.names = FALSE
  ) |>
    pivot_longer(-rank, names_to = "comparison", values_to = "BC") |>
    group_by(.data$rank) |>
    summarise(MeanBC = mean(.data$BC), .groups = "drop") |>
    mutate(rank_num = as.numeric(as.character(.data$rank))) |>
    arrange(.data$rank_num) |>
    mutate(proportionBC = .data$MeanBC / max(.data$MeanBC))

  # Increase method ----
  if (nrow(BC_ranked) >= 2) {
    Increase <- ifelse(
      BC_ranked$MeanBC[-nrow(BC_ranked)] == 0,
      NA_real_,
      BC_ranked$MeanBC[-1] / BC_ranked$MeanBC[-nrow(BC_ranked)]
    )
    increaseDF <- data.frame(
      IncreaseBC = c(NA_real_, Increase),
      rank = factor(seq_len(length(Increase) + 1))
    )
  } else {
    increaseDF <- data.frame(IncreaseBC = NA_real_, rank = factor(1))
  }
  BC_ranked <- left_join(BC_ranked, increaseDF, by = "rank")

  # add OTU name, delta_pct_max_BC ----
  BC_ranked <- BC_ranked |>
    mutate(
      rank_num = as.numeric(as.character(.data$rank)),
      otu_added = otu_ranked_ordered[.data$rank_num],
      delta_pct_max_BC = (.data$IncreaseBC - 1) * 100
    )

  # Elbow method ----
  elbow_slope_differences <- function(pos) {
    left <- (BC_ranked$MeanBC[pos] - BC_ranked$MeanBC[1]) / pos
    right <- (BC_ranked$MeanBC[nrow(BC_ranked)] - BC_ranked$MeanBC[pos]) /
      max(1, (nrow(BC_ranked) - pos))
    left - right
  }
  BC_ranked$elbow_slope_diffs <- vapply(
    seq_len(nrow(BC_ranked)),
    elbow_slope_differences,
    numeric(1)
  )

  elbow <- which.max(BC_ranked$elbow_slope_diffs)

  # FALLBACK: if elbow is empty, NA, or 0, default to 1
  if (length(elbow) == 0 || is.na(elbow) || elbow == 0) {
    cli::cli_warn(
      "Elbow calculation failed (possibly due to low variation). Defaulting to 1."
    )
    elbow <- 1
  }

  # Threshold cut based on multiplicative increase
  thr <- 1 + increase_value
  valid_increases <- which(BC_ranked$IncreaseBC >= thr)

  lastCall <- if (length(valid_increases)) {
    utils::tail(valid_increases, 1)
  } else {
    1
  }

  # Add core set flags
  BC_ranked <- BC_ranked |>
    mutate(
      is_BC_core = .data$rank_num <= lastCall,
      last_pctBC_cutoff = .data$rank_num == lastCall,
      is_elbow_core = .data$rank_num <= elbow,
      last_elbow_cutoff = .data$rank_num == elbow
    ) |>
    arrange(.data$rank_num) |>

    select(
      "rank",
      "rank_num",
      "otu_added",
      "MeanBC",
      "proportionBC",
      "IncreaseBC",
      "elbow_slope_diffs",
      "delta_pct_max_BC",
      "is_BC_core",
      "last_pctBC_cutoff",
      "is_elbow_core",
      "last_elbow_cutoff"
    )

  # identified core sets ----

  elbow_core <- otu_ranked_ordered[seq_len(elbow)]
  cli::cli_alert_success(
    "Elbow method identified {.val {length(elbow_core)}} core OTUs"
  )
  increase_core <- otu_ranked_ordered[seq_len(lastCall)]
  cli::cli_alert_success(
    "% increase method identified {.val {length(increase_core)}} core OTUs"
  )

  # return ----
  out <- list(
    bray_curtis_ranked = BC_ranked,
    otu_ranked = otu_ranked,
    abundance_occupancy = occ_abun,
    priority_var = data_var,
    abundance_weight = abundance_weight,
    elbow = as.integer(elbow),
    bc_increase = as.integer(lastCall),
    increase_value = increase_value,
    elbow_core = elbow_core,
    increase_core = increase_core,
    otu_table = otu,
    metadata = map,
    taxonomy = taxa
  )

  class(out) <- c("identify_core_result", class(out))

  cli::cli_alert_success("Analysis complete!")

  out
}

#' Helper: compute mean BC dissimilarity across all rarefied iterations
#' for a given subset of OTUs (rows of each iteration matrix)
#'
#' #' This is the core computational step that is repeated for each rank as
#' OTUs are added.
#' This function is called internally by `identify_core` and is not exported.
#'
#' @param otu_subset Character vector of OTU names to include in the
#' calculation.
#' @param depth_level Numeric value representing the sequencing depth level.
#' @param rarefied_list List of rarefied OTU tables.
#' @param sample_pairs Matrix of sample pairs for BC calculation.
#' @param n_iter Number of iterations.
#' @param n_pairs Number of sample pairs.
#' @return Numeric vector of mean BC values for each sample pair.
#'
#' @noRd
#' @keywords internal
#'
.mean_bc_over_iters <- function(
  otu_subset,
  depth_level,
  rarefied_list,
  sample_pairs,
  n_iter,
  n_pairs
) {
  # otu_subset: character vector of OTU names
  pair_sums <- matrix(0, nrow = n_iter, ncol = n_pairs)

  for (iter_i in seq_len(n_iter)) {
    iter_mat <- as.matrix(t(rarefied_list[[iter_i]])) # taxa x samples
    # subset to OTUs present in this iteration (some may have dropped to 0)
    keep_otus <- intersect(otu_subset, rownames(iter_mat))
    sub_mat <- iter_mat[keep_otus, , drop = FALSE]

    bc_iter <- as.vector(
      vegan::vegdist(t(sub_mat), method = "bray")
    )

    # Re-normalize: vegdist uses sum(x+y) as denominator;
    # we want sum(abs(x-y)) / (2 * depth_level) to match find_core
    pair_sums_iter <- apply(sample_pairs, 2, function(x) {
      sum(sub_mat[, x[1]]) + sum(sub_mat[, x[2]])
    })
    pair_sums[iter_i, ] <- bc_iter * pair_sums_iter / (2 * depth_level)
  }

  colMeans(pair_sums)
}
