Comparison with other packages

Setting

library(tidyverse)
library(PRcalc)
library(seatdist)

dp <- disproportionality

obj1 <- prcalc(jp_upper_2019, m = 50, method = "dt")
ind1 <- index(obj1)
v1   <- obj1$raw$Vote
s1   <- obj1$dist$Vote

obj2 <- prcalc(us_census_2020, m = 435, method = "hh")
ind2 <- index(obj2)
v2   <- obj2$raw$Pop
s2   <- obj2$dist$Pop

Comparison

D’Hondt

{PRcalc}
ind1["dhondt"]
##   dhondt 
## 1.116833
ind2["dhondt"]
##   dhondt 
## 1.402639
{seatdist}
dp(s = s1, v = v1, measure = "dhondt")$value
## [1] 1.116833
dp(s = s2, v = v2, measure = "dhondt")$value
## [1] 1.402639

Monroe

{PRcalc}
ind1["monroe"]
##     monroe 
## 0.01891832
ind2["monroe"]
##      monroe 
## 0.004537504
{seatdist}
dp(s = s1, v = v1, measure = "monroe")$value
## [1] 0.01891832
dp(s = s2, v = v2, measure = "monroe")$value
## [1] 0.004537504

Maximum absolute deviation

{PRcalc}
ind1["maxdev"]
##     maxdev 
## 0.01046107
ind2["maxdev"]
##      maxdev 
## 0.001319808
{seatdist}
dp(s = s1, v = v1, measure = "monroe")$value
## [1] 0.01891832
dp(s = s2, v = v2, measure = "monroe")$value
## [1] 0.004537504

Max-Min ratio

{PRcalc}
ind1["mm_ratio"]
## mm_ratio 
##      Inf
ind2["mm_ratio"]
## mm_ratio 
## 1.826093

Rae

{PRcalc}
ind1["maxdev"]
##     maxdev 
## 0.01046107
ind2["maxdev"]
##      maxdev 
## 0.001319808
{seatdist}
dp(s = s1, v = v1, measure = "maxdev")$value
## [1] 0.01046107
dp(s = s2, v = v2, measure = "maxdev")$value
## [1] 0.001319808

Loosemore & Hanby

{PRcalc}
ind1["lh"]
##         lh 
## 0.03031546
ind2["lh"]
##         lh 
## 0.01387072
{seatdist}
dp(s = s1, v = v1, measure = "loosemore hanby")$value
## [1] 0.03031546
dp(s = s2, v = v2, measure = "loosemore hanby")$value
## [1] 0.01387072

Grofman

{PRcalc}
ind1["grofman"]
##    grofman 
## 0.01167689
ind2["grofman"]
##     grofman 
## 0.001241881
{seatdist}
dp(s = s1, v = v1, measure = "grofman")$value
## [1] 0.01167689
dp(s = s2, v = v2, measure = "grofman")$value
## [1] 0.001241881

Lijphart

{PRcalc}
ind1["lijphart"]
##    lijphart 
## 0.004068599
ind2["lijphart"]
##     lijphart 
## 0.0003820148
{seatdist}
dp(s = s1, v = v1, measure = "lijphart")$value
##        p_13 
## 0.002475945
dp(s = s2, v = v2, measure = "lijphart")$value
##         p_50 
## 0.0004547714

Since the results for each package are different, we need to be sure we know which results are correct. Lijphart index is calculated as follow:

\[ \mbox{I}_{\mbox{Lijphart}} = \frac{|s_a - v_a| + |s_b - v_b|}{2}, \]

where \(s_a\) and \(v_a\) are the proportion of seats and votes for the party that received the largest number of votes, and \(s_b\) and \(v_b\) are that for the party that received the second largest of votes. We can compute the above equation directly.

new_s1 <- s1[order(v1, decreasing = TRUE)]
new_v1 <- v1[order(v1, decreasing = TRUE)]

new_s1 <- new_s1 / sum(new_s1)
new_v1 <- new_v1 / sum(new_v1)

new_s1
##  [1] 0.36 0.16 0.14 0.10 0.10 0.06 0.04 0.02 0.02 0.00 0.00 0.00 0.00
new_v1
##  [1] 0.353736700 0.158126102 0.130538236 0.098015356 0.089538935 0.069521178
##  [7] 0.045539306 0.020890077 0.019729213 0.005373282 0.004039727 0.003353098
## [13] 0.001598792

(abs(new_s1[1] - new_v1[1]) + abs(new_s1[2] - new_v1[2])) / 2
## [1] 0.004068599

The calculation results show that {PRcalc} is correct.

Gallagher

{PRcalc}
ind1["gallagher"]
##  gallagher 
## 0.01460875
ind2["gallagher"]
##  gallagher 
## 0.00327953
{seatdist}
dp(s = s1, v = v1, measure = "gallagher")$value
## [1] 0.01460875
dp(s = s2, v = v2, measure = "gallagher")$value
## [1] 0.00327953

Generalized Gallagher

  • Parameter \(k\) (k) is required. Default is 2.
{PRcalc}
index(obj1, k = 2)["g_gallagher"]
## g_gallagher 
##  0.01460875
index(obj2, k = 3)["g_gallagher"]
##  g_gallagher 
## 0.0008262183
{seatdist}
dp(s = s1, v = v1, k = 2, 
   measure = "kindex")$value
## [1] 0.01460875
dp(s = s2, v = v2, k = 3, 
   measure = "kindex")$value
## [1] 0.0008262183

Gatev

{PRcalc}
ind1["gatev"]
##      gatev 
## 0.03293948
ind2["gatev"]
##     gatev 
## 0.0155396
{seatdist}
dp(s = s1, v = v1, measure = "gatev")$value
## [1] 0.03293948
dp(s = s2, v = v2, measure = "gatev")$value
## [1] 0.0155396

Ryabtsev

{PRcalc}
ind1["ryabtsev"]
##   ryabtsev 
## 0.02329805
ind2["ryabtsev"]
##   ryabtsev 
## 0.01098882
{seatdist}
dp(s = s1, v = v1, measure = "ryabtsev")$value
## [1] 0.02329805
dp(s = s2, v = v2, measure = "ryabtsev")$value
## [1] 0.01098882

Szalai

{PRcalc}
ind1["szalai"]
##    szalai 
## 0.5557115
ind2["szalai"]
##     szalai 
## 0.05339091
{seatdist}
dp(s = s1, v = v1, measure = "szalai")$value
## [1] 0.5557115
dp(s = s2, v = v2, measure = "szalai")$value
## [1] 0.05339091

Weighted Szalai

{PRcalc}
ind1["w_szalai"]
##   w_szalai 
## 0.09066122
ind2["w_szalai"]
##   w_szalai 
## 0.02538329
{seatdist}
dp(s = s1, v = v1, measure = "weighted szalai")$value
## [1] 0.09066122
dp(s = s2, v = v2, measure = "weighted szalai")$value
## [1] 0.02538329

Aleskerov & Platonov

{PRcalc}
ind1["ap"]
##       ap 
## 1.042141
ind2["ap"]
##       ap 
## 1.093426
{seatdist}
dp(s = s1, v = v1, measure = "aleskerov")$value
## [1] 1.042141
dp(s = s2, v = v2, measure = "aleskerov")$value
## [1] 1.093426

Gini coefficient

{PRcalc}
ind1["gini"]
##       gini 
## 0.03606891
ind2["gini"]
##       gini 
## 0.01671634
{seatdist}
dp(s = s1, v = v1, measure = "gini")$value
## [1] 0.03606891
dp(s = s2, v = v2, measure = "gini")$value
## [1] 0.01671634

Atkinson

  • Parameter \(\eta\) (eta) is required. Defualt is 2.
{PRcalc}
index(obj1, eta = 2)["atkinson"]
## atkinson 
##        1
index(obj2, eta = 3)["atkinson"]
##    atkinson 
## 0.003623267
{seatdist}
dp(s = s1, v = v1, eta = 2, 
   measure = "atkinson")$value
## [1] 1
dp(s = s2, v = v2, eta = 3, 
   measure = "atkinson")$value
## [1] 0.003623267

Generalized entropy

See \(\alpha\)-divergence.

Sainte-Laguë

{PRcalc}
ind1["sl"]
##         sl 
## 0.01846559
ind2["sl"]
##          sl 
## 0.002747745
{seatdist}
dp(s = s1, v = v1, measure = "sainte lague")$value
## [1] 0.01846559
dp(s = s2, v = v2, measure = "sainte lague")$value
## [1] 0.002747745

Cox & Shugart

{PRcalc}
ind1["cs"]
##       cs 
## 1.033646
ind2["cs"]
##        cs 
## 0.9904007
{seatdist}
dp(s = s1, v = v1, measure = "cox shugart")$value
## [1] 1.033646
dp(s = s2, v = v2, measure = "cox shugart")$value
## [1] 0.9904007

Farina

{PRcalc}
ind1["farina"]
##     farina 
## 0.04628158
ind2["farina"]
##     farina 
## 0.02375309
{seatdist}
dp(s = s1, v = v1, measure = "farina")$value
## [1] 0.04628158
dp(s = s2, v = v2, measure = "farina")$value
## [1] 0.02375309

Ortona

{PRcalc}
ind1["ortona"]
##     ortona 
## 0.04690884
ind2["ortona"]
##     ortona 
## 0.01575384
{seatdist}
dp(s = s1, v = v1, measure = "ortona")$value
## [1] 0.04690884
dp(s = s2, v = v2, measure = "ortona")$value
## [1] 0.01575384

Cosine Dissimilarity

{PRcalc}
ind1["cd"]
##           cd 
## 0.0008673785
ind2["cd"]
##           cd 
## 0.0002284962
{seatdist}
dp(s = s1, v = v1, measure = "cosine")$value
## [1] 0.0008673785
dp(s = s2, v = v2, measure = "cosine")$value
## [1] 0.0002284962

Lebeda’s RR (Mixture D’Hondt)

{PRcalc}
ind1["rr"]
##        rr 
## 0.1046107
ind2["rr"]
##        rr 
## 0.2870583
{seatdist}
dp(s = s1, v = v1, measure = "mixture")$value
## [1] 0.1046107
dp(s = s2, v = v2, measure = "mixture")$value
## [1] 0.2870583

Lebeda’s ARR

{PRcalc}
ind1["arr"]
##         arr 
## 0.008046973
ind2["arr"]
##         arr 
## 0.005741165
{seatdist}
dp(s = s1, v = v1, measure = "arr")$value
## [1] 0.008046973
dp(s = s2, v = v2, measure = "arr")$value
## [1] 0.005741165

Lebeda’s SRR

{PRcalc}
ind1["srr"]
##        srr 
## 0.04148157
ind2["srr"]
##        srr 
## 0.06162057
{seatdist}
dp(s = s1, v = v1, measure = "srr")$value
## [1] 0.04148157
dp(s = s2, v = v2, measure = "srr")$value
## [1] 0.06162057

Lebeda’s WDRR

{PRcalc}
ind1["wdrr"]
##       wdrr 
## 0.05508052
ind2["wdrr"]
##      wdrr 
## 0.1049332
{seatdist}
dp(s = s1, v = v1, measure = "wdrr")$value
## [1] 0.05508052
dp(s = s2, v = v2, measure = "wdrr")$value
## [1] 0.1049332

Kullback-Leibler Surprise

{PRcalc}
ind1["kl"]
##         kl 
## 0.01643105
ind2["kl"]
##          kl 
## 0.001316731
{seatdist}
dp(s = s1, v = v1, measure = "surprise")$value
## [1] 0.01643105
dp(s = s2, v = v2, measure = "surprise")$value
## [1] 0.001316731

Likelihood Ratio Statistic

{PRcalc}
ind1["lr"]
##  lr 
## Inf
ind2["lr"]
##          lr 
## 0.002544105
{seatdist}
dp(s = s1, v = v1, measure = "lrstat")$value
## [1] Inf
dp(s = s2, v = v2, measure = "lrstat")$value
## [1] 0.002544105

\(\chi^2\)

{PRcalc}
ind1["chisq"]
##       chisq 
## 0.004225364
ind2["chisq"]
##       chisq 
## 0.002476612
{seatdist}
dp(s = s1, v = v1, measure = "chisq")$value
## [1] 0.004225364
dp(s = s2, v = v2, measure = "chisq")$value
## [1] 0.002476612

Hellinger Distance

{PRcalc}
ind1["hellinger"]
##  hellinger 
## 0.08775774
ind2["hellinger"]
##  hellinger 
## 0.01797873
{seatdist}
dp(s = s1, v = v1, measure = "hellinger")$value
## [1] 0.08775774
dp(s = s2, v = v2, measure = "hellinger")$value
## [1] 0.01797873

\(\alpha\)-divergence (Generalized entropy)

  • Parameter \(\alpha\) (alpha) is required. Default is 2.
  • \(\alpha\)-divergence is theoretically equivalent to generalized entropy. However, {seatdist} can only be computed for the cases where \(\alpha \neq 0, 1\)
{PRcalc}
index(obj1, alpha = 2)["ad"]
##          ad 
## 0.009232794
index(obj2, alpha = 0, as_disprop = FALSE)["ad"]
##          ad 
## 0.001272053
index(obj1, alpha = 1)["ad"]
##         ad 
## 0.01643105
index(obj2, alpha = -1, as_disprop = FALSE)["ad"]
##          ad 
## 0.001238306
index(obj1, alpha = 3)["ad"]
##         ad 
## 0.00682755
index(obj2, alpha = 0.5)["ad"]
##         ad 
## 0.00129294
{seatdist}
dp(s = s1, v = v1, alpha = 2, 
   measure = "gen entropy")$value
## [1] 0.009232794
dp(s = s2, v = v2, alpha = 0, 
   measure = "gen entropy")$value
## [1] NaN
dp(s = s1, v = v1, alpha = 1, 
   measure = "gen entropy")$value
## [1] NaN
dp(s = s2, v = v2, alpha = -1, 
   measure = "gen entropy")$value
## [1] 0.001238306
dp(s = s1, v = v1, alpha = 3, 
   measure = "gen entropy")$value
## [1] 0.00682755
dp(s = s2, v = v2, alpha = 0.5, 
   measure = "gen entropy")$value
## [1] 0.00129294

Example 1: \(D^{-1} \times 2\) is equivalent to Neyman’s \(\chi^2\) divergence.

2 * index(obj2, alpha = -1, as_disprop = FALSE)["ad"]
##          ad 
## 0.002476612
index(obj2)["chisq"]
##       chisq 
## 0.002476612

Example 2: \(D^{1}\) is equivalent to Kullback-Leibler surprise.

index(obj2, alpha = 1, as_disprop = FALSE)["ad"]
##          ad 
## 0.001316731
index(obj2)["kl"]
##          kl 
## 0.001316731

Example 3: \(\sqrt{\frac{1}{4} D^{\frac{1}{2}}}\) is equivalent to Hellinger distance.

sqrt(index(obj2, alpha = 0.5, as_disprop = FALSE)["ad"] * 0.25)
##         ad 
## 0.01797873
index(obj2)["hellinger"]
##  hellinger 
## 0.01797873