allow n_seats=0, add parameter checks

DESCRIPTION

@@ -9,7 +9,7 @@ Description: Calculate seat apportionment for legislative bodies using
 License: GPL (>=3)
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.3
 Depends: 
     R (>= 3.6.0)
 Suggests:

R/divisor.R

@@ -16,10 +16,19 @@
 #'
 #' @export
 highest_averages_method = function(party_votes, n_seats, divisors) {
+	check_votes(party_votes)
+	check_n_seats(n_seats)
+	if(length(party_votes) == 1) { return(n_seats) }
+	stopifnot(all(!is.na(party_votes)))
+	if(n_seats == 0) { return(rep(0, length(party_votes))) }
+
     stopifnot(is.null(dim(divisors)))
-    if(length(divisors) == 1) divisors <- seq(from = divisors, by = 1, length.out = n_seats)
+    if(length(divisors) == 1) {
+    	divisors <- seq(from = divisors, by = 1, length.out = n_seats)
+    }
     n_parties = length(party_votes)
 
+    # method
     mtrx_votes = matrix(rep(party_votes, each=n_seats), ncol = n_parties)
     mtrx_divisors = matrix(rep(divisors, ncol(mtrx_votes)), ncol = n_parties)
 
@@ -30,6 +39,7 @@ highest_averages_method = function(party_votes, n_seats, divisors) {
     mtrx_seats[order(mtrx_quotient, decreasing = TRUE)[1:n_seats]] <- 1
 
     vec = colSums(mtrx_seats)
+    vec[is.nan(vec)] <- 0
     names(vec) <- names(party_votes)
 
     return(vec)
@@ -91,10 +101,13 @@ divisor_ceiling = function(votes, n_seats, quorum = 0) {
 #' @seealso \code{\link{proporz}}
 #' @export
 divisor_harmonic = function(votes, n_seats, quorum = 0) {
-    nn = 1:n_seats
+	check_n_seats(n_seats)
+
+    nn = seq(1, n_seats)
     divisors = 2/((1/nn)+(1/(nn-1)))
     divisors[0] <- 10e-12
     votes <- quorum_votes(votes, quorum)
+
     hzv(votes, n_seats, divisors)
 }
 
@@ -106,9 +119,12 @@ divisor_harmonic = function(votes, n_seats, quorum = 0) {
 #' @seealso \code{\link{proporz}}
 #' @export
 divisor_geometric = function(votes, n_seats, quorum = 0) {
+	check_n_seats(n_seats)
+
     nn = seq(1, n_seats)
     divisors = sqrt((nn-1)*nn)
     divisors[1] <- 10e-12
     votes <- quorum_votes(votes, quorum)
+
     hzv(votes, n_seats, divisors)
 }

R/quota.R

@@ -9,16 +9,29 @@
 #' @seealso \code{\link{proporz}}
 #' @export
 quota_largest_remainder = function(votes, n_seats, throw_equal_remainder_error = TRUE) {
+	check_n_seats(n_seats)
+	check_votes(votes)
+
+	if(length(votes) == 1) {
+		return(n_seats)
+	}
+	if(n_seats == 0) {
+		return(rep(0, length(votes)))
+	}
+
     quota = n_seats*votes/sum(votes)
     seats_base = floor(quota)
+	seats_rem = rep(0, length(votes))
 
-    remainder = quota - seats_base
-    check_equal_entries(remainder, "remainder")
+	if(sum(seats_base) < n_seats) {
+		remainder = quota - seats_base
+		check_equal_entries(remainder[remainder > 0], "remainder")
 
-    n_seats_remaining = n_seats - sum(seats_base)
-    seats_rem <- rep(0, length(votes))
-    order_index = order(remainder, decreasing = TRUE)
-    seats_rem[order_index[1:n_seats_remaining]] <- 1
+		n_seats_remaining = n_seats - sum(seats_base)
+		seats_rem <- rep(0, length(votes))
+		order_index = order(remainder, decreasing = TRUE)
+		seats_rem[order_index[1:n_seats_remaining]] <- 1
+	}
 
     return(seats_base + seats_rem)
 }

R/utils.R

@@ -7,6 +7,7 @@ check_equal_entries = function(vec, x = "value") {
 }
 
 quorum_votes = function(votes, quorum) {
+	check_votes(votes)
     stopifnot(length(quorum) == 1, is.numeric(quorum), quorum >= 0)
 
     if(quorum < 1) {
@@ -81,3 +82,27 @@ pivot_to_df = function(matrix_wide, value_colname = "values") {
     new_df[[value_colname]] <- matrix_wide[values_indices]
     return(new_df)
 }
+
+check_n_seats = function(n_seats) {
+	if(length(n_seats) == 1 && !is.null(n_seats) && !is.na(n_seats) && n_seats >= 0) {
+		return()
+	}
+	stop("n_seats must be one number >= 0")
+}
+
+check_votes = function(votes) {
+	if(is.numeric(votes) && all(!is.na(votes)) && all(votes >= 0)) {
+		return()
+	}
+	stop("votes must be numeric >= 0")
+}
+
+.sample_votes = function(n_non_zero, n_zero) {
+	repeat {
+		x = round(stats::runif(n_non_zero, 10, 1000))
+		if(length(unique(x)) == n_non_zero) {
+			break
+		}
+	}
+	return(c(x, rep(0, n_zero)))
+}

tests/testthat/test-proporz.R

@@ -1,11 +1,49 @@
 context("proporz")
 
 test_that("generic proporz", {
-    expect_equal(
-        proporz(c(216, 310, 32), 20, "jefferson"),
-        proporz(c(216, 310, 32), 20, "D'hondt"))
-    expect_equal(
-        proporz(c(216, 310, 32), 20, "Hagenbach-Bischoff"),
-        proporz(c(216, 310, 32), 20, "hare-niemeyer"))
-    expect_error(proporz(1,1, "unkown method"))
+	expect_equal(
+		proporz(c(216, 310, 32), 20, "jefferson"),
+		proporz(c(216, 310, 32), 20, "D'hondt"))
+	expect_equal(
+		proporz(c(216, 310, 32), 20, "Hagenbach-Bischoff"),
+		proporz(c(216, 310, 32), 20, "hare-niemeyer"))
+	expect_error(proporz(1,1, "unkown method"))
+})
+
+test_that("proporz parameter range", {
+	method_list = unique(unlist(apport_methods, use.names = F))
+
+	set.seed(0)
+	for(n_parties in 1:2) {
+		for(n_parties_zero in 0:2) {
+			for(n_seats in 0:6) {
+				for(method in method_list) {
+					votes = .sample_votes(n_parties, n_parties_zero)
+					seats = proporz(votes, n_seats, method)
+
+					expect_equal(length(seats), length(votes))
+					expect_equal(sum(seats), n_seats)
+				}
+			}
+		}
+	}
+
+	# unsupported values
+	for(method in method_list) {
+		for(n_seats in list(NA, NULL, -1, c(1, 1))) {
+			expect_error(proporz(c(100, 10, 5), n_seats, method), "n_seats must be one number >= 0")
+		}
+	}
+	for(method in method_list) {
+		for(votes in list(NA, NULL, -1)) {
+			expect_error(proporz(votes, 3, method), "votes must be numeric >= 0", fixed = TRUE)
+		}
+	}
+})
+
+test_that("all method names", {
+	for(m in names(apport_methods)) {
+		x = proporz(c(10, 20, 5), 3, m)
+		expect_length(x, 3)
+	}
 })

tests/testthat/test-quota.R

@@ -2,11 +2,26 @@ context("quota")
 
 # https://de.wikipedia.org/wiki/Hare-Niemeyer-Verfahren
 test_that("quota_largest_remainder", {
-    v1 = c(216, 310, 22, 32)
-    n1 = 60
-    e1 = c(23,32,2,3)
-    expect_equal(quota_largest_remainder(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)
+	v1 = c(216, 310, 22, 32)
+	n1 = 60
+	e1 = c(23,32,2,3)
+	expect_equal(quota_largest_remainder(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
+	votes2 = c(47000, 16000, 15800, 12000, 6100, 3100)
+	seats_actual2 = quota_largest_remainder(votes2, 10)
+	seats_expected2 = c(5, 2, 1, 1, 1, 0)
+	expect_equal(seats_actual2, seats_expected2)
+
+	# Wikipedia DE
+	votes3 = c(720257, 323524, 257466, 213138, 144392, 88315)
+	seats_expected3 = c(13, 6, 5, 4, 2, 1)
+	seats_actual3 = quota_largest_remainder(votes3, 31)
+	expect_equal(seats_actual3, seats_expected3)
+
+	expect_error(quota_largest_remainder(numeric(), numeric()))
 })