-
Notifications
You must be signed in to change notification settings - Fork 0
/
proporz.R
98 lines (95 loc) · 3.73 KB
/
proporz.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
#' Proportional apportionment
#'
#' Calculate seat apportionment for legislative bodies.
#'
#' @param votes numeric vector with number of votes for each party
#' @param n_seats total number of seats
#' @param method Apportionment method to use, as character. Not case sensitive. See details.
#' @param quorum Vote threshold a party must reach. Used as quota of total
#' votes within a district if less than 1 otherwise as number
#' of votes.
#'
#' @details The following methods are available: `r .doc_proporz_methods()`
#'
#' @returns The number of seats per party as a vector
#'
#' @note Seats can also be apportioned among regions instead of parties. The
#' parameter `votes` is then normally used with census data (e.g.
#' population counts).
#'
#' @examples
#' votes = c("Party A" = 651, "Party B" = 349, "Party C" = 50)
#'
#' proporz(votes, 10, "sainte-lague")
#'
#' proporz(votes, 10, "hill-huntington")
#'
#' proporz(votes, 10, "hill-huntington", quorum = 0.05)
#'
#' proporz(votes, 10, "jefferson", quorum = 70)
#'
#'@export
proporz = function(votes, n_seats, method, quorum = 0) {
proporz_method = get_method_implementation(method)
proporz_func = match.fun(proporz_method)
proporz_func(votes, n_seats, quorum)
}
#' List of method names and their implementation
#'
#' Names can be used in [proporz()] or [biproporz()], the list entries
#' denote the name of the implementation function.
#' @returns Named list of methods
#' @keywords internal
proporz_methods = list(
"d'hondt" = "divisor_floor",
"jefferson" = "divisor_floor",
"hagenbach-bischoff" = "divisor_floor",
"sainte-lague" = "divisor_round",
"webster" = "divisor_round",
"adams" = "divisor_ceiling",
"dean" = "divisor_harmonic",
"huntington-hill" = "divisor_geometric",
"hill-huntington" = "divisor_geometric",
"hare-niemeyer" = "largest_remainder_method",
"hamilton" = "largest_remainder_method",
"vinton" = "largest_remainder_method",
"floor" = "divisor_floor",
"round" = "divisor_round",
"ceiling" = "divisor_ceiling",
"harmonic" = "divisor_harmonic",
"geometric" = "divisor_geometric",
"largest_remainder_method" = "largest_remainder_method",
"divisor_floor" = "divisor_floor",
"divisor_round" = "divisor_round",
"divisor_ceiling" = "divisor_ceiling",
"divisor_harmonic" = "divisor_harmonic",
"divisor_geometric" = "divisor_geometric"
)
get_method_implementation = function(method_name) {
method_name <- tolower(method_name)
if(!method_name %in% names(proporz_methods)) {
stop("Unknown apportion method: ", method_name, ".\nAvailable: ",
paste0(names(proporz_methods), collapse=", "), call. = FALSE)
}
return(proporz_methods[[method_name]])
}
# function to create the list of method names for the proporz documentation
.doc_proporz_methods = function(only_divisor_methods = FALSE) { # nocov start
doc = c("\\itemize{")
implementation_list = unique(unlist(proporz_methods))
if(only_divisor_methods) {
implementation_list <- implementation_list[grepl("divisor_", implementation_list)]
}
for(implementation in implementation_list) {
method_names = names(proporz_methods[proporz_methods == implementation])
method_names <- method_names[!grepl("divisor_", method_names)]
if(only_divisor_methods) {
method_names <- method_names[!method_names %in% c("floor", "geometric", "harmonic", "round", "ceiling")]
}
method_names = paste0(method_names, collapse = ", ")
doc[length(doc)+1] <- paste0(" \\item{", method_names,
": use [", implementation, "()]}")
}
doc[length(doc)+1] <- "}"
return(paste(doc, collapse = "\n"))
} # nocov end