R/mono-type.R

In glyrepr: Representation for Glycan Compositions and Structures

#' Convert Monosaccharides to Generic Type
#'
#' This function converts monosaccharide types of monosaccharide characters,
#' glycan compositions, or glycan structures from concrete to generic type.
#' This is a simplified version that only supports conversion from "concrete"
#' to "generic" monosaccharides.
#'
#' @details
#'
#' # Two types of monosaccharides
#'
#' There are two types of monosaccharides:
#' - concrete: e.g. "Gal", "GlcNAc", "Glc", "Fuc", etc.
#' - generic: e.g. "Hex", "HexNAc", "HexA", "HexN", etc.
#' Concrete furanose forms such as "Galf" and "GlcfNAc" convert to the same
#' generic names as their ringless forms: "Hex" and "HexNAc", respectively.
#' Explicit unusual configurations also convert to the same generic names as
#' their natural counterparts. For example, "D-Fuc" and "D-Fucf" both convert
#' to "dHex".
#'
#' For the full list of monosaccharides, use [available_monosaccharides()].
#'
#' @param x Either of these objects:
#'   - A character of monosaccharide;
#'   - A glycan composition vector ("glyrepr_composition" object);
#'   - A glycan structure vector ("glyrepr_structure" object);
#'   - A glycan `igraph`.
#'
#' @returns A new object of the same class as `x`
#' with monosaccharides converted to generic type. Graph input retains its
#' vertex IDs and order.
#'
#' @examples
#' # Convert character vectors
#' convert_to_generic(c("Gal", "GlcNAc", "Galf", "GlcfNAc"))
#'
#' # Convert glycan compositions
#' comps <- glycan_composition(
#'   c(Gal = 5, GlcNAc = 2),
#'   c(Glc = 5, GalNAc = 4, Fuc = 1)
#' )
#' convert_to_generic(comps)
#'
#' # Convert glycan structures
#' strucs <- c(n_glycan_core(), o_glycan_core_1())
#' convert_to_generic(strucs)
#'
#' @export
convert_to_generic <- function(x) {
  UseMethod("convert_to_generic")
}

#' @export
#' @rdname convert_to_generic
convert_to_generic.character <- function(x) {
  checkmate::assert_character(x)

  from <- get_mono_type(x)

  if (!any(from == "concrete")) {
    return(x)
  }

  result <- x
  result[from == "concrete"] <- convert_mono_type_impl(x[from == "concrete"])
  result
}

#' @export
#' @rdname convert_to_generic
convert_to_generic.glyrepr_structure <- function(x) {
  if (!is_glycan_structure(x)) {
    cli::cli_abort(c(
      "Input must be a glyrepr_structure vector.",
      "i" = "Use `glycan_structure()` to create a glyrepr_structure from igraph objects."
    ))
  }

  if (length(x) == 0) {
    return(x)
  }

  input_iupacs <- glycan_structure_iupac_data(x)
  used_iupacs <- unique(input_iupacs[!is.na(input_iupacs)])
  if (length(used_iupacs) == 0) {
    return(x)
  }

  source_graphs <- attr(x, "graphs")[used_iupacs]
  converted <- Map(
    convert_structure_graph_to_generic,
    source_graphs,
    used_iupacs
  )
  changed <- vapply(converted, `[[`, logical(1), "changed")
  if (!any(changed)) {
    return(x)
  }

  converted_graphs <- lapply(converted, `[[`, "graph")
  new_unique_iupacs <- vapply(converted, `[[`, character(1), "iupac")
  result_iupacs <- new_unique_iupacs[match(input_iupacs, used_iupacs)]
  names(result_iupacs) <- names(x)

  keep <- !duplicated(new_unique_iupacs)
  final_graphs <- converted_graphs[keep]
  names(final_graphs) <- new_unique_iupacs[keep]

  new_glycan_structure(result_iupacs, final_graphs)
}

#' @export
#' @rdname convert_to_generic
convert_to_generic.igraph <- function(x) {
  from <- get_graph_mono_type(x)
  if (from == "generic") {
    return(x)
  }
  convert_glycan_mono_type_impl(x, from, "generic")
}

#' @export
#' @rdname convert_to_generic
convert_to_generic.glyrepr_composition <- function(x) {
  if (!is_glycan_composition(x)) {
    cli::cli_abort(c(
      "Input must be a glyrepr_composition vector.",
      "i" = "Use `glycan_composition()` to create a glyrepr_composition from named vectors."
    ))
  }

  if (length(x) == 0) {
    return(x)
  }

  # Get current mono types
  current_type <- get_mono_type.glyrepr_composition(x)
  if (!any(current_type %in% c("concrete", "mixed"))) {
    return(x)
  }

  # Convert each composition
  compositions <- vctrs::field(x, "data")
  new_compositions <- purrr::map(compositions, function(comp) {
    # Handle NULL/empty compositions (from NA elements)
    if (is.null(comp) || length(comp) == 0) {
      return(NULL) # NA elements are stored as NULL
    }

    # Convert monosaccharide names
    old_names <- names(comp)
    new_names <- convert_mono_type_impl(old_names)

    # Create new composition with converted names, aggregating counts for duplicates
    result <- tapply(comp, new_names, sum, na.rm = TRUE)
    res_names <- names(result)
    result <- as.integer(result)
    names(result) <- res_names

    .reorder_composition_components(result)
  })

  # Create new composition vector
  new_glycan_composition(new_compositions)
}

#' Get Monosaccharide Types
#'
#' This function determines the type of monosaccharides in character vectors,
#' glycan compositions, or glycan structures.
#' Supported types are "concrete", "generic", and "mixed" (see details
#' below).
#'
#' @details
#'
#' # Two types of monosaccharides
#'
#' There are two types of monosaccharides:
#' - concrete: e.g. "Gal", "GlcNAc", "Glc", "Fuc", etc.
#' - generic: e.g. "Hex", "HexNAc", "HexA", "HexN", etc.
#'
#' For the full list of monosaccharides, use [available_monosaccharides()].
#'
#' # Special monosaccharides
#'
#' Some monosaccharides are special in that they have no generic names in database or literature.
#' For example, "Mur" is a rare monosaccharide that has no popular generic name.
#' In `glyrepr`, we assign a "g" prefix to these monosaccharides as their generic names.
#' This includes "gNeu", "gKdn", "gPse", "gLeg", "gAci", "g4eLeg", "gBac", "gKdo", "gMur".
#' These names might only be meaningful inside `glycoverse`.
#' Take care when you export results from `glycoverse` functions to other analysis tools.
#'
#' @param x Either of these objects:
#'   - A character vector of monosaccharide names;
#'   - A glycan composition vector ("glyrepr_composition" object);
#'   - A glycan structure vector ("glyrepr_structure" object);
#'   - A glycan `igraph`.
#'
#' @returns
#'   - For character input, returns a character vector of the same length as `x`.
#'   - For `glyrepr_structure` and `glyrepr_composition` input, returns one
#'     value per element. Missing elements return `NA_character_`.
#'   - For `igraph` input, returns a character scalar.
#'   Character and structure-vector outputs preserve input names.
#'
#' @examples
#' # Character vector
#' get_mono_type(c("Gal", "Hex"))
#'
#' # Glycan structures
#' get_mono_type(n_glycan_core(mono_type = "concrete"))
#' get_mono_type(n_glycan_core(mono_type = "generic"))
#'
#' # Glycan compositions
#' comp <- glycan_composition(c(Glc = 2, GalNAc = 1))
#' get_mono_type(comp)
#'
#' @seealso [convert_to_generic()]
#'
#' @export
get_mono_type <- function(x) {
  UseMethod("get_mono_type")
}

#' @export
#' @rdname get_mono_type
get_mono_type.character <- function(x) {
  checkmate::assert_character(x)
  result <- vector("character", length = length(x))
  is_concrete <- x %in% monosaccharides$concrete
  is_generic <- x %in% monosaccharides$generic
  is_unknown <- !(is_concrete | is_generic)
  if (any(is_unknown)) {
    cli::cli_abort("Unknown monosaccharide: {.val {x[is_unknown]}}.")
  }
  result[is_concrete] <- "concrete"
  result[is_generic] <- "generic"
  names(result) <- names(x)
  result
}

#' @export
#' @rdname get_mono_type
get_mono_type.glyrepr_structure <- function(x) {
  if (!is_glycan_structure(x)) {
    cli::cli_abort(c(
      "Input must be a glyrepr_structure vector.",
      "i" = "Use `glycan_structure()` to create a glyrepr_structure from igraph objects."
    ))
  }

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

  smap_chr(x, get_graph_mono_type)
}

#' @export
#' @rdname get_mono_type
get_mono_type.igraph <- function(x) {
  get_graph_mono_type(x)
}

#' @export
#' @rdname get_mono_type
get_mono_type.glyrepr_composition <- function(x) {
  if (!is_glycan_composition(x)) {
    cli::cli_abort(c(
      "Input must be a glyrepr_composition vector.",
      "i" = "Use `glycan_composition()` to create a glyrepr_composition from named vectors."
    ))
  }

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

  compositions <- vctrs::field(x, "data")
  result <- purrr::map_chr(compositions, function(comp) {
    if (.is_na_composition_elem(comp)) {
      return(NA_character_)
    }

    mono_names <- names(comp)[!names(comp) %in% available_substituents()]
    get_mono_type_impl(mono_names)
  })
  names(result) <- names(x)
  result
}

#' Decide mono type from a vector of monosaccharide names
#'
#' This function handles the special cases where some monosaccharides
#' have the same name for both generic and concrete types.
#' For example, "Mur" is both a generic and concrete monosaccharide.
#'
#' This function is used internally when creating [glycan_composition()] and [glycan_structure()].
#'
#' @param x A character vector of monosaccharide names.
#' @returns A character scalar of monosaccharide type. Can be "concrete", "generic", "mixed", or "unknown".
#' @noRd
get_mono_type_impl <- function(x) {
  types <- tryCatch(
    get_mono_type.character(x),
    error = function(e) "unknown"
  )

  unique_types <- unique(types)
  if (length(unique_types) > 1) {
    "mixed"
  } else {
    unique_types[[1]]
  }
}

get_graph_mono_type <- function(graph) {
  # This function is the implementation of get_mono_type for a single glycan graph.
  monos <- igraph::vertex_attr(graph, "mono")
  get_mono_type_impl(monos)
}

#' Convert monosaccharide names to generic type
#'
#' This function converts concrete monosaccharide names to generic type.
#' Generic monosaccharides are returned as is.
#' Substituents are not converted.
#'
#' @param monos A character vector of monosaccharide names.
#' @returns A character vector of monosaccharide names in generic type.
#' @noRd
convert_mono_type_impl <- function(monos) {
  from_ <- monosaccharides[["concrete"]]
  to_ <- monosaccharides[["generic"]]

  # Preserve missing values and substituents.
  is_na <- is.na(monos)
  is_substituent <- monos %in% available_substituents()
  is_residue <- !is_na & !is_substituent

  result <- monos
  if (!any(is_residue)) {
    return(result)
  }

  residue_types <- get_mono_type(monos[is_residue])
  concrete <- which(is_residue)[residue_types == "concrete"]
  result[concrete] <- to_[match(monos[concrete], from_)]
  result
}

convert_glycan_mono_type_impl <- function(glycan, from, to) {
  old_names <- igraph::V(glycan)$mono
  new_names <- convert_mono_type_impl(old_names)
  raise_error_for_na(old_names, new_names, to)
  igraph::set_vertex_attr(glycan, "mono", value = new_names)
}

convert_structure_graph_to_generic <- function(graph, iupac) {
  old_names <- igraph::vertex_attr(graph, "mono")
  new_names <- convert_mono_type_impl(old_names)
  raise_error_for_na(old_names, new_names, "generic")

  if (identical(old_names, new_names)) {
    return(list(graph = graph, iupac = iupac, changed = FALSE))
  }

  graph <- igraph::set_vertex_attr(graph, "mono", value = new_names)
  canonical <- canonicalize_graph_with_iupac(graph)
  list(graph = canonical$graph, iupac = canonical$iupac, changed = TRUE)
}

raise_error_for_na <- function(old_names, new_names, to) {
  bad_names <- old_names[is.na(new_names)]
  if (length(bad_names) > 0) {
    cli::cli_abort(
      "Some monosaccharides cannot be converted to {.val {to}}: {.val {bad_names}}.",
      call = rlang::expr(convert_to_generic())
    )
  }
}