/
lexcel1.R
139 lines (130 loc) · 4.7 KB
/
lexcel1.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
#' @export
`[.L1Scores` <- function(x, i, ...) structure(unclass(x)[i], class = 'L1Scores')
#' @export
`==.L1Scores` <- function(a, b) {identical(a[[1]], b[[1]])}
#' @export
`>.L1Scores` <- function(a, b) {
a <- a[[1]]
b <- b[[1]]
i <- which(a != b)
length(i) > 0 && a[i[1]] > b[i[1]]
}
#' @export
is.na.L1Scores <- function(x) FALSE
#' L1 Ranking
#'
#' Calculate the \eqn{L^{(1)}}{L^(1)} scores.
#'
#' @details
#'
#' Similar to [`lexcelRanking()`], the number of times an element appears in each equivalence class is counted.
#' In addition, we now also consider the size of the coalitions.
#'
#' @template lexcel/frequencyMatrixDoc
#'
#' @details
#' The \eqn{L^{(1)}}{L^(1)} rewards elements that appear in higher ranking coalitions as well as in smaller coalitions.
#' When comparing two matrices for a power relation, if \eqn{M^\succsim_i >_{L^{(1)}} M^\succsim_j}{M^(>=)_i > M^(>=)_j (the ^(>=) will be omitted to improve readability)},
#' this suggests that there exists a \eqn{p^0 \in \{1, \dots, |N|\}}{p^0 in \{1, ..., |N|\}} and \eqn{q^0 \in \{1, \dots, m\}}{q^0 in \{1, ..., m\}} such that the following holds:
#'
#' 1. \eqn{(M^\succsim_i)_{p^0,q^0} > (M^\succsim_j)_{p^0,q^0}}{(M_i)_(p^0 q^0) > (M_j)_(p^0 q^0)}
#' 2. \eqn{(M^\succsim_i)_{p,q^0} = (M^\succsim_j)_{p,q^0}}{(M_i)_(p q^0) = (M_j)_(p q^0)} for all \eqn{p < p^0}{p < p^0}
#' 3. \eqn{(M^\succsim_i)_{p,q} = (M^\succsim_j)_{p,q}}{(M_i)_(pq) = (M_j)_(p,q)} for all \eqn{q < q^0}{q < q^0} and \eqn{p \in \{1, \dots, |N|\}}{p in \{1, ..., |N|\}}
#'
#' @section Example:
#' Let \eqn{\succsim: (123 \sim 13 \sim 2) \succ (12 \sim 1 \sim 3) \succ (23 \sim \{\})}{>=: (123 ~ 13 ~ 2) > (12 ~ 1 ~ 3) > (23 ~ \{\})}.
#' From this, we get the following three matrices:
#'
#' \deqn{
#' M^\succsim_1 = \begin{bmatrix}
#' 0 & 1 & 0\\
#' 1 & 1 & 0\\
#' 1 & 0 & 0
#' \end{bmatrix}
#' M^\succsim_2 = \begin{bmatrix}
#' 1 & 0 & 0\\
#' 0 & 1 & 1\\
#' 1 & 0 & 0
#' \end{bmatrix}
#' M^\succsim_3 = \begin{bmatrix}
#' 0 & 1 & 0\\
#' 1 & 0 & 1\\
#' 1 & 0 & 0
#' \end{bmatrix}
#' }{
#' M^(>=)_1 = matrix(c(0,1,1,1,1,0,0,0,0),nrow=3)\\
#' M^(>=)_2 = matrix(c(1,0,1,0,1,0,0,1,0),nrow=3)\\
#' M^(>=)_3 = matrix(c(0,1,1,1,0,0,0,1,0),nrow=3)
#' }
#'
#' From \eqn{(M^\succsim_2)_{1,1} > (M^\succsim_1)_{1,1}}{(M_2)_(1,1) > (M_1)_1,1} and \eqn{(M^\succsim_2)_{1,1} > (M^\succsim_3)_{1,1}}{(M_2)_(1,1) > (M_3)_1,1} it
#' immediately follows that \eqn{2}{2} is ranked above \eqn{1}{1} and \eqn{3}{3} according to \eqn{L^{(1)}}{L^(1)}.
#'
#' Comparing \eqn{1}{1} against \eqn{3}{3} we can set \eqn{p^0 = 2}{p^0 = 2} and \eqn{q^0 = 2}{q^0 = 2}.
#' Following the constraints from the definition above, we can verify that the entire column 1 is identical.
#' In column 2, we determine that \eqn{(M^\succsim_1)_{1,q^0} = (M^\succsim_3)_{1,q^0}}{(M_1)_(1,q^0) = (M_3)_(1,q^0)}, whereas
#' \eqn{(M^\succsim_1)_{p^0,q^0} > (M^\succsim_3)_{p^0,q^0}}{(M_1)_(p^0,q^0) > (M_3)_(p^0,q^0)}, indicating that \eqn{1}{1}
#' is ranked higher than \eqn{3}{3}, hence \eqn{2 \succ 1 \succ 3}{2 > 1 > 3} according to \eqn{L^{(1)}}{L^(1)}.
#'
#' @section Aliases:
#'
#' For better discoverability, `lexcel1Scores()` and `lexcel1Ranking()` serve as aliases for `L1Scores()` and `L1Ranking()`, respectively.
#'
#' @template param/powerRelation
#' @template param/elements
#'
#' @family ranking solution functions
#'
#' @references
#' \insertRef{2021Lexcel}{socialranking}
#'
#' @return Score function returns a list of type `L1Scores` and length of `powerRelation$elements`
#' (unless parameter `elements` is specified).
#' Each index contains a vector of length `powerRelation$eqs`, the number of
#' times the given element appears in each equivalence class.
#'
#' @examples
#' pr <- as.PowerRelation("(123 ~ 13 ~ 2) > (12 ~ 1 ~ 3) > (23 ~ {})")
#' scores <- L1Scores(pr)
#' scores$`1`
#' # [,1] [,2] [,3]
#' # [1,] 0 1 0
#' # [2,] 1 1 0
#' # [3,] 1 0 0
#'
#' L1Ranking(pr)
#' # 2 > 1 > 3
#'
#' @export
L1Scores <- function(powerRelation, elements = powerRelation$elements) {
# --- checks (generated) --- #
stopifnot(is.PowerRelation(powerRelation))
# --- end checks --- #
l <- list()
for(e in elements) {
m <- matrix(0, nrow = length(powerRelation$elements), ncol = length(powerRelation$eqs))
for(index in powerRelation$elementLookup(e)) {
y <- length(powerRelation$eqs[[index[1]]][[index[2]]])
x <- index[1]
m[y,x] <- m[y,x] + 1
}
l[[paste(e)]] <- m
}
structure(l, class = 'L1Scores')
}
#' `L1Ranking()` returns the corresponding ranking.
#'
#' @rdname L1Scores
#'
#' @template return/ranking
#'
#' @export
L1Ranking <- function(powerRelation) {
doRanking(L1Scores(powerRelation))
}
#' @rdname L1Scores
#' @export
lexcel1Scores <- L1Scores
#' @rdname L1Scores
#' @export
lexcel1Ranking <- L1Ranking