R/resolve_redirects.R

Defines functions .most_frequent_target .resolve_most_frequent .apply_redirect_conflict_policy .preprocess_redirects .assign_chain .fold_chain_from .build_canonical_map .break_arrow_loops .prune_loop_edges .format_cycle_path .resolve_via_graph .apply_fold_map .build_terminal_map .apply_map_to_edges .clean_redirect_pairs .validate_redirect_inputs resolve_redirects

Documented in resolve_redirects

#' @title Resolve Redirects in an Edge List
#' @description Updates an edge list by replacing URLs with their final
#'   destinations based on a redirect data frame. Handles redirect chains,
#'   detects cycles, and resolves conflicting redirects using configurable
#'   policies.
#'
#' @param edge_list_df A data frame representing the edge list.
#' @param redirects_df A data frame containing redirect rules, with 'from' and
#'   'to' columns specifying the source and target of a redirect.
#' @param edge_from_col Character, the name of the column in `edge_list_df`
#'   containing source URLs. Default "from".
#' @param edge_to_col Character, the name of the column in `edge_list_df`
#'   containing target URLs. Default "to".
#' @param redirect_from_col Character, the name of the column in `redirects_df`
#'   containing source URLs of redirects. Default "from".
#' @param redirect_to_col Character, the name of the column in `redirects_df`
#'   containing target URLs of redirects. Default "to".
#' @param duplicate_from_policy Character, how to handle conflicting redirects
#'   (same source URL mapping to multiple distinct targets). One of:
#'   \describe{
#'     \item{"strict"}{(Default) Error on any conflict.}
#'     \item{"first_wins"}{Keep the first occurrence for each conflicting
#'       source.}
#'     \item{"last_wins"}{Keep the last occurrence for each conflicting source.}
#'     \item{"most_frequent"}{Keep the most common target. Ties broken by first
#'       occurrence.}
#'     \item{"prune_source"}{Remove ALL redirects from any conflicting source.}
#'     \item{"resolve_if_consistent"}{Allow exact duplicates; error only on
#'       true conflicts where targets differ.}
#'   }
#' @param loop_handling Character, how to handle redirect cycles (loops).
#'   One of:
#'   \describe{
#'     \item{"error"}{(Default) Error when a redirect cycle is detected.}
#'     \item{"prune_loop"}{Remove all edges involved in cycles. URLs in the
#'       loop remain unresolved (map to themselves).}
#'     \item{"break_arrow"}{For each cycle, keep the node with the highest
#'       in-degree as the sink and remove edges pointing away from it within
#'       the cycle. This preserves as much of the chain as possible.}
#'   }
#'
#' @return An updated `edge_list_df` with URLs in `edge_from_col` and
#'   `edge_to_col` replaced by their final resolved destinations.
#' @family edge-list resolvers
#' @export
#' @examples
#' edges <- data.frame(
#'   from = c("A", "B", "C"),
#'   to = c("B", "C", "D")
#' )
#' redirects <- data.frame(
#'   from = c("B", "C", "E"),
#'   to = c("B_final", "C_final", "E_final")
#' )
#' resolve_redirects(edges, redirects)
#'
#' # Example with a redirect chain
#' edges_chain <- data.frame(from = "X", to = "Y")
#' redirects_chain <- data.frame(
#'   from = c("Y", "Z"),
#'   to = c("Z", "Z_final")
#' )
#' resolve_redirects(edges_chain, redirects_chain)
#'
#' # Example with conflicting redirects resolved via first_wins
#' edges_conflict <- data.frame(
#'   from = "A", to = "B"
#' )
#' redirects_conflict <- data.frame(
#'   from = c("B", "B"),
#'   to = c("C", "D")
#' )
#' resolve_redirects(edges_conflict, redirects_conflict,
#'   duplicate_from_policy = "first_wins"
#' )
#'
#' # Example with different column names
#' edges_custom <- data.frame(
#'   source_url = "Page1", target_url = "Page2"
#' )
#' redirects_custom <- data.frame(
#'   original = "Page2", final = "Page2_resolved"
#' )
#' resolve_redirects(edges_custom, redirects_custom,
#'   edge_from_col = "source_url",
#'   edge_to_col = "target_url",
#'   redirect_from_col = "original",
#'   redirect_to_col = "final"
#' )
#' @details
#' Self-referencing redirects (where from == to) and any redirects with NA
#' in from or to are automatically filtered out before processing.
#'
#' When crawl data contains conflicting redirects (the same URL redirecting
#' to different targets), use \code{duplicate_from_policy} to control the
#' behavior. The default \code{"strict"} preserves backward compatibility
#' by erroring on any conflict.
#'
#' Redirect resolution uses a graph-based approach: an igraph is built from
#' the redirect rules, strongly connected components (SCCs) are used to
#' detect loops, and the \code{loop_handling} policy determines what happens
#' to cycles. After loop handling, each URL is mapped to its terminal
#' destination by traversing the acyclic graph.

resolve_redirects <- function(edge_list_df,
                              redirects_df,
                              edge_from_col = "from",
                              edge_to_col = "to",
                              redirect_from_col = "from",
                              redirect_to_col = "to",
                              duplicate_from_policy = c(
                                "strict",
                                "first_wins",
                                "last_wins",
                                "most_frequent",
                                "prune_source",
                                "resolve_if_consistent"
                              ),
                              loop_handling = c(
                                "error",
                                "prune_loop",
                                "break_arrow"
                              )) {
  duplicate_from_policy <- match.arg(duplicate_from_policy)
  loop_handling <- match.arg(loop_handling)

  # --- Input Validation ---
  .validate_redirect_inputs(
    edge_list_df, redirects_df,
    edge_from_col, edge_to_col, redirect_from_col, redirect_to_col
  )

  # If redirects_df is empty or has no valid rules, return edge_list_df as is.
  if (nrow(redirects_df) == 0) {
    return(edge_list_df)
  }

  # Filter out NA values and self-referencing redirects (from == to).
  redirects_df <- .clean_redirect_pairs(
    redirects_df, redirect_from_col, redirect_to_col
  )

  # --- Preprocess: handle conflicting redirects ---
  redirect_sources <- as.character(redirects_df[[redirect_from_col]])
  redirect_targets <- as.character(redirects_df[[redirect_to_col]])

  valid_redirect_indices <- !is.na(redirect_sources) & !is.na(redirect_targets)
  redirect_sources <- redirect_sources[valid_redirect_indices]
  redirect_targets <- redirect_targets[valid_redirect_indices]

  if (length(redirect_sources) == 0) {
    return(edge_list_df)
  }

  # --- Build canonical redirect map via the neutral signal-agnostic builder ---
  canonical_map <- .build_terminal_map(
    redirect_sources, redirect_targets,
    duplicate_from_policy = duplicate_from_policy,
    loop_handling = loop_handling
  )

  if (length(canonical_map) == 0) {
    return(edge_list_df)
  }

  # --- Apply map to edge list (vectorized) ---
  .apply_map_to_edges(edge_list_df, canonical_map, edge_from_col, edge_to_col)
}


#' Validate `resolve_redirects()` inputs
#'
#' Stops with the original error text if either data frame is malformed or is
#' missing its required columns. Split into sequential `if` guards (rather than
#' `&&`-chains) to keep cyclomatic complexity low.
#' @noRd
.validate_redirect_inputs <- function(edge_list_df, redirects_df,
                                      edge_from_col, edge_to_col,
                                      redirect_from_col, redirect_to_col) {
  if (!is.data.frame(edge_list_df)) {
    stop("`edge_list_df` must be a data frame.", call. = FALSE)
  }
  if (nrow(edge_list_df) > 0) {
    if (!all(c(edge_from_col, edge_to_col) %in% names(edge_list_df))) {
      stop(
        "`edge_list_df` must have '", edge_from_col, "' and '",
        edge_to_col, "' columns if not empty.",
        call. = FALSE
      )
    }
  }

  if (!is.data.frame(redirects_df)) {
    stop("`redirects_df` must be a data frame.", call. = FALSE)
  }
  if (nrow(redirects_df) > 0) {
    if (!all(c(redirect_from_col, redirect_to_col) %in% names(redirects_df))) {
      stop("`redirects_df` must have '", redirect_from_col, "' and '",
        redirect_to_col, "' columns if not empty.",
        call. = FALSE
      )
    }
  }

  invisible(NULL)
}


#' Drop NA and self-referencing redirect rows
#'
#' Removes rows where either endpoint is NA, then removes self-references
#' (from == to, compared as characters).
#' @noRd
.clean_redirect_pairs <- function(redirects_df, redirect_from_col,
                                  redirect_to_col) {
  na_mask <- !is.na(redirects_df[[redirect_from_col]]) &
    !is.na(redirects_df[[redirect_to_col]])
  redirects_df <- redirects_df[na_mask, , drop = FALSE]

  if (nrow(redirects_df) > 0) {
    self_ref <- as.character(redirects_df[[redirect_from_col]]) ==
      as.character(redirects_df[[redirect_to_col]])
    redirects_df <- redirects_df[!self_ref, , drop = FALSE]
  }

  redirects_df
}


#' Apply a canonical map to the edge-list source/target columns
#'
#' Vectorized replacement of both edge columns (when present) via
#' [.apply_fold_map()].
#' @noRd
.apply_map_to_edges <- function(edge_list_df, canonical_map,
                                edge_from_col, edge_to_col) {
  resolved_edge_list <- edge_list_df

  for (col_name in c(edge_from_col, edge_to_col)) {
    if (col_name %in% names(resolved_edge_list)) {
      resolved_edge_list[[col_name]] <- .apply_fold_map(
        resolved_edge_list[[col_name]], canonical_map
      )
    }
  }

  resolved_edge_list
}


# --- Internal: neutral, signal-agnostic terminal-map builder ---

#' Build a terminal fold map from raw (from, to) pairs of any URL signal
#'
#' This is the reusable graph machinery shared by redirect resolution and
#' canonical folding. It is deliberately signal-agnostic: it knows nothing
#' about whether the pairs are 3xx redirects or declared rel=canonicals. Given
#' source/target vectors it strips NAs and self-references, applies the chosen
#' duplicate-source policy via [.preprocess_redirects()], then resolves chains
#' and cycles to terminal destinations via [.resolve_via_graph()].
#'
#' @param from Character vector of source URLs.
#' @param to Character vector of target URLs.
#' @param duplicate_from_policy How to handle a source with multiple distinct
#'   targets. See [resolve_redirects()].
#' @param loop_handling How to handle cycles. See [resolve_redirects()].
#' @return A named character vector mapping every reachable source URL to its
#'   final terminal destination. Entries where a URL maps to itself are
#'   retained (callers filter via [.apply_fold_map()] / `match()`). Returns an
#'   empty named vector when there are no effective rules.
#' @noRd
.build_terminal_map <- function(from, to,
                                duplicate_from_policy = "strict",
                                loop_handling = "error") {
  from <- as.character(from)
  to <- as.character(to)

  valid <- !is.na(from) & !is.na(to)
  from <- from[valid]
  to <- to[valid]

  if (length(from) == 0) {
    return(stats::setNames(character(0), character(0)))
  }

  # Drop self-references (no-op folds, e.g. self-canonicals / self-redirects).
  self_ref <- from == to
  from <- from[!self_ref]
  to <- to[!self_ref]

  if (length(from) == 0) {
    return(stats::setNames(character(0), character(0)))
  }

  clean_df <- data.frame(from = from, to = to)
  clean_df <- .preprocess_redirects(clean_df, "from", "to",
    policy = duplicate_from_policy
  )

  if (nrow(clean_df) == 0) {
    return(stats::setNames(character(0), character(0)))
  }

  .resolve_via_graph(clean_df$from, clean_df$to, loop_handling = loop_handling)
}


#' Apply a terminal fold map to a vector of URLs
#'
#' Replaces each URL with its mapped representative, leaving unmapped URLs and
#' NAs untouched. Mirrors the vectorized replacement used throughout the
#' redirect/canonical machinery so edges, priors, and externally reported maps
#' all fold identically.
#'
#' @param urls Character vector (or coercible) of URLs to fold.
#' @param map Named character vector (source -> representative), e.g. from
#'   [.build_terminal_map()] or [.compose_fold_map()].
#' @return Character vector the same length as `urls`, with mapped entries
#'   replaced and original NAs preserved.
#' @noRd
.apply_fold_map <- function(urls, map) {
  original <- as.character(urls)
  if (length(map) == 0) {
    return(original)
  }
  idx <- match(original, names(map))
  resolved <- ifelse(!is.na(idx), unname(map)[idx], original)
  resolved[is.na(original)] <- NA_character_
  resolved
}


# --- Internal: graph-based redirect resolution ---

#' Resolve redirects using igraph and SCC-based loop detection
#'
#' Builds a directed graph from redirect pairs, detects loops via strongly
#' connected components, applies the chosen loop_handling policy, then
#' traverses the resulting DAG to produce a canonical redirect map.
#'
#' @param from Character vector of redirect sources.
#' @param to Character vector of redirect targets.
#' @param loop_handling One of "error", "prune_loop", "break_arrow".
#' @return Named character vector mapping every reachable URL to its final
#'   resolved destination.
#' @noRd
.resolve_via_graph <- function(from, to, loop_handling = "error") {
  # Build redirect graph
  redirect_edges <- data.frame(from = from, to = to)
  g <- igraph::graph_from_data_frame(redirect_edges, directed = TRUE)

  # --- Detect loops via SCCs ---
  scc <- igraph::components(g, mode = "strong")
  # SCCs of size > 1 are cycles; also check self-loops
  loop_sccs <- which(scc$csize > 1)
  self_loop_eids <- which(igraph::which_loop(g))
  has_self_loops <- length(self_loop_eids) > 0
  has_loops <- length(loop_sccs) > 0 || has_self_loops

  if (has_loops) {
    if (loop_handling == "error") {
      # Report the first cycle found
      if (length(loop_sccs) > 0) {
        first_scc_id <- loop_sccs[1]
        cycle_verts <- igraph::V(g)[scc$membership == first_scc_id]
        cycle_names <- igraph::V(g)$name[cycle_verts]
        # Build a readable cycle path
        cycle_path <- .format_cycle_path(g, cycle_names)
        stop("Redirect cycle detected: ", cycle_path, call. = FALSE)
      } else {
        # Self-loop only
        sl_ends <- igraph::ends(g, self_loop_eids[1])
        sl_name <- sl_ends[1, 1]
        stop("Redirect cycle detected: ", sl_name, " -> ", sl_name,
          call. = FALSE
        )
      }
    }

    # Remove self-loops first (they should have been filtered, but belt &
    # suspenders)
    if (has_self_loops) {
      g <- igraph::delete_edges(g, self_loop_eids)
    }

    if (loop_handling == "prune_loop") {
      g <- .prune_loop_edges(g, scc, loop_sccs)
    } else if (loop_handling == "break_arrow") {
      g <- .break_arrow_loops(g, scc, loop_sccs)
    }
  }

  # --- Build canonical map by traversing the DAG ---
  .build_canonical_map(g)
}


#' Format a readable cycle path from SCC vertices
#' @noRd
.format_cycle_path <- function(g, cycle_names) {
  # Walk from the first cycle vertex following edges within the SCC
  # to produce a readable A -> B -> C -> A path
  visited <- character(0)
  current <- cycle_names[1]
  path <- current

  for (i in seq_along(cycle_names)) {
    neighbors <- igraph::neighbors(g, current, mode = "out")
    next_in_cycle <- intersect(igraph::V(g)$name[neighbors], cycle_names)
    # Pick a neighbor we haven't visited yet, or the first one to close cycle
    unvisited <- setdiff(next_in_cycle, path)
    if (length(unvisited) > 0) {
      current <- unvisited[1]
      path <- c(path, current)
    } else if (length(next_in_cycle) > 0) {
      # Close the cycle
      path <- c(path, next_in_cycle[1])
      break
    } else {
      break
    }
  }

  paste(path, collapse = " -> ")
}


#' Remove all edges within SCC loops
#' @noRd
.prune_loop_edges <- function(g, scc, loop_sccs) {
  for (scc_id in loop_sccs) {
    loop_verts <- igraph::V(g)[scc$membership == scc_id]
    loop_names <- igraph::V(g)$name[loop_verts]
    # Remove all edges where both endpoints are in this SCC
    edges_to_remove <- igraph::E(g)[.inc(loop_verts)] # nolint
    # Filter to only edges fully within the SCC (not edges leaving/entering)
    el <- igraph::ends(g, edges_to_remove)
    within_scc <- el[, 1] %in% loop_names & el[, 2] %in% loop_names
    g <- igraph::delete_edges(g, edges_to_remove[within_scc])
  }
  g
}


#' Break loops by keeping the highest in-degree node as a sink
#' @noRd
.break_arrow_loops <- function(g, scc, loop_sccs) {
  for (scc_id in loop_sccs) {
    loop_verts <- igraph::V(g)[scc$membership == scc_id]
    loop_names <- igraph::V(g)$name[loop_verts]

    # Pick the cycle node with the highest GLOBAL in-degree as the sink -- this
    # counts inbound edges from outside the cycle too, so the most-redirected-to
    # page becomes the canonical destination (in a bare cycle every within-cycle
    # in-degree is 1, so external inbound is the meaningful tie-breaker; ties
    # fall back to first vertex order). Behavior asserted in
    # test-resolve_redirects.R "break_arrow with asymmetric in-degree".
    in_deg <- igraph::degree(g, v = loop_verts, mode = "in")
    sink_idx <- which.max(in_deg)
    sink_name <- loop_names[sink_idx]

    # Remove outgoing edges FROM the sink that stay within the SCC
    out_edges <- igraph::E(g)[.from(igraph::V(g)[sink_name])] # nolint
    el <- igraph::ends(g, out_edges)
    within_scc <- el[, 2] %in% loop_names
    g <- igraph::delete_edges(g, out_edges[within_scc])
  }
  g
}


#' Build a canonical URL map by traversing the redirect graph
#'
#' For every vertex, follow outgoing edges until a terminal vertex (one with
#' no outgoing edges in the redirect graph, i.e. a final destination) is
#' reached. Returns a named vector: source -> final_destination.
#' @noRd
.build_canonical_map <- function(g) {
  vnames <- igraph::V(g)$name
  n <- length(vnames)

  if (n == 0) {
    return(stats::setNames(character(0), character(0)))
  }

  # Pre-compute adjacency for speed: for each vertex, its single out-neighbor
  # (redirect graphs should have out-degree <= 1 per vertex after dedup)
  out_list <- igraph::as_adj_list(g, mode = "out")

  # Map vertex names to indices for fast lookup
  name_to_idx <- stats::setNames(seq_len(n), vnames)

  resolved <- rep(NA_character_, n)

  # Iterative traversal with memoization
  for (i in seq_len(n)) {
    if (is.na(resolved[i])) {
      resolved <- .fold_chain_from(i, resolved, out_list, vnames)
    }
  }

  # Return map: only include entries where a redirect actually changes the URL
  # (source vertices from the original redirect data)
  canonical <- stats::setNames(resolved, vnames)
  # Keep all entries -- the caller filters by match()
  canonical
}


#' Walk one redirect chain to its terminal and fold it into `resolved`
#'
#' Follows outgoing edges from `start` (out-degree <= 1 after loop handling)
#' until reaching an already-resolved node, a terminal node, or -- defensively
#' -- a re-encountered node (which would indicate a cycle that should be
#' impossible here). Every visited source in the chain is then set to the
#' terminal destination. Returns the updated `resolved` vector.
#' @noRd
.fold_chain_from <- function(start, resolved, out_list, vnames) {
  chain <- integer(0)
  current <- start

  while (TRUE) {
    if (!is.na(resolved[current])) {
      # Already resolved: apply to whole chain
      return(.assign_chain(resolved, chain, resolved[current]))
    }

    if (current %in% chain) {
      # Defensive: a cycle reached this traversal, which should be impossible
      # given the out-degree <= 1 invariant plus loop_handling in
      # .resolve_via_graph. Break rather than spin forever -- resolve the
      # chain to the re-encountered node so callers get a usable map instead
      # of a silent hang. Mirrors the guard in audit_redirects.R's traversal.
      return(.assign_chain(resolved, chain, vnames[current]))
    }

    chain <- c(chain, current)
    out_neighbors <- out_list[[current]]
    if (length(out_neighbors) == 0) {
      # Terminal node
      return(.assign_chain(resolved, chain, vnames[current]))
    }

    # Follow the first (and ideally only) outgoing edge
    current <- as.integer(out_neighbors[1])
  }
}


#' Assign a terminal destination to every index in a redirect chain
#' @noRd
.assign_chain <- function(resolved, chain, final) {
  for (ci in chain) resolved[ci] <- final
  resolved
}


# --- Internal: preprocess conflicting redirects ---

#' Preprocess redirects to handle conflicting sources
#'
#' Given a two-column data frame of (from, to) redirect pairs (already cleaned
#' of NAs and self-refs), detect conflicting sources and apply the chosen
#' policy.
#'
#' @param redirects_df Data frame with columns named by `from_col` and `to_col`.
#' @param from_col Character, name of the source column.
#' @param to_col Character, name of the target column.
#' @param policy One of "strict", "first_wins", "last_wins", "most_frequent",
#'   "prune_source", "resolve_if_consistent".
#' @return A deduplicated data frame where each source maps to exactly one
#'   target.
#' @noRd
.preprocess_redirects <- function(redirects_df, from_col, to_col,
                                  policy = "strict") {
  sources <- redirects_df[[from_col]]
  targets <- redirects_df[[to_col]]

  # --- Detect conflicting sources ---
  # A source is "conflicting" if it has >1 distinct target
  src_target_pairs <- paste0(sources, "\t", targets)
  unique_pairs_df <- redirects_df[!duplicated(src_target_pairs), , drop = FALSE]
  dup_sources <- unique_pairs_df[[from_col]][
    duplicated(unique_pairs_df[[from_col]])
  ]
  conflicting_sources <- unique(dup_sources)

  # No conflicts: just deduplicate exact duplicates and return

  if (length(conflicting_sources) == 0) {
    return(unique_pairs_df)
  }

  # --- Apply policy ---
  .apply_redirect_conflict_policy(
    redirects_df, from_col, to_col, policy,
    sources, targets, conflicting_sources
  )
}

#' Resolve conflicting redirect sources according to the chosen policy
#'
#' Invoked by [.preprocess_redirects()] only when at least one source has
#' multiple distinct targets. Error-message text and per-policy behavior are
#' preserved verbatim.
#' @noRd
.apply_redirect_conflict_policy <- function(redirects_df, from_col, to_col,
                                            policy, sources, targets,
                                            conflicting_sources) {
  if (policy == "strict") {
    first_conflict <- conflicting_sources[1]
    conflict_targets <- unique(targets[sources == first_conflict])
    stop("Ambiguous redirect: URL '", first_conflict,
      "' maps to multiple distinct targets: ",
      toString(conflict_targets),
      call. = FALSE
    )
  }

  if (policy == "resolve_if_consistent") {
    first_conflict <- conflicting_sources[1]
    conflict_targets <- unique(targets[sources == first_conflict])
    stop("Ambiguous redirect: URL '", first_conflict,
      "' maps to multiple distinct targets: ",
      toString(conflict_targets),
      call. = FALSE
    )
  }

  if (policy == "first_wins") {
    return(redirects_df[!duplicated(sources), , drop = FALSE])
  }

  if (policy == "last_wins") {
    return(redirects_df[!duplicated(sources, fromLast = TRUE), , drop = FALSE])
  }

  if (policy == "prune_source") {
    keep <- !(sources %in% conflicting_sources)
    # Also deduplicate the remaining non-conflicting redirects
    result <- redirects_df[keep, , drop = FALSE]
    if (nrow(result) > 0) {
      dedup_key <- paste0(result[[from_col]], "\t", result[[to_col]])
      result <- result[!duplicated(dedup_key), , drop = FALSE]
    }
    return(result)
  }

  if (policy == "most_frequent") {
    return(.resolve_most_frequent(
      redirects_df, from_col, to_col, conflicting_sources
    ))
  }

  # Should not reach here due to match.arg in caller, but as safeguard
  stop("Unknown duplicate_from_policy: ", policy, call. = FALSE) # nocov
}


#' Resolve conflicting sources by keeping the most frequent target
#'
#' Non-conflicting sources are simply deduplicated; each conflicting source is
#' reduced to its modal target (ties broken by first occurrence) via
#' [.most_frequent_target()].
#' @noRd
.resolve_most_frequent <- function(redirects_df, from_col, to_col,
                                   conflicting_sources) {
  # For non-conflicting sources: just deduplicate
  is_conflict <- redirects_df[[from_col]] %in% conflicting_sources
  non_conflict <- redirects_df[!is_conflict, , drop = FALSE]
  if (nrow(non_conflict) > 0) {
    nc_key <- paste0(non_conflict[[from_col]], "\t", non_conflict[[to_col]])
    non_conflict <- non_conflict[!duplicated(nc_key), , drop = FALSE]
  }

  # For conflicting sources: find the mode target per source
  conflict_df <- redirects_df[is_conflict, , drop = FALSE]
  resolved_rows <- lapply(conflicting_sources, function(src) {
    .most_frequent_target(conflict_df, from_col, to_col, src)
  })
  resolved <- do.call(rbind, resolved_rows)
  names(resolved) <- c(from_col, to_col)
  rbind(non_conflict, resolved)
}


#' Pick the modal target for one conflicting source
#'
#' Returns a one-row `data.frame(from, to)` with the most frequent target for
#' `src`; ties are broken by earliest occurrence in `conflict_df`.
#' @noRd
.most_frequent_target <- function(conflict_df, from_col, to_col, src) {
  idx <- conflict_df[[from_col]] == src
  src_targets <- conflict_df[[to_col]][idx]
  freq <- table(src_targets)
  max_freq <- max(freq)
  candidates <- names(freq)[freq == max_freq]
  # Tie-break: first occurrence in original data
  winner <- candidates[1]
  for (cand in candidates) {
    if (match(cand, src_targets) < match(winner, src_targets)) {
      winner <- cand
    }
  }
  data.frame(from = src, to = winner)
}

Try the pagerankr package in your browser

Any scripts or data that you put into this service are public.

pagerankr documentation built on Oct. 1, 2026, 5:09 p.m.