RedEnginePress logo
RedEnginePress
AlgorithmsLanguagesPlaygroundAbout

Johnson Shortest Paths

S
# Johnson's All-Pairs Shortest Paths Algorithm
#
# Johnson's algorithm computes shortest paths between all pairs of vertices
# in a sparse, weighted directed graph that may have negative edge weights
# (but no negative cycles). It reweights edges using Bellman-Ford to remove
# negative weights and then runs Dijkstra from each vertex.
#
# Time Complexity: O(V * E + V * (E log V)) with a binary heap priority queue
# Space Complexity: O(V + E)
#
# Graph representation matches other files in this folder:
# - Adjacency list: a named list where each name is a vertex index as a string
# - Each entry is a list of edges: list(vertex = <int>, weight = <numeric>)

# ----------------------------
# Priority Queue (simple) API
# ----------------------------
create_priority_queue <- function() {
  list(
    elements = data.frame(vertex = integer(0), distance = numeric(0)),
    size = 0
  )
}

pq_insert <- function(pq, vertex, distance) {
  pq$elements <- rbind(pq$elements, data.frame(vertex = vertex, distance = distance))
  pq$size <- pq$size + 1
  return(pq)
}

pq_extract_min <- function(pq) {
  if (pq$size == 0) {
    return(list(pq = pq, min_element = NULL))
  }
  min_idx <- which.min(pq$elements$distance)
  min_element <- pq$elements[min_idx, ]
  pq$elements <- pq$elements[-min_idx, ]
  pq$size <- pq$size - 1
  return(list(pq = pq, min_element = min_element))
}

pq_is_empty <- function(pq) {
  return(pq$size == 0)
}

# -----------------------------------------------
# Bellman-Ford potentials (no explicit supersource)
# -----------------------------------------------
# Equivalent to adding a new super-source s with 0-weight edges to all vertices,
# by initializing h[i] = 0 for all i and relaxing edges (V-1) times.
bellman_ford_potentials <- function(graph) {
  # Collect all vertices appearing as sources or targets
  all_vertices <- unique(c(names(graph), unlist(lapply(graph, function(x) sapply(x, function(e) e$vertex)))))
  all_vertices <- as.numeric(all_vertices)
  V <- max(all_vertices)

  # Initialize h with zeros (super-source trick)
  h <- rep(0, V)

  # Relax edges V-1 times
  for (i in 1:(V - 1)) {
    updated <- FALSE
    for (u_char in as.character(1:V)) {
      if (!(u_char %in% names(graph))) next
      u <- as.numeric(u_char)
      for (edge in graph[[u_char]]) {
        v <- edge$vertex
        w <- edge$weight
        if (h[u] + w < h[v]) {
          h[v] <- h[u] + w
          updated <- TRUE
        }
      }
    }
    if (!updated) break
  }

  # Check for negative-weight cycles
  negative_cycle <- FALSE
  for (u_char in as.character(1:V)) {
    if (!(u_char %in% names(graph))) next
    u <- as.numeric(u_char)
    for (edge in graph[[u_char]]) {
      v <- edge$vertex
      w <- edge$weight
      if (h[u] + w < h[v]) {
        negative_cycle <- TRUE
        break
      }
    }
    if (negative_cycle) break
  }

  list(h = h, V = V, negative_cycle = negative_cycle)
}

# ---------------------------
# Dijkstra on reweighted graph
# ---------------------------
dijkstra_on_adj <- function(graph, source, V) {
  distances <- rep(Inf, V)
  previous <- rep(-1, V)
  visited <- rep(FALSE, V)

  distances[source] <- 0
  pq <- create_priority_queue()
  pq <- pq_insert(pq, source, 0)

  while (!pq_is_empty(pq)) {
    res <- pq_extract_min(pq)
    pq <- res$pq
    cur <- res$min_element
    if (is.null(cur)) break

    u <- cur$vertex
    if (visited[u]) next
    visited[u] <- TRUE

    u_char <- as.character(u)
    if (u_char %in% names(graph)) {
      for (edge in graph[[u_char]]) {
        v <- edge$vertex
        w <- edge$weight
        if (!visited[v] && distances[u] + w < distances[v]) {
          distances[v] <- distances[u] + w
          previous[v] <- u
          pq <- pq_insert(pq, v, distances[v])
        }
      }
    }
  }

  list(distances = distances, previous = previous)
}

# ---------------------
# Johnson's main driver
# ---------------------
johnson_shortest_paths <- function(graph) {
  # Ensure all vertices 1..V exist as keys (even if empty list)
  all_vertices <- unique(c(names(graph), unlist(lapply(graph, function(x) sapply(x, function(e) e$vertex)))))
  all_vertices <- as.numeric(all_vertices)
  V <- max(all_vertices)
  for (u in as.character(1:V)) {
    if (!(u %in% names(graph))) graph[[u]] <- list()
  }

  # Step 1: Bellman-Ford to get potentials h
  bf <- bellman_ford_potentials(graph)
  if (bf$negative_cycle) {
    return(list(
      distances = NULL,
      negative_cycle = TRUE,
      message = "Graph contains a negative-weight cycle; shortest paths undefined"
    ))
  }
  h <- bf$h

  # Step 2: Reweight edges to eliminate negative weights
  reweighted <- vector("list", V)
  names(reweighted) <- as.character(1:V)
  for (i in 1:V) reweighted[[i]] <- list()
  for (u_char in as.character(1:V)) {
    u <- as.numeric(u_char)
    for (edge in graph[[u_char]]) {
      v <- edge$vertex
      w <- edge$weight
      w_prime <- w + h[u] - h[v]
      reweighted[[u_char]] <- append(reweighted[[u_char]], list(list(vertex = v, weight = w_prime)))
    }
  }

  # Step 3: Run Dijkstra from each vertex on the reweighted graph
  dist_matrix <- matrix(Inf, nrow = V, ncol = V)
  for (s in 1:V) {
    dj <- dijkstra_on_adj(reweighted, s, V)
    # Convert distances back to original weights
    for (v in 1:V) {
      if (!is.infinite(dj$distances[v])) {
        dist_matrix[s, v] <- dj$distances[v] - h[s] + h[v]
      }
    }
  }

  list(
    distances = dist_matrix,
    negative_cycle = FALSE
  )
}

# -----------------
# Example / Demo
# -----------------
cat("=== Johnson's All-Pairs Shortest Paths Algorithm ===\n")

# Convert the Java example (0-based) to 1-based indices used here
# Java edges:
# 0->1(3), 0->2(8), 0->4(-4), 1->3(1), 1->4(7), 2->1(4), 3->0(2), 3->2(-5), 4->3(6)
j_graph <- list(
  "1" = list(list(vertex = 2, weight = 3), list(vertex = 3, weight = 8), list(vertex = 5, weight = -4)),
  "2" = list(list(vertex = 4, weight = 1), list(vertex = 5, weight = 7)),
  "3" = list(list(vertex = 2, weight = 4)),
  "4" = list(list(vertex = 1, weight = 2), list(vertex = 3, weight = -5)),
  "5" = list(list(vertex = 4, weight = 6))
)

cat("Running Johnson on 5-vertex graph (with negative edges, no negative cycles) ...\n")
j_res <- johnson_shortest_paths(j_graph)
if (isTRUE(j_res$negative_cycle)) {
  cat("Negative cycle detected. Shortest paths undefined.\n")
} else {
  cat("All-pairs shortest path distance matrix (rows = sources, cols = targets):\n")
  print(j_res$distances)
}