R/get.rankings.R

In netrankr: Analyzing Partial Rankings in Networks

#' @title Rankings that extend a partial ranking
#' @description Returns all possible rankings that extend a partial ranking.
#'
#' @param data List as returned by [exact_rank_prob] when run with `only.results = FALSE`
#' @param force Logical scalar. Stops function if the number of rankings is too large.
#' Only change to TRUE if you know what you are doing
#' @details The `i`th row of the matrix contains the rank of node `i` in all possible rankings
#' that are in accordance with the partial ranking `P`. The lowest rank possible is
#' associated with `1`.
#' @return A matrix containing ranks of nodes in all possible rankings.
#' @author David Schoch
#' @examples
#' P <- matrix(c(0, 0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, rep(0, 10)), 5, 5, byrow = TRUE)
#' P
#' res <- exact_rank_prob(P, only.results = FALSE)
#' get_rankings(res)
#' @export

get_rankings <- function(data, force = FALSE) {
  if (!"netrankr_full" %in% class(data)) {
    stop("data is not a netrankr_full object")
  }

  if (is.null(data$tree)) {
    stop("input does not include all necessary data structures. run exact_rank_prob() with 'only.results = FALSE'")
  }
  lattice <- data$lattice
  ideals <- data$ideals
  topo.order <- data$topo.order
  linext <- data$lin.ext
  mse <- data$mse

  if (linext > 50000 & !force) {
    stop("number of possible rankings is very high. Use 'force = FALSE'
           if you know what you are doing.")
  }

  n <- length(unique(mse))
  lattice <- lapply(lattice, function(x) x + 1)
  g <- igraph::graph_from_adj_list(lattice, mode = "in")
  paths <- igraph::all_shortest_paths(g, from = n + 1, to = 1)

  paths <- lapply(paths$res, function(x) as.vector(x) - 1)
  rks <- rankings(paths, ideals, linext, n)
  rks <- rks + 1
  rks <- rks[order(topo.order), ]
  rks <- rks[mse, ]
  return(rks)
}