|
1
|
|
#' @title Rankings that extend a partial ranking
|
|
2
|
|
#' @description Returns all possible rankings that extend a partial ranking.
|
|
3
|
|
#'
|
|
4
|
|
#' @param data List as returned by [exact_rank_prob] when run with `only.results = FALSE`
|
|
5
|
|
#' @param force Logical scalar. Stops function if the number of rankings is too large.
|
|
6
|
|
#' Only change to TRUE if you know what you are doing
|
|
7
|
|
#' @details The `i`th row of the matrix contains the rank of node `i` in all possible rankings
|
|
8
|
|
#' that are in accordance with the partial ranking `P`. The lowest rank possible is
|
|
9
|
|
#' associated with `1`.
|
|
10
|
|
#' @return A matrix containing ranks of nodes in all possible rankings.
|
|
11
|
|
#' @author David Schoch
|
|
12
|
|
#' @examples
|
|
13
|
|
#' 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)
|
|
14
|
|
#' P
|
|
15
|
|
#' res <- exact_rank_prob(P,only.results = FALSE)
|
|
16
|
|
#' get_rankings(res)
|
|
17
|
|
#'
|
|
18
|
|
#' @export
|
|
19
|
|
|
|
20
|
|
get_rankings <- function(data, force = F) {
|
|
21
|
1
|
if (missing(data)){
|
|
22
|
1
|
stop("no data provided")
|
|
23
|
|
}
|
|
24
|
1
|
if (!all(c("lattice", "ideals", "topo.order", "lin.ext", "mse")%in%names(data))){
|
|
25
|
0
|
stop("data is in wrong format. run exact_rank_prob with only.results = F")
|
|
26
|
|
}
|
|
27
|
1
|
lattice <- data$lattice
|
|
28
|
1
|
ideals <- data$ideals
|
|
29
|
1
|
topo.order <- data$topo.order
|
|
30
|
1
|
linext <- data$lin.ext
|
|
31
|
1
|
mse <- data$mse
|
|
32
|
|
|
|
33
|
1
|
if (linext > 50000 & !force) {
|
|
34
|
0
|
stop("number of possible rankings is very high. Use force = F
|
|
35
|
0
|
if you know what you are doing.")
|
|
36
|
|
}
|
|
37
|
|
|
|
38
|
1
|
n <- length(unique(mse))
|
|
39
|
1
|
lattice <- lapply(lattice, function(x) x + 1)
|
|
40
|
1
|
g <- igraph::graph_from_adj_list(lattice, mode = "in")
|
|
41
|
1
|
paths <- igraph::all_shortest_paths(g, from = n + 1, to = 1)
|
|
42
|
|
|
|
43
|
1
|
paths <- lapply(paths$res, function(x) as.vector(x) - 1)
|
|
44
|
1
|
rks <- rankings(paths, ideals, linext, n)
|
|
45
|
1
|
rks <- rks + 1
|
|
46
|
1
|
rks <- rks[order(topo.order), ]
|
|
47
|
1
|
rks <- rks[mse, ]
|
|
48
|
1
|
return(rks)
|
|
49
|
|
}
|
schochastics