R/structure.R

In glyrepr: Representation for Glycan Compositions and Structures

#' Create a Glycan Structure Vector
#'
#' @description
#' `glycan_structure()` creates an efficient glycan structure vector for storing and
#' processing glycan molecular structures. The function employs hash-based deduplication
#' mechanisms, making it suitable for glycoproteomics, glycomics analysis, and glycan
#' structure comparison studies.
#'
#' @details
#' # Data Structure Overview
#'
#' A glycan structure vector is a vctrs vector with an additional S3 class
#' `glyrepr_structure`.
#'
#' Each glycan structure must satisfy the following constraints:
#'
#' ## Graph Structure Requirements
#' - An ordinary structure must be a directed outward tree (reducing end as
#'   root).
#' - A structure with floating parts must be one annotated forest containing
#'   exactly one main outward tree and one outward tree per floating part.
#' - Floating substituents add graph metadata but no vertices or edges.
#' - Must have a graph attribute `anomer` in the format "a1" or "b1"
#'   - Unknown parts can be represented with "?", e.g., "?1", "a?", "??"
#' - May have a graph attribute `alditol`, containing one logical value.
#'   Missing attributes are treated as `FALSE` and canonicalized explicitly.
#'
#' ## Node Attributes
#' - `mono`: Monosaccharide names, must be known monosaccharide types
#'   - Generic names: Hex, HexNAc, dHex, NeuAc, etc.
#'   - Concrete names: Glc, Gal, Man, GlcNAc, etc.
#'   - Generic and concrete names may be mixed
#'   - NA values are not allowed
#' - `sub`: Substituent information
#'   - Single substituent format: "xY" (x = position, Y = substituent name),
#'     e.g., "2Ac", "3S"
#'   - Ambiguous substituent positions use slash-separated alternatives,
#'     e.g., "4/6S", "3/4/6Ac"
#'   - Multiple substituents separated by commas and ordered by position,
#'     e.g., "3Me,4Ac", "2S,6P"
#'   - Unknown substituent positions can be repeated, e.g., "?Me,?S"
#'   - No substituents represented by empty string ""
#'
#' ## Edge Attributes
#' - `linkage`: Glycosidic linkage information in format "a/bX-Y"
#'   - Standard format: e.g., "b1-4", "a2-3"
#'   - Unknown positions allowed: "a1-?", "b?-3", "??-?"
#'   - Partially unknown positions: "a1-3/6", "a1-3/6/9"
#'   - NA values are not allowed
#'
#' ## Floating Parts
#'
#' Floating parts are disconnected substructures whose attachment to the main
#' tree is not fully localized. They are declared by the `floating_parts` graph
#' attribute, a list with one entry per floating component. Each entry contains:
#'
#' - `root`: the integer vertex index of the floating component root.
#' - `nodes`: all integer vertex indices in the floating component, ordered as
#'   the component appears in the complete IUPAC-condensed sequence.
#' - `linkage`: the virtual linkage from that root to its unresolved parent.
#' - `parents`: integer vertex indices outside the floating component. An empty
#'   integer vector means that all feasible nodes outside the component are
#'   candidates.
#'
#' Canonical graphs always contain `nodes`. For backward compatibility, input
#' graphs may omit it; [glycan_structure()] derives the component membership
#' before validation and stores `nodes` in the canonical result.
#'
#' During canonicalization, a floating part with exactly one effective
#' candidate parent is attached to that parent as an ordinary graph edge.
#' Attachments between floating components merge their `nodes` metadata and
#' can resolve further singleton domains. Only unresolved attachments retain
#' floating metadata, where the virtual attachment is metadata rather than an
#' edge and contributes to the canonical structure key.
#'
#' ## Floating Substituents
#'
#' A floating substituent has known chemistry but an unresolved parent residue.
#' It is declared by the `floating_substituents` graph attribute, a list with
#' one entry per substituent. Each entry contains:
#'
#' - `substituent`: one canonical substituent token such as `"6S"`, `"4/6Ac"`,
#'   or `"?Me"`.
#' - `parents`: integer residue vertex indices in the complete structure. An
#'   empty integer vector means that all feasible residue nodes are candidates.
#'
#' A singleton candidate is normalized into the corresponding vertex's `sub`
#' attribute. Candidate parents must permit a conflict-free assignment of
#' occupied carbon positions. Floating-part assignments must also be acyclic
#' and connect every floating component to the main tree.
#'
#' # Node and Edge Order
#'
#' For an ordinary tree, the indices of vertices and linkages correspond
#' directly to their order in the printed IUPAC-condensed string.
#' For example, for the glycan `Man(a1-3)[Man(a1-6)]Man(b1-4)GlcNAc(b1-4)GlcNAc(b1-`,
#' the vertices are "Man", "Man", "Man", "GlcNAc", "GlcNAc",
#' and the linkages are "a1-3", "a1-6", "b1-4", "b1-4".
#'
#' For a floating structure, floating-component vertices and edges precede the
#' main tree, exactly as their brace-enclosed components precede the main glycan
#' in the complete IUPAC-condensed string. Parent indices written inside braces
#' and stored in `floating_parts$parents` or `floating_substituents$parents`
#' use this same global order. Substituent blocks contribute no vertex indices.
#' A virtual floating attachment is not an edge, and a floating substituent is
#' not a vertex.
#'
#' # NA Support
#'
#' Glycan structure vectors support NA values for representing missing or
#' unknown structures:
#'
#' - Create with `glycan_structure(NA)` or `glycan_structure(NULL)`
#' - Combine with valid structures: `c(struct1, NA, struct2)`
#' - Convert from character: `as_glycan_structure(c("Glc(a1-", NA))`
#' - `smap` functions skip NA elements gracefully
#' - `is.na()` returns `TRUE` for NA elements
#'
#' # Naming Support
#'
#' Glycan structure vectors can have names, which are preserved during operations.
#' This is particularly useful when working with the `glymotif` package.
#'
#' # Character conversion
#'
#' A glycan structure vector is not a character vector. Use `as.character()` to
#' explicitly convert it to IUPAC-condensed strings when needed.
#'
#' @param ... igraph graph objects to be converted to glycan structures, or existing
#'   glycan structure vectors. Supports mixed input of multiple objects.
#' @param x An object to check or convert.
#'
#' @returns A `glyrepr_structure` class glycan structure vector object.
#'
#' @examples
#' library(igraph)
#'
#' # Example 1: Create a simple glycan structure GlcNAc(b1-4)GlcNAc
#' graph <- make_graph(~ 1-+2)  # Create graph with two monosaccharides
#' V(graph)$mono <- c("GlcNAc", "GlcNAc")  # Set monosaccharide types
#' V(graph)$sub <- ""  # No substituents
#' E(graph)$linkage <- "b1-4"  # b1-4 glycosidic linkage
#' graph$anomer <- "a1"  # a anomeric carbon
#'
#' # Create glycan structure vector
#' simple_struct <- glycan_structure(graph)
#' print(simple_struct)
#'
#' # Example 2: Use predefined glycan core structures
#' n_core <- n_glycan_core()  # N-glycan core structure
#' o_core1 <- o_glycan_core_1()  # O-glycan Core 1 structure
#'
#' # Example 3: Create complex structure with substituents
#' complex_graph <- make_graph(~ 1-+2-+3)
#' V(complex_graph)$mono <- c("GlcNAc", "Gal", "Neu5Ac")
#' V(complex_graph)$sub <- c("", "", "")  # Add substituents as needed
#' E(complex_graph)$linkage <- c("b1-4", "a2-3")
#' complex_graph$anomer <- "b1"
#'
#' complex_struct <- glycan_structure(complex_graph)
#' print(complex_struct)
#'
#' # Example 4: Parse a floating part with explicit candidate parents
#' floating <- as_glycan_structure(
#'   "{Neu5Ac(a2-3)|2,3}Gal(b1-3)[Gal(b1-4)]GlcNAc(a1-"
#' )
#' structure_floating_parts(floating)
#'
#' # Example 5: Parse a substituent with two candidate residues
#' floating_sub <- as_glycan_structure(
#'   "{6S|1,2}Gal(a1-3)Glc(a1-3)Man(a1-"
#' )
#' get_structure_graphs(floating_sub)$floating_substituents
#'
#' # Example 6: Check if object is a glycan structure
#' is_glycan_structure(simple_struct)  # TRUE
#' is_glycan_structure(graph)          # FALSE
#'
#' @importFrom magrittr %>%
#' @export
glycan_structure <- function(...) {
  args <- list(...)

  iupacs <- rep(NA_character_, length(args))
  na_positions <- logical(length(args))

  for (i in seq_along(args)) {
    arg <- args[[i]]
    if (is.null(arg) || (is.atomic(arg) && length(arg) == 1 && is.na(arg))) {
      na_positions[i] <- TRUE
    } else if (!inherits(arg, "igraph")) {
      cli::cli_abort("All arguments must be igraph objects or NA values.")
    }
  }

  valid_idx <- which(!na_positions)
  if (length(valid_idx) == 0) {
    return(new_glycan_structure(iupacs, list()))
  }

  valid_graphs <- unname(args[valid_idx])
  canonical <- canonicalize_and_validate_iupac_graphs(valid_graphs)
  iupacs[valid_idx] <- canonical$iupacs

  new_glycan_structure(iupacs, canonical$graphs)
}

#' Extract stored IUPAC-condensed strings from a glycan structure vector
#'
#' @param x A `glyrepr_structure` vector.
#' @returns A character vector of IUPAC-condensed strings.
#' @noRd
glycan_structure_iupac_data <- function(x) {
  data <- unclass(x)
  attributes(data) <- NULL

  if (length(data) == 0) {
    return(character())
  }

  purrr::map_chr(data, identity)
}

#' Normalize vctrs restore input to IUPAC-condensed strings
#'
#' @param x Data passed to `vec_restore.glyrepr_structure()`.
#' @returns A character vector of IUPAC-condensed strings.
#' @noRd
as_iupac_character <- function(x) {
  if (inherits(x, "glyrepr_structure")) {
    out <- glycan_structure_iupac_data(x)
  } else if (is.character(x)) {
    out <- x
  } else if (is.data.frame(x) && "iupac" %in% names(x)) {
    out <- x$iupac
  } else if (is.list(x)) {
    out <- purrr::map_chr(x, identity)
  } else {
    out <- vctrs::vec_data(x)
  }

  names(out) <- names(x)
  out
}

#' Create a missing glycan structure vector
#'
#' @param n Number of missing elements.
#' @returns A `glyrepr_structure` vector containing only missing values.
#' @noRd
new_na_glycan_structure <- function(n) {
  new_glycan_structure(rep(NA_character_, n), list())
}

#' Get the missing-value mask for a glycan structure vector
#'
#' @param x A `glyrepr_structure` vector.
#' @returns A logical vector.
#' @noRd
structure_na_mask <- function(x) {
  is.na(vctrs::vec_data(x))
}

#' Keep only graphs used by non-missing structure codes
#'
#' @param iupacs Character vector of structure codes.
#' @param graphs Named list of structure graphs.
#' @returns A named list of graphs.
#' @noRd
filter_used_structure_graphs <- function(iupacs, graphs) {
  used_codes <- unique(unname(iupacs[!is.na(iupacs)]))
  used_graphs <- graphs[used_codes]
  used_graphs[!vapply(used_graphs, is.null, logical(1))]
}

ensure_name_vertex_attr <- function(glycan) {
  if (!("name" %in% igraph::vertex_attr_names(glycan))) {
    names <- as.character(seq_len(igraph::vcount(glycan)))
    glycan <- igraph::set_vertex_attr(glycan, "name", value = names)
  }
  glycan
}

#' @export
#' @rdname glycan_structure
is_glycan_structure <- function(x) {
  inherits(x, "glyrepr_structure")
}

#' @export
is.na.glyrepr_structure <- function(x, ...) {
  iupacs <- vctrs::vec_data(x)
  is.na(iupacs)
}

#' @export
vec_proxy.glyrepr_structure <- function(x, ...) {
  iupacs <- glycan_structure_iupac_data(x)
  names(iupacs) <- names(x)
  iupacs
}

#' @export
vec_ptype_full.glyrepr_structure <- function(x, ...) "glycan_structure"

#' @export
vec_ptype_abbr.glyrepr_structure <- function(x, ...) "struct"

#' @export
format.glyrepr_structure <- function(x, ...) {
  formatted <- format(vctrs::vec_data(x), ...)

  # Add names if present
  nms <- names(x)
  if (!is.null(nms) && length(nms) > 0) {
    # Use tab separation between name and structure
    formatted <- paste(nms, formatted, sep = "\t")
  }

  formatted
}

#' @export
as.list.glyrepr_structure <- function(x, ...) {
  iupacs <- vctrs::vec_data(x)
  graphs <- attr(x, "graphs")

  out <- purrr::map(iupacs, function(iupac) {
    if (is.na(iupac)) {
      NULL
    } else {
      copy_structure_graph(graphs[[iupac]])
    }
  })
  names(out) <- names(x)
  out
}

#' Copy a glycan structure graph
#'
#' Use an identity permutation to materialize a separate igraph object while
#' preserving vertices, edges, and attributes.
#'
#' @param graph An igraph object.
#' @returns A copied igraph object.
#' @noRd
copy_structure_graph <- function(graph) {
  igraph::permute(graph, seq_len(igraph::vcount(graph)))
}

#' Format a Subset of Glycan Structures with Optional Colors
#'
#' @param x A glyrepr_structure object
#' @param indices Indices of structures to format
#' @param colored A logical value indicating whether to add colors
#' @returns A character vector of formatted structures for the specified indices
#' @keywords internal
format_glycan_structure_subset <- function(x, indices, colored = TRUE) {
  if (!colored) {
    return(format(x)[indices])
  }

  codes <- vctrs::vec_data(x)[indices]
  graphs <- attr(x, "graphs")

  # For each structure, add colors if concrete type
  purrr::map_chr(codes, function(code) {
    # Handle NA codes
    if (is.na(code)) {
      return(NA_character_)
    }
    structure <- graphs[[code]]
    mono_names <- igraph::V(structure)$mono

    # Add colors to monosaccharides and gray linkages
    if (colored) {
      colorize_iupac_string(code, mono_names)
    } else {
      code
    }
  })
}


#' @export
print.glyrepr_structure <- function(x, ..., n = 10) {
  vctrs::obj_print(x, ..., max_n = n)
  invisible(x)
}

#' @export
obj_print_footer.glyrepr_structure <- function(x, ...) {
  cat(
    "# Unique structures: ",
    format(length(attr(x, "graphs"))),
    "\n",
    sep = ""
  )
}

#' @export
obj_print_data.glyrepr_structure <- function(
  x,
  ...,
  max_n = 10,
  colored = TRUE
) {
  if (length(x) == 0) {
    return()
  }

  n <- length(x)
  n_show <- min(n, max_n)

  # Only format the structures that need to be shown to improve performance
  indices_to_show <- seq_len(n_show)
  formatted <- format_glycan_structure_subset(
    x,
    indices_to_show,
    colored = colored
  )

  # Check if names are present
  nms <- names(x)
  has_names <- !is.null(nms) && length(nms) > 0

  # Print each IUPAC structure on its own line with indexing, up to max_n
  for (i in seq_len(n_show)) {
    if (has_names) {
      cat("[", i, "] ", nms[i], "\t", formatted[i], "\n", sep = "")
    } else {
      cat("[", i, "] ", formatted[i], "\n", sep = "")
    }
  }
  if (n > max_n) {
    cat("... (", n - max_n, " more not shown)\n", sep = "")
  }
}

#' @importFrom pillar pillar_shaft
#' @export
pillar_shaft.glyrepr_structure <- function(x, ...) {
  if (length(x) == 0) {
    return(pillar::pillar_shaft(character()))
  }

  # Get formatted strings with colors
  codes <- vctrs::vec_data(x)
  graphs <- attr(x, "graphs")

  # For each structure, add colors if concrete type
  formatted <- purrr::map_chr(codes, function(code) {
    # Handle NA codes
    if (is.na(code)) {
      return(NA_character_)
    }
    structure <- graphs[[code]]
    mono_names <- igraph::V(structure)$mono

    # Add colors to monosaccharides and gray linkages
    colorize_iupac_string(code, mono_names)
  })

  pillar::new_pillar_shaft_simple(formatted, align = "left", min_width = 10)
}

#' @export
vec_ptype2.glyrepr_structure.glyrepr_structure <- function(x, y, ...) {
  # Get graphs from both vectors (works for both empty prototypes and full vectors)
  graphs_x <- attr(x, "graphs")
  graphs_y <- attr(y, "graphs")

  # Validate each graph-list container separately.
  validate_glycan_graph_vector(graphs_x, label = "Vector 1")
  validate_glycan_graph_vector(graphs_y, label = "Vector 2")

  # Combine graphs from both vectors (union by IUPAC name as key)
  combined_graphs <- c(graphs_x, graphs_y)
  # Remove duplicates, keeping first occurrence (from x)
  unique_graphs <- combined_graphs[!duplicated(names(combined_graphs))]

  # Create prototype with combined graphs
  out <- new_glycan_structure()
  attr(out, "graphs") <- unique_graphs
  out
}

#' @export
vec_cast.glyrepr_structure.glyrepr_structure <- function(x, to, ...) {
  x
}

#' @export
vec_cast.glyrepr_structure.igraph <- function(x, to, ...) {
  glycan_structure(x)
}

#' @export
vec_cast.glyrepr_structure.list <- function(x, to, ...) {
  if (!all(purrr::map_lgl(x, ~ inherits(.x, "igraph")))) {
    cli::cli_abort(c(
      "All elements in the list must be igraph objects.",
      "i" = "Each graph in the list should be a valid glycan structure."
    ))
  }
  do.call(glycan_structure, x)
}

#' @export
vec_cast.glyrepr_structure.character <- function(x, to, ...) {
  # Handle empty character vector
  if (length(x) == 0) {
    return(glycan_structure())
  }

  input_names <- names(x)
  result <- glycan_structure_from_iupac_character(x)
  names(result) <- input_names
  result
}

#' Create a glycan structure vector from IUPAC-condensed strings
#'
#' Parses each unique non-missing IUPAC-condensed string once, validates the
#' resulting graphs, canonicalizes their IUPAC representation, and maps the
#' canonical strings back to the original input positions.
#'
#' @param x A character vector of IUPAC-condensed strings.
#' @returns A [glycan_structure()] vector.
#' @noRd
glycan_structure_from_iupac_character <- function(x) {
  na_mask <- is.na(x)

  if (all(na_mask)) {
    return(new_na_glycan_structure(length(x)))
  }

  non_na_x <- x[!na_mask]
  unique_x <- unique(non_na_x)
  arrays <- .compact_iupac_arrays(unique_x)
  if (all(vapply(arrays, \(x) identical(x$status, "ok"), logical(1)))) {
    return(.compact_structure_from_arrays(x, unique_x, arrays))
  }

  # Replay the complete reference path on native failures, preserving the
  # original parse-before-validation precedence and purrr error indices.
  graphs <- purrr::map(unique_x, .parse_iupac_condensed_single)
  canonical <- canonicalize_and_validate_iupac_graphs(graphs)

  result_iupacs <- rep(NA_character_, length(x))
  result_iupacs[!na_mask] <- canonical$iupacs[match(non_na_x, unique_x)]

  new_glycan_structure(result_iupacs, canonical$graphs)
}

#' Canonicalize and validate parsed IUPAC-condensed graphs
#'
#' Validates each parsed graph, reorders vertices and edges to the canonical
#' IUPAC-condensed order and deduplicates graph storage by canonical IUPAC
#' string.
#'
#' @param graphs A list of parsed igraph graph objects.
#' @returns A list with canonical `iupacs` and unique named `graphs`.
#' @noRd
canonicalize_and_validate_iupac_graphs <- function(graphs) {
  processed <- purrr::map(graphs, process_glycan_structure_element)
  graphs <- purrr::map(processed, "graph")
  validate_glycan_graph_vector(graphs)

  iupacs <- purrr::map_chr(processed, "iupac")
  unique_indices <- which(!duplicated(iupacs))
  unique_graphs <- graphs[unique_indices]
  names(unique_graphs) <- iupacs[unique_indices]

  list(
    iupacs = iupacs,
    graphs = unique_graphs
  )
}

#' @export
vec_cast.character.glyrepr_structure <- function(x, to, ...) {
  vctrs::vec_data(x)
}

# ===== IMPORTANT NOTE =====
# `vec_restore.glyrepr_structure()` and `[.glyrepr_structure()`
# are implemented by Claude Code.
# I do NOT fully understand the code, but it works.

#' @export
vec_restore.glyrepr_structure <- function(x, to, ...) {
  # Get the graphs attribute from the prototype
  graphs <- attr(to, "graphs")
  iupacs <- as_iupac_character(x)
  out_names <- names(iupacs)

  # If prototype has no graphs, return with empty graphs
  if (length(graphs) == 0) {
    out <- new_glycan_structure(iupacs, list())
    names(out) <- out_names
    return(out)
  }

  # If x is empty (e.g., during vec_ptype2), keep all graphs from prototype
  if (length(iupacs) == 0) {
    out <- new_glycan_structure(iupacs, graphs)
    names(out) <- out_names
    return(out)
  }

  # Filter graphs to only include those used in the subset
  # Use unique iupacs to handle duplicates correctly
  used_graphs <- filter_used_structure_graphs(iupacs, graphs)

  out <- new_glycan_structure(iupacs, used_graphs)
  names(out) <- out_names
  out
}

#' @export
`[.glyrepr_structure` <- function(x, i, ...) {
  if (missing(i)) {
    return(x)
  }

  iupacs_all <- glycan_structure_iupac_data(x)
  names(iupacs_all) <- names(x)
  iupacs <- iupacs_all[i]
  graphs <- filter_used_structure_graphs(iupacs, attr(x, "graphs"))
  out <- new_glycan_structure(iupacs, graphs)

  nms <- names(x)
  if (!is.null(nms)) {
    names(out) <- names(iupacs)
  }

  out
}

#' @export
`[[.glyrepr_structure` <- function(x, i, ...) {
  out <- x[i]
  names(out) <- NULL
  out
}

#' @export
`[[<-.glyrepr_structure` <- function(x, i, value) {
  cli::cli_abort(c(
    "Cannot use `[[<-` on {.cls glyrepr_structure} vectors.",
    "x" = "This operation would create an invalid object with mismatched data and graphs.",
    "i" = "Create a new vector instead, e.g., with `c()`."
  ))
}

#' Convert to Glycan Structure Vector
#'
#' Convert an object to a glycan structure vector.
#'
#' Character input assumes the natural absolute configuration for unprefixed
#' monosaccharides. Less common configurations use a leading `D-` or `L-`, such
#' as `D-Fuc`, `L-Gul`, and `D-Fucf`.
#' Alditols use `-ol` on the main reducing-end residue, for example
#' `Gal(b1-4)GlcNAc-ol(a1-`. The reducing-end anomer annotation remains part of
#' the canonical representation.
#'
#' Character input supports floating-part blocks before the main
#' IUPAC-condensed structure. `{Neu5Ac(a2-3)}<main>` allows every feasible
#' node outside its own component as a candidate parent, while an explicit
#' `|<parents>` suffix restricts that domain. Parent indices follow residue
#' order in the complete supplied sequence: residues in floating blocks are
#' counted left to right before the main glycan, and substituent blocks add no
#' indices. A floating part may target another floating component or the main
#' tree, but cannot target itself. Indices are remapped to canonical complete
#' sequence order in the result. The suffix is a `glyrepr` extension to
#' curly-brace IUPAC notation. A singleton candidate set is accepted as input
#' but fully localizes the attachment, so
#' `{Neu5Ac(a2-3)|2}Gal(b1-4)GlcNAc(b1-` canonicalizes to the ordinary structure
#' `Neu5Ac(a2-3)Gal(b1-4)GlcNAc(b1-`.
#'
#' Floating substituents use the same leading-brace and candidate-parent syntax.
#' For example, `{6S}<main>` leaves the sulfated residue unrestricted across all
#' residue nodes, `{6S|1,2}<main>` restricts it to complete-sequence nodes 1 and
#' 2, and `{?S}<main>` also leaves the carbon position unknown. A singleton
#' candidate is normalized into the selected residue's ordinary `sub` attribute.
#'
#' @param x An object to convert to a glycan structure vector.
#'   Can be an igraph object, a list of igraph objects,
#'   a character vector of IUPAC-condensed strings,
#'   or an existing glyrepr_structure object.
#' @param on_failure The failure policy for element-local parsing, validation,
#'   and canonicalization errors. `"error"` preserves the default strict
#'   behavior. `"na"` replaces failed elements with `NA` and emits one warning
#'   that reports their positions and failure reasons. Existing missing elements
#'   remain missing without a warning. Vector-level incompatibilities still
#'   produce an error.
#'
#' @returns A glyrepr_structure object.
#'
#' @examples
#' library(igraph)
#'
#' # Convert a single igraph
#' graph <- make_graph(~ 1-+2)
#' V(graph)$mono <- c("GlcNAc", "GlcNAc")
#' V(graph)$sub <- ""
#' E(graph)$linkage <- "b1-4"
#' graph$anomer <- "a1"
#' as_glycan_structure(graph)
#'
#' # Convert a list of igraphs
#' o_glycan_vec <- o_glycan_core_1()
#' o_glycan_graph <- get_structure_graphs(o_glycan_vec)
#' as_glycan_structure(list(graph, o_glycan_graph))
#'
#' # Convert a character vector of IUPAC-condensed strings
#' as_glycan_structure(c("GlcNAc(b1-4)GlcNAc(b1-", "Man(a1-2)GlcNAc(b1-"))
#' as_glycan_structure(c("D-Fuc(a1-", "L-Gul(b1-", "D-Fucf(a1-"))
#' as_glycan_structure("Gal(b1-4)GlcNAc-ol(a1-")
#'
#' # Parse a floating residue with two candidate parents
#' floating_iupac <- paste0(
#'   "{Neu5Ac(a2-3)|2,5}",
#'   "Gal(b1-4)GlcNAc(b1-2)Man(a1-3)",
#'   "[Gal(b1-4)GlcNAc(b1-2)Man(a1-6)]",
#'   "Man(b1-4)GlcNAc(b1-4)GlcNAc(b1-"
#' )
#' as_glycan_structure(floating_iupac)
#'
#' # Preserve valid elements while replacing an invalid element with NA
#' as_glycan_structure(
#'   c(valid = "Glc(?1-", invalid = "not-a-structure"),
#'   on_failure = "na"
#' )
#'
#' @export
as_glycan_structure <- function(x, on_failure = c("error", "na")) {
  on_failure <- rlang::arg_match(on_failure)

  if (identical(on_failure, "error")) {
    return(vctrs::vec_cast(x, glycan_structure()))
  }

  as_glycan_structure_with_na(x)
}

#' Convert to glycan structures with element-local failure recovery
#'
#' @param x An object accepted by [as_glycan_structure()].
#' @returns A `glyrepr_structure` vector.
#' @noRd
as_glycan_structure_with_na <- function(x) {
  if (inherits(x, "glyrepr_structure")) {
    return(vctrs::vec_cast(x, glycan_structure()))
  }

  if (is.character(x)) {
    return(glycan_structure_from_iupac_character_with_na(x))
  }

  if (inherits(x, "igraph")) {
    return(glycan_structure_from_graph_list_with_na(list(x)))
  }

  if (is.list(x)) {
    return(glycan_structure_from_graph_list_with_na(x))
  }

  vctrs::vec_cast(x, glycan_structure())
}

#' Recover valid glycan structures from a graph list
#'
#' @param x A list containing igraph objects and missing values.
#' @returns A `glyrepr_structure` vector.
#' @noRd
glycan_structure_from_graph_list_with_na <- function(x) {
  missing <- vapply(x, is_missing_structure_input, logical(1))
  is_graph <- vapply(x, inherits, logical(1), what = "igraph")
  invalid_positions <- which(!missing & !is_graph)

  if (length(invalid_positions) > 0) {
    cli::cli_abort(c(
      "All elements in the list must be igraph objects or missing values.",
      "x" = "Invalid element position{?s}: {.val {invalid_positions}}."
    ))
  }

  positions <- as.list(which(!missing))
  recover_glycan_structure_elements(
    elements = x[!missing],
    positions = positions,
    size = length(x),
    input_names = names(x),
    parser = identity
  )
}

#' Recover valid glycan structures from character input
#'
#' @param x A character vector of IUPAC-condensed strings.
#' @returns A `glyrepr_structure` vector.
#' @noRd
glycan_structure_from_iupac_character_with_na <- function(x) {
  non_missing <- which(!is.na(x))

  if (length(non_missing) == 0) {
    out <- new_na_glycan_structure(length(x))
    names(out) <- names(x)
    return(out)
  }

  unique_x <- unique(x[non_missing])
  groups <- match(x, unique_x)
  positions <- lapply(seq_along(unique_x), function(i) which(groups == i))

  outcomes <- .compact_iupac_outcomes(unique_x)
  assemble_recovered_structure_outcomes(
    outcomes,
    positions = positions,
    size = length(x),
    input_names = names(x)
  )
}

#' Process elements independently and recover valid glycan structures
#'
#' @param elements A list of graph objects or character strings.
#' @param positions A list mapping each element to its original positions.
#' @param size The size of the output vector.
#' @param input_names Names for the output vector.
#' @param parser A function that converts one element to an igraph object.
#' @returns A `glyrepr_structure` vector.
#' @noRd
recover_glycan_structure_elements <- function(
  elements,
  positions,
  size,
  input_names,
  parser
) {
  outcomes <- lapply(elements, function(element) {
    tryCatch(
      process_glycan_structure_element(parser(element)),
      error = function(cnd) cnd
    )
  })
  assemble_recovered_structure_outcomes(outcomes, positions, size, input_names)
}

assemble_recovered_structure_outcomes <- function(
  outcomes,
  positions,
  size,
  input_names
) {
  failed <- vapply(outcomes, inherits, logical(1), what = "error")
  successful <- outcomes[!failed]

  successful_graphs <- lapply(successful, `[[`, "graph")
  validate_glycan_graph_vector(successful_graphs)

  result_iupacs <- rep(NA_character_, size)
  successful_positions <- positions[!failed]
  successful_iupacs <- vapply(successful, `[[`, character(1), "iupac")
  for (i in seq_along(successful_positions)) {
    result_iupacs[successful_positions[[i]]] <- successful_iupacs[[i]]
  }

  unique_graphs <- successful_graphs[!duplicated(successful_iupacs)]
  names(unique_graphs) <- unique(successful_iupacs)
  out <- new_glycan_structure(result_iupacs, unique_graphs)
  names(out) <- input_names

  if (any(failed)) {
    failure_positions <- unlist(positions[failed], use.names = FALSE)
    failure_reasons <- unlist(
      Map(
        function(outcome, element_positions) {
          rep(
            normalize_structure_failure_reason(outcome),
            length(element_positions)
          )
        },
        outcomes[failed],
        positions[failed]
      ),
      use.names = FALSE
    )
    failure_order <- order(failure_positions)
    warn_structure_failures(
      positions = failure_positions[failure_order],
      reasons = failure_reasons[failure_order],
      input_names = input_names
    )
  }

  out
}

#' Validate and canonicalize one glycan graph
#'
#' @param graph An igraph object.
#' @returns A list containing the canonical graph and IUPAC string.
#' @noRd
process_glycan_structure_element <- function(graph) {
  graph <- validate_glycan_graph(graph)
  canonicalize_graph_with_iupac(graph)
}

#' Test whether a graph-list element represents a missing structure
#'
#' @param x A graph-list element.
#' @returns A logical scalar.
#' @noRd
is_missing_structure_input <- function(x) {
  is.null(x) || (is.atomic(x) && length(x) == 1 && is.na(x))
}

#' Normalize an element-local failure reason
#'
#' @param cnd An error condition.
#' @returns A one-line character scalar.
#' @noRd
normalize_structure_failure_reason <- function(cnd) {
  reason <- conditionMessage(cnd)
  reason <- stringr::str_replace_all(reason, "\\s*\\n\\s*", " ")
  stringr::str_squish(reason)
}

#' Warn about structures replaced with missing values
#'
#' @param positions Integer positions of failed elements.
#' @param reasons Character failure reasons.
#' @param input_names Optional names of the input elements.
#' @returns Nothing. Called for its warning side effect.
#' @noRd
warn_structure_failures <- function(positions, reasons, input_names = NULL) {
  n_failed <- length(positions)
  labels <- as.character(positions)

  if (!is.null(input_names)) {
    failed_names <- input_names[positions]
    has_name <- !is.na(failed_names) & nzchar(failed_names)
    labels[has_name] <- paste0(
      labels[has_name],
      " (`",
      failed_names[has_name],
      "`)"
    )
  }

  failure_details <- paste0("Position ", labels, ": ", reasons)
  cli::cli_warn(
    c(
      "{n_failed} structure{?s} failed validation and {?was/were} replaced with {.code NA}.",
      "x" = "{failure_details}"
    ),
    class = "glyrepr_warning_structure_failure",
    positions = positions,
    reasons = reasons,
    input_names = if (is.null(input_names)) NULL else input_names[positions]
  )
}

#' Access Individual Glycan Structures
#'
#' Extract individual glycan structure graphs from a glycan structure vector.
#' A structure with floating parts is returned as one annotated, weakly
#' disconnected `igraph`: its main tree and floating components share the graph,
#' and the `floating_parts` graph attribute records each component's node
#' indices, virtual attachment, and candidate parents. See [glycan_structure()]
#' for the metadata schema.
#' A structure with floating substituents carries a `floating_substituents`
#' graph attribute containing their tokens and candidate parent indices.
#'
#' @param x A glycan structure vector.
#' @param return_list If `TRUE`, always returns a list.
#'   If `FALSE` and `x` has a length of 1, return the igraph object directly.
#'   If not provided (default), `FALSE` when `x` has a length of 1 and `TRUE`
#'   otherwise, including for an empty vector.
#'
#' @returns A list of igraph objects or an igraph object directly (see `return_list` parameter).
#'
#' @examples
#' structures <- c(o_glycan_core_1(), n_glycan_core())
#' get_structure_graphs(structures)
#' get_structure_graphs(structures)
#'
#' @export
get_structure_graphs <- function(x, return_list = NULL) {
  checkmate::assert_class(x, "glyrepr_structure")
  checkmate::assert_flag(return_list, null.ok = TRUE)

  if (is.null(return_list)) {
    return_list <- length(x) != 1
  } else {
    if (!return_list && length(x) != 1) {
      cli::cli_abort(c(
        "{.arg return_list} must be `TRUE` or `NULL` unless {.arg x} has length 1.",
        "i" = "Length of {.arg x}: {.val {length(x)}}"
      ))
    }
  }

  iupacs <- vctrs::vec_data(x)
  graphs <- attr(x, "graphs")
  res <- purrr::map(iupacs, ~ graphs[[.x]])
  if (!return_list) {
    res <- res[[1]]
  }
  res
}