rename quota_largest_remainder to largest_remainder_method

like highest_averages_method

NAMESPACE

@@ -10,14 +10,14 @@ export(divisor_harmonic)
 export(divisor_round)
 export(get_divisors)
 export(highest_averages_method)
+export(largest_remainder_method)
 export(lower_apportionment)
 export(pivot_to_df)
 export(pivot_to_matrix)
 export(proporz)
 export(pukelsheim)
 export(quorum_all)
 export(quorum_any)
-export(quota_largest_remainder)
 export(reached_quorum_any_district)
 export(reached_quorum_total)
 export(run_app)

R/biproportional-check.R

@@ -66,8 +66,8 @@ prep_method = function(method) {
     if(length(method) == 1) {
         method <- c(method, method)
     }
-    if(any(method == "quota_largest_remainder")) {
-        stop('Cannot use "quota_largest_remainder" method, only divisor methods ',
+    if(any(method == "largest_remainder_method")) {
+        stop('Cannot use "largest_remainder_method", only divisor methods ',
              'are possible in biproportional apportionment.', call. = F)
     }
 

R/divisor-check.R

@@ -29,10 +29,12 @@ check_enough_seats = function(votes, n_seats, method) {
 }
 
 check_seats_number = function(n_seats, n_seats.name) {
-    if(length(n_seats) == 1 && !is.null(n_seats) && !is.na(n_seats) && n_seats >= 0) {
+    if(length(n_seats) == 1 && !is.null(n_seats) && !is.na(n_seats) &&
+       (n_seats %% 1 == 0) &&
+       n_seats >= 0) {
         return()
     }
-    stop("`", n_seats.name, "` must be one number >= 0", call. = F)
+    stop("`", n_seats.name, "` must be an integer >= 0", call. = F)
 }
 
 check_votes_vector = function(votes, votes.name) {

R/proporz.R

@@ -51,15 +51,15 @@ proporz_methods = list(
     "dean" = "divisor_harmonic",
     "huntington-hill" = "divisor_geometric",
     "hill-huntington" = "divisor_geometric",
-    "hare-niemeyer" = "quota_largest_remainder",
-    "hamilton" = "quota_largest_remainder",
-    "vinton" = "quota_largest_remainder",
+    "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",
-    "quota_largest_remainder" = "quota_largest_remainder",
+    "largest_remainder_method" = "largest_remainder_method",
     "divisor_floor" = "divisor_floor",
     "divisor_round" = "divisor_round",
     "divisor_ceiling" = "divisor_ceiling",

R/quota.R

@@ -1,16 +1,26 @@
 #' Largest remainder method
 #'
-#' Also known as:  Hamilton, Hare-Niemeyer, Vinton method
+#' Allocate seats based on the largest fractional remainder. The largest remainder method is
+#' also known as: Hamilton, Hare-Niemeyer or Vinton method.
+#'
+#' The numbers of votes for each party is divided by a quota representing the number of
+#' votes required for a seat. Then, each party receives the rounded down quota value as
+#' seats. The remaining seats are given to the party with the largest remainder until all
+#' seats have been distributed.
 #'
 #' @inheritParams proporz
-#' @seealso \code{\link{proporz}}
+#' @seealso [proporz()]
 #' @inherit proporz return
+#'
+#' @note Only the quota `total votes / total seats` (which is used by the aforementioned
+#'   methods) is implemented.
+#'
 #' @examples
 #' votes = c(47000, 16000, 15800, 12000, 6100, 3100)
-#' quota_largest_remainder(votes, 10)
+#' largest_remainder_method(votes, 10)
 #'
 #' @export
-quota_largest_remainder = function(votes, n_seats, quorum = 0) {
+largest_remainder_method = function(votes, n_seats, quorum = 0) {
     check_votes_vector(votes, deparse(substitute(votes)))
     check_seats_number(n_seats, deparse(substitute(n_seats)))
 
@@ -21,23 +31,37 @@ quota_largest_remainder = function(votes, n_seats, quorum = 0) {
         return(rep(0, length(votes)))
     }
 
+    # apply quorum
     votes <- apply_quorum_vector(votes, quorum)
 
-    # calculate
-    quota = n_seats*votes/sum(votes)
-    seats_base = floor(quota)
+    # get LR-quota and assign seats
+    quota = lr_quota(votes, n_seats)
+    quotas = votes / quota
+
+    seats_base = floor(quotas)
     seats_remainder = rep(0, length(votes))
 
     if(sum(seats_base) < n_seats) {
-        remainders = quota - seats_base
+        remainders = quotas - seats_base
         n_seats_remaining = n_seats - sum(seats_base)
         ordered_remainders = order(remainders, decreasing = TRUE)
         check_equal_entries(remainders, ordered_remainders, n_seats_remaining)
 
         seats_remainder[ordered_remainders[1:n_seats_remaining]] <- 1
     }
 
-    return(seats_base + seats_remainder)
+    seats = as.integer(seats_base + seats_remainder)
+
+    return(seats)
+}
+
+lr_quota = function(votes, n_seats, method = "hare") {
+    if(method %in% c("hare", "hare-niemeyer", "vinton", "simple")) {
+        quota = sum(votes)/n_seats
+    } else {
+        stop("Unknown quota method '", method, "'", call. = F)
+    }
+    return(quota)
 }
 
 check_equal_entries = function(remainders, ordered_remainders, n_seats_remaining) {

data-raw/readme_examples.R

@@ -4,7 +4,7 @@ reprex::reprex({
 
     divisor_round(votes, 10)
     divisor_floor(votes, 10)
-    quota_largest_remainder(votes, 10)
+    largest_remainder_method(votes, 10)
 })
 
 reprex::reprex({

tests/testthat/test-biproportional.R

@@ -386,8 +386,8 @@ test_that("error messages", {
     # biproportional
     expect_error_fixed(biproporz(vdf, c(1,2,3)), "`vdf` must be a matrix.")
     expect_error_fixed(biproporz(vm, c(1,2,3)), "`vm` needs to have districts as columns and parties as rows.")
-    expect_error_fixed(biproporz(vm, seats, method = "quota_largest_remainder"),
-                 'Cannot use "quota_largest_remainder" method, only divisor methods are possible in biproportional apportionment.')
+    expect_error_fixed(biproporz(vm, seats, method = "largest_remainder_method"),
+                 'Cannot use "largest_remainder_method", only divisor methods are possible in biproportional apportionment.')
     expect_error_fixed(biproporz(vm+0.1, seats), "`vm + 0.1` must only contain integers")
     expect_error_fixed(biproporz(vm, seats+0.1), "`seats + 0.1` must be integers.")
     expect_error_fixed(biproporz(vm, seats, method = c("round", "floor", "ceiling")),

tests/testthat/test-proporz.R

@@ -55,8 +55,8 @@ test_that("proporz parameter range", {
 
     # unsupported values
     for(method_impl in method_list) {
-        for(n_seats in list(NA, NULL, -1, c(1, 1))) {
-            expect_error(proporz(c(100, 10, 5), n_seats, method_impl), "`n_seats` must be one number >= 0")
+        for(n_seats in list(NA, NULL, -1, 1.1, c(1, 1))) {
+            expect_error(proporz(c(100, 10, 5), n_seats, method_impl), "`n_seats` must be an integer >= 0")
         }
     }
     for(method_impl in method_list) {
@@ -87,7 +87,7 @@ test_that("undefined result errors", {
                  "Result is undefined, equal quotient for parties: 2 & 3", fixed = T)
     expect_equal(proporz(c(1, 10, 10), 2, "round"), c(0,1,1))
 
-    expect_error(quota_largest_remainder(c(10, 10, 0), 1),
+    expect_error(largest_remainder_method(c(10, 10, 0), 1),
                  "Result is undefined, equal remainder for parties: 1 & 2",
                  fixed = TRUE)
 })

tests/testthat/test-quota.R

@@ -1,34 +1,38 @@
 # https://de.wikipedia.org/wiki/Hare-Niemeyer-Verfahren
-test_that("quota_largest_remainder", {
+test_that("largest_remainder_method", {
     v1 = c(216, 310, 22, 32)
     n1 = 60
     e1 = c(23,32,2,3)
-    expect_equal(quota_largest_remainder(v1, n1), e1)
+    expect_equal(largest_remainder_method(v1, n1), e1)
     expect_equal(proporz(v1, n1, "hare-niemeyer"), e1)
     expect_equal(proporz(v1, n1, "hamilton"), e1)
     expect_equal(proporz(v1, n1, "vinton"), e1)
 
     # https://en.wikipedia.org/wiki/Largest_remainder_method
     v2 = c(47000, 16000, 15800, 12000, 6100, 3100)
     e2 = c(5, 2, 1, 1, 1, 0)
-    expect_equal(quota_largest_remainder(v2, 10), e2)
+    expect_equal(largest_remainder_method(v2, 10), e2)
 
     # Wikipedia DE
     v3 = c(720257, 323524, 257466, 213138, 144392, 88315)
     e3 = c(13, 6, 5, 4, 2, 1)
-    expect_equal(quota_largest_remainder(v3, 31), e3)
+    expect_equal(largest_remainder_method(v3, 31), e3)
 
-    expect_error(quota_largest_remainder(numeric(), numeric()))
+    expect_error(largest_remainder_method(numeric(), numeric()))
+    expect_error(largest_remainder_method(c(10,20), 2.2), "`2.2` must be an integer >= 0")
+
+    # lr
+    expect_error(lr_quota(c(100,200), 2, "test"), "Unknown quota method 'test'")
 })
 
 test_that("equal remainder not on threshold", {
     votes = c(43, 33, 12, 8, 4)
-    expect_equal(quota_largest_remainder(votes, 10), c(4,3,1,1,1))
+    expect_equal(largest_remainder_method(votes, 10), c(4,3,1,1,1))
     expect_equal(
-        quota_largest_remainder(votes, 10, 5), c(5,3,1,1,0))
+        largest_remainder_method(votes, 10, 5), c(5,3,1,1,0))
     expect_equal(
-        quota_largest_remainder(votes, 10, quorum = 0.045), c(5,3,1,1,0))
+        largest_remainder_method(votes, 10, quorum = 0.045), c(5,3,1,1,0))
 
     # no remainders
-    expect_equal(quota_largest_remainder(c(10, 10, 0), 2), c(1,1,0))
+    expect_equal(largest_remainder_method(c(10, 10, 0), 2), c(1,1,0))
 })