> |
ElectoralCollege := Matrix(51, 2, [
|
> |
Alabama, 9, Kentucky, 8, North_Dakota, 3,
|
> |
Alaska, 3, Louisiana, 8, Ohio, 18,
|
> |
Arizona, 11, Maine, 4, Oklahoma, 7,
|
> |
Arkansas, 6, Maryland, 10, Oregon, 7,
|
> |
California, 55, Massachusetts, 11, Pennsylvania, 20,
|
> |
Colorado, 9, Michigan, 16, Rhode_Island, 4,
|
> |
Connecticut, 7, Minnesota, 10, South_Carolina, 9,
|
> |
Delaware, 3, Mississippi, 6, South_Dakota, 3,
|
> |
District_of_Columbia, 3, Missouri, 10, Tennessee, 11,
|
> |
Florida, 29, Montana, 3, Texas, 38,
|
> |
Georgia, 16, Nebraska, 5, Utah, 6,
|
> |
Hawaii, 4, Nevada, 6, Vermont, 3,
|
> |
Idaho, 4, New_Hampshire, 4, Virginia, 13,
|
> |
Illinois, 20, New_Jersey, 14, Washington, 12,
|
> |
Indiana, 11, New_Mexico, 5, West_Virginia, 5,
|
> |
Iowa, 6, New_York, 29, Wisconsin, 10,
|
> |
Kansas, 6, North_Carolina, 15, Wyoming, 3
]):
|

|
(1) |
> |
add(ElectoralCollege[..,2]):
tie := %/2;
|

|
(2) |
> |
ec := convert(ElectoralCollege, listlist):
|
> |
# Sets of states that form an electoral college tie
R := 10^5:
nbties := 0:
states := NULL:
for r from 1 to R do
poll := combinat:-randperm(ec):
cpoll := CumulativeSum(op~(2, poll)):
if tie in cpoll then
nbties := nbties+1;
place := ListTools:-Search(tie, cpoll);
states := states, op~(1, poll)[1..place]: # see below
end if:
end do:
|
> |
# electoral college tie is not so rare an event
# (prob of occurrence about 9.4 %).
#
# Why the hell the US constitution did not decide to have an odd
# number or electors to avoid ths kind of situation instead of
# introducing a complex mechanism when tie appears????
nbties;
evalf(nbties/R);
states := [states]:
|

|
(3) |
> |
# What states participate to the tie?
names := sort(ElectoralCollege[..,1]):
all_states_in_ties := [op(op~(states))]:
howoften := Vector(
51,
i -> ListTools:-Occurrences(names[i], all_states_in_ties)
):
ScatterPlot(Vector(51, i->i), howoften);
|
> |
# All the states seem to appear equally likely in an electoral college tie.
# Why? Does someone have a guess?
#
# The reason is obvious, as each state must appear in the basket of a candidate,
# then in case of a tie each state is either in op~(1, poll)[1..place] (candidate 1)
# or either in op~(1, poll)[place+1..51] (candidate 2);
# So, as we obtained 9397 ties, each states appears exactly 9397 times (with
# different occurences in the baskets of candidate 1 and 2).
|
> |
# Lengths of the configurations that lead to a tie.
#
# Pleas refer to the answer above to understand why Histogram(lengths) should be
# symmetric.
lengths := map(i -> numelems(states[i]), [$1..nbties]):
sort(Tally(lengths))
|
![[14 = 1, 15 = 2, 16 = 7, 17 = 36, 18 = 78, 19 = 179, 20 = 341, 21 = 507, 22 = 652, 23 = 849, 24 = 1015, 25 = 1041, 26 = 1056, 27 = 997, 28 = 862, 29 = 657, 30 = 515, 31 = 300, 32 = 158, 33 = 95, 34 = 41, 35 = 6, 36 = 2]](/view.aspx?sf=213592_post/5db78e6502fd070b9a07d277de4930f4.gif)
|
(4) |
> |
Histogram(lengths, range=min(lengths)..max(lengths), discrete=true)
|
> |
ShortestConfigurations := map(i -> if lengths[i]=min(lengths) then states[i] end if, [$1..nbties]):
print~(ShortestConfigurations):
|
![[New_York, Wisconsin, Illinois, Kentucky, Florida, New_Jersey, Mississippi, Indiana, Virginia, Maryland, California, Massachusetts, North_Carolina, Texas]](/view.aspx?sf=213592_post/d152f6c71da340d61946a425bcb92471.gif)
|
(5) |
> |
LargestConfigurations := map(i -> if lengths[i]=max(lengths) then states[i] end if, [$1..nbties]):
print~(LargestConfigurations):
|
![[West_Virginia, Maryland, Massachusetts, Colorado, South_Dakota, Kentucky, Kansas, Wyoming, North_Dakota, Indiana, Michigan, Utah, Louisiana, Ohio, Alabama, Nebraska, Connecticut, Illinois, Oklahoma, Alaska, New_Jersey, District_of_Columbia, Oregon, Nevada, Missouri, Delaware, Washington, New_Hampshire, Arizona, Maine, South_Carolina, Hawaii, Vermont, Montana, Rhode_Island, Idaho]](/view.aspx?sf=213592_post/26444a03460cf94ed347c7f8903d9f18.gif)
|
(6) |
> |
# What could be the largest composition of a basket in case of a tie?
# (shortest composition is the complementary of the largest one)
ecs := sort(ec, key=(x-> x[2]));
csecs := CumulativeSum(op~(2, ecs)):
# Where would the break locate?
tieloc := ListTools:-BinaryPlace(csecs, tie);
csecs[tieloc..tieloc+1]
|

|
(7) |
> |
# This 40 states coniguration is not a tie.
#
# But list all the states in basket of candidate 1 and look to the 41th state (which is
# in the basket of candidate 2)
ecs[1..tieloc];
print():
ecs[tieloc+1]
|
![[New_Jersey, 14]](/view.aspx?sf=213592_post/66a3a2676b3b04dc8d857a32df4e358b.gif)
|
(8) |
> |
# It appears that exchanging Virginia and New_Jersey increases by 1 unit the college of candidate 1
# and produces a tie.
LargestBasketEver := [ ecs[1..tieloc-1][], ecs[tieloc+1] ];
add(op~(2, LargestBasketEver))
|

|
(9) |
> |
# The largest electoral college tie contains 40 states (the shortest 11)
|
|