Modifying biproporz()

1) Introduction

This vignette demonstrates how to modify and extend the default implementation of biproportional apportionment in biproporz(). We cover the following modifications:

Applying a quorum to filter seat-eligible parties
Using alternative predefined apportionment methods
Implementing a custom rounding function for the lower apportionment
Altering the Winner-Take-One (WTO) method to bypass upper apportionment constraints

We’ll begin by creating a custom dataset: a matrix containing vote counts and a vector representing the number of seats per district.

library(proporz)

# Define a custom dataset for this vignette
votes_matrix = matrix(
  c( 800, 2802, 4095,  0, 150,
     3900,  814, 3990, 20,  60,
     1400, 1302, 4305, 10,  80,
     0,    0,    0, 50,   0,
     610,  500, 1001, 40, 120),
  ncol = 5, byrow = TRUE,
  dimnames = list(
    party = c("A", "B", "C", "D", "E"),
    district = c("City 1", "City 2", "City 3", "Region 4", "Region 5")
  ))

district_seats = setNames(c(5, 5, 14, 1, 1), colnames(votes_matrix))

Analyzing the Votes Matrix

In our example votes_matrix, each voter casts as many votes as there are seats in the district. To understand the party strength across districts, we calculate the number of voters per party and district by weighting the votes matrix with weight_votes_matrix():

votes_matrix
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A    800   2802   4095        0      150
#>     B   3900    814   3990       20       60
#>     C   1400   1302   4305       10       80
#>     D      0      0      0       50        0
#>     E    610    500   1001       40      120

(voters = weight_votes_matrix(votes_matrix, district_seats))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A    160  560.4  292.5        0      150
#>     B    780  162.8  285.0       20       60
#>     C    280  260.4  307.5       10       80
#>     D      0    0.0    0.0       50        0
#>     E    122  100.0   71.5       40      120

This step is performed within biproporz() with the parameter weight_votes = TRUE. The result is a matrix with fractional voter counts, as votes can be split between multiple parties.

2) Standard Biproportional Apportionment

The default biproporz() method allocates seats based on the votes matrix and district seats using standard rounding for both the upper and lower apportionments.

seats_biproporz_standard = biproporz(votes_matrix, district_seats)

# Number of seats per party
rowSums(seats_biproporz_standard)
#> A B C D E 
#> 8 9 6 0 3

Key observations from the standard apportionment:

Party D did not receive enough votes across all districts to win a seat.
In City 3, Party B receives the most seats despite having fewer total votes than two other parties.
Party E’s strongest district is City 1 (122 voters), but it does not win a seat there.

The biproporz() function returns the seat allocation as a matrix with divisors as hidden attributes (see get_divisors()). You can print the marginal sums (total seats per party and district) and divisors with summary().

summary(seats_biproporz_standard)
#>            City 1 City 2 City 3 Region 4 Region 5 (sum) (divisor)
#>          A      1      2      4        0        1     8      0.91
#>          B      3      1      5        0        0     9       0.8
#>          C      1      1      4        0        0     6         1
#>          D      0      0      0        0        0     0         1
#>          E      0      1      1        1        0     3      0.76
#>      (sum)      5      5     14        1        1    26          
#>  (divisor)   1703   1286   1008      101      324

# You can transpose the matrix
# summary(t(seats_biproporz_standard))

3) Modifying biproporz with Parameters

Applying a Quorum

A quorum can ensure that only parties with a minimum percentage or number of votes are eligible for seat allocation. In this example, we impose a 5% quorum on the total votes.

biproporz(votes_matrix, district_seats, quorum_any(total = 0.05))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A      1      2      4        0        1
#>     B      3      1      5        0        0
#>     C      1      1      4        0        0
#>     D      0      0      0        0        0
#>     E      0      1      1        1        0

This does not actually change the seat distribution compared to the standard method, as Party D is already below the “natural quorum” and did not get enough votes for any seat.

Alternative Apportionment Methods

biproporz() allows you to specify different methods for the upper and lower apportionment by passing a list to the method parameter. For example, we can use the Adams method for the upper apportionment and standard rounding for the lower apportionment.

biproporz(votes_matrix, district_seats, method = list("adams", "round"))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A      1      2      5        0        0
#>     B      3      1      4        0        0
#>     C      1      1      4        0        0
#>     D      0      0      0        1        0
#>     E      0      1      1        0        1

Custom Rounding Function

To customize seat allocation, you can define your own rounding function for the lower apportionment. Here’s a custom rounding function that works as follows:

Values below 0.7 are rounded down to 0
Values equal to or greater than 0.7 are rounded up to 1
Standard rounding applies for values greater than 1 (i.e. values below .5 are rounded down)

custom_rounding_func = function(x) {
  stopifnot(all(x >= 0))
  lt0.7 = x < 0.7
  x[lt0.7] <- 0
  x[!lt0.7] <- ceil_at(x[!lt0.7], 0.5)
  x
}

# The function must work with a matrix
custom_rounding_func(matrix(c(0.5, 0.6, 1.5, 2.5), 2))
#>      [,1] [,2]
#> [1,]    0    2
#> [2,]    0    3

# Apply custom rounding function in lower apportionment
biproporz(votes_matrix, district_seats, 
          method = list("adams", custom_rounding_func))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A      0      3      5        0        0
#>     B      3      1      4        0        0
#>     C      1      1      4        0        0
#>     D      0      0      0        1        0
#>     E      1      0      1        0        1

Compared to using standard rounding, parties A and E swap one seat in cities 1 and 2.

4) District Winner Methods

Winner-Take-One (WTO)

The WTO method guarantees that the party with the most votes in each district will receive at least one seat, given that the party is eligible for a seat from the upper apportionment. These two constraints may lead to conflicts and an error, as seen below.

try(biproporz(votes_matrix, district_seats, method = "wto"))
#> Error : Not enough upper apportionment seats to give district winner seats to party: 'D'

Party D has the most votes in Region 4 and should get a seat there but there’s no party seat to allocate. To prevent this case, a quorum is usually applied to ensure that only large enough parties are eligible for seats.

biproporz(votes_matrix, district_seats, method = "wto",
          quorum = quorum_any(total = 0.01))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A      1      2      4        0        1
#>     B      3      1      5        0        0
#>     C      1      1      4        0        0
#>     D      0      0      0        0        0
#>     E      0      1      1        1        0

WTO with an Alternative Upper Apportionment Method

By switching to the Adams method for the upper apportionment, Party D gets one seat (as we’ve already seen). This resolves the conflict, allowing WTO to work in the lower apportionment.

biproporz(votes_matrix, district_seats, method = list("adams", "wto"))
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A      0      2      5        0        1
#>     B      3      1      4        0        0
#>     C      1      1      4        0        0
#>     D      0      0      0        1        0
#>     E      1      1      1        0        0

WTO with Ties

If two parties have the same number of votes in a district (and there’s not enough seats for both), there is no clear district winner and the WTO condition is not applied in this district. biproporz issues a warning in this case, as seen in this example:

(tied_votes = matrix(
  c(1000, 500, 150, 150), 2, 
  dimnames = list(party = c("X", "Y"), district = 1:2)))
#>      district
#> party    1   2
#>     X 1000 150
#>     Y  500 150
tied_votes_seats = setNames(c(2,1), colnames(tied_votes))

try(biproporz(tied_votes, tied_votes_seats, method = "wto"))
#> Warning: Not enough seats for tied parties with the most votes in: '2'
#> Winner take one condition is not applied in this district.
#>      district
#> party 1 2
#>     X 1 1
#>     Y 1 0

When WTO is suspended in district 2, tied party Y gets a seat in district 1 as this distribution better satisfies the constraints given by the upper apportionment. To explicitly break the tie (which might be necessary depending on the actual specifications) you need to modify the votes matrix by adding a very small vote amount to the district winner. Here is a workflow to break ties randomly:

tied_districts = district_winner_matrix(tied_votes, tied_votes_seats)
set.seed(4)
for(d in seq_len(ncol(tied_votes))) {
  if(anyNA(tied_districts[,d])) {
    tied_parties = which(is.na(tied_districts[,d]))
    
    # break tie randomly
    tiebreak_winner = sample(tied_parties, 1)
    cat("party", names(tiebreak_winner), "wins district", d)
    
    # assuming the impact of a small vote difference on 
    # the overall result is negligible
    tied_votes[tiebreak_winner,d] <- tied_votes[tiebreak_winner,d]+1e-9
  }
}
#> party Y wins district 2

biproporz(tied_votes, tied_votes_seats, method = "wto")
#>      district
#> party 1 2
#>     X 2 0
#>     Y 0 1

As you can see, party Y now has a seat in district 2 as they won the tiebreaker. This means in turn that party X must get both seats in district 1.

Guaranteeing District Winners a Seat

You can modify the WTO method to ensure district winners always get a seat, even if they don’t meet the upper apportionment criteria. Below is a custom function that implements this approach. This is a non-standard approach and the function should be adapted as needed.

biproporz_absolute_wto = function(votes_matrix, district_seats,
                                  quorum = NULL, weight_votes = TRUE) {
  # 1) Identify unambiguous district winners
  # Note: This step could also happen after the quorum has been applied
  # (depending on the desired method implementation)
  district_winners = district_winner_matrix(votes_matrix, district_seats)
  district_winners[is.na(district_winners)] <- FALSE # Ignore ties
  
  # 2) Apply quorum if specified
  if(!is.null(quorum)) {
    votes_matrix <- apply_quorum(votes_matrix, quorum)
  }
  
  # 3) Assign party seats in upper apportionment
  ua = upper_apportionment(votes_matrix, district_seats, 
                           weight_votes, method = "round")
  
  # 4.1) Assign seats to district winners without 
  # enough upper apportionment seats
  seats_without_ua = district_winners * 1L
  seats_without_ua[rowSums(district_winners) <= ua$party, ] <- 0L
  
  # 4.2) Biproportional apportionment for remaining seats
  # Build votes matrix, set votes for district winners 
  # without enough upper apportionment seats to zero
  biprop_votes_matrix = votes_matrix
  biprop_votes_matrix[seats_without_ua > 0] <- 0
  
  # Reduce the number of seats for districts that 
  # already had a "insufficient district winner" seat assigned
  biprop_district_seats = district_seats - colSums(seats_without_ua)
  
  # Run biproporz
  seats_biproporz = biproporz(biprop_votes_matrix, 
                              biprop_district_seats, 
                              method = "wto")
  
  # Remove divisor attributes, as they're no longer 
  # meaningful for the combined distribution
  seats_biproporz <- as.matrix(seats_biproporz)
  
  # 5) Return final seat distribution,
  #    combining the two apportionments 
  return(seats_biproporz + seats_without_ua)
}

Let’s compare the standard biproportional apportionment to the modified method, which guarantees district winners a seat.

seats_biproporz_absolute_wto = biproporz_absolute_wto(votes_matrix, 
                                                      district_seats)

# Show the difference to the standard apportionment
seats_biproporz_absolute_wto - seats_biproporz_standard
#>      district
#> party City 1 City 2 City 3 Region 4 Region 5
#>     A     -1      0      1        0        0
#>     B      0      0     -1        0        0
#>     C      0      0      0        0        0
#>     D      0      0      0        1        0
#>     E      1      0      0       -1        0

In this example, Party D gains a seat from Party B. To satisfy the new constraints, there are changes in district seat distributions for Party A and Party E.

Note that while this method resolves possible conflicts for district winners without upper apportionment seats, other conflicts might arise. For example, if too many district winners are missing upper apportionment seats, the constraints for allocating the remaining seats may become overly restrictive.