library(tidyverse)
library(PRcalc)
library(seatdist)
<- disproportionality
dp
<- prcalc(jp_upper_2019, m = 50, method = "dt")
obj1 <- index(obj1)
ind1 <- obj1$raw$Vote
v1 <- obj1$dist$Vote
s1
<- prcalc(us_census_2020, m = 435, method = "hh")
obj2 <- index(obj2)
ind2 <- obj2$raw$Pop
v2 <- obj2$dist$Pop s2
Comparison with other packages
Setting
Comparison
D’Hondt
{PRcalc}
"dhondt"]
ind1[## dhondt
## 1.116833
"dhondt"]
ind2[## 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}
"monroe"]
ind1[## monroe
## 0.01891832
"monroe"]
ind2[## 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}
"maxdev"]
ind1[## maxdev
## 0.01046107
"maxdev"]
ind2[## 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}
"mm_ratio"]
ind1[## mm_ratio
## Inf
"mm_ratio"]
ind2[## mm_ratio
## 1.826093
Rae
{PRcalc}
"maxdev"]
ind1[## maxdev
## 0.01046107
"maxdev"]
ind2[## 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}
"lh"]
ind1[## lh
## 0.03031546
"lh"]
ind2[## 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}
"grofman"]
ind1[## grofman
## 0.01167689
"grofman"]
ind2[## 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}
"lijphart"]
ind1[## lijphart
## 0.004068599
"lijphart"]
ind2[## 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.
<- s1[order(v1, decreasing = TRUE)]
new_s1 <- v1[order(v1, decreasing = TRUE)]
new_v1
<- new_s1 / sum(new_s1)
new_s1 <- new_v1 / sum(new_v1)
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}
"gallagher"]
ind1[## gallagher
## 0.01460875
"gallagher"]
ind2[## 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}
"gatev"]
ind1[## gatev
## 0.03293948
"gatev"]
ind2[## 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}
"ryabtsev"]
ind1[## ryabtsev
## 0.02329805
"ryabtsev"]
ind2[## 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}
"szalai"]
ind1[## szalai
## 0.5557115
"szalai"]
ind2[## 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}
"w_szalai"]
ind1[## w_szalai
## 0.09066122
"w_szalai"]
ind2[## 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}
"ap"]
ind1[## ap
## 1.042141
"ap"]
ind2[## 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}
"gini"]
ind1[## gini
## 0.03606891
"gini"]
ind2[## 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}
"sl"]
ind1[## sl
## 0.01846559
"sl"]
ind2[## 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}
"cs"]
ind1[## cs
## 1.033646
"cs"]
ind2[## 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}
"farina"]
ind1[## farina
## 0.04628158
"farina"]
ind2[## 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}
"ortona"]
ind1[## ortona
## 0.04690884
"ortona"]
ind2[## 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}
"cd"]
ind1[## cd
## 0.0008673785
"cd"]
ind2[## 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}
"rr"]
ind1[## rr
## 0.1046107
"rr"]
ind2[## 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}
"arr"]
ind1[## arr
## 0.008046973
"arr"]
ind2[## 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}
"srr"]
ind1[## srr
## 0.04148157
"srr"]
ind2[## 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}
"wdrr"]
ind1[## wdrr
## 0.05508052
"wdrr"]
ind2[## 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}
"kl"]
ind1[## kl
## 0.01643105
"kl"]
ind2[## 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}
"lr"]
ind1[## lr
## Inf
"lr"]
ind2[## 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}
"chisq"]
ind1[## chisq
## 0.004225364
"chisq"]
ind2[## 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}
"hellinger"]
ind1[## hellinger
## 0.08775774
"hellinger"]
ind2[## 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