Equal Proportions

This Mathematica notebook is licensed under a MouseOver . It is discussed in the post Apportionment I. I hope anyone interested will feel free to improve this work and to use it in their own publications and coursework. --Charles Wells

Data

zlist:={0,0,0,0,0}

onelist:={1,1,1,1,1}

example1prelist:={5567,7775,4435,7800,3000}

example2prelist:={9567,7633,6112,2003,1598}

epsetup[l_]:=Transpose[{Range[5],l,zlist,l}]

(#/Sqrt[2]//N)&/@example1prelist

sepsetup[l_]:=Transpose[{Range[5],l,onelist,(#/Sqrt[2]//N)&/@l}]

(#/Sqrt[2]//N)&/@example1prelist

lst1:=epsetup[example1prelist]

lst1

(*first coord is position,second coord is number of seats already assigned, third cooord is number of votes*)

lst2:=epsetup[example2prelist]

lst2

slst1:=sepsetup[example1prelist]

slst1

Initial definitions

(*the list l below must be manufactured by startlist*)

singleout[l_]:=Select[l,#[[4]]==Max[l[[All,4]]]&,1][[1]]

singleout[lst1]

epwt[p_,n_]:=If[n==0,p,p/Sqrt[n(n+1)]//N]

epwt[7800,#]&/@Range[0,5]

epchangeone[item_]:={item[[1]],item[[2]],item[[3]]+1,epwt[item[[2]],item[[3]]+1]}

epchangeone[{4,7800,0,7800}]

pickit[l_]:=epchangeone[singleout[l]]

pickit[lst1]

update[l_]:=Module[{li=ReplacePart[l,pickit[l][[1]]->pickit[l]]},Return[li]]

update[lst1]

update[%]

epapport[l_,seats_]:=NestWhile[update,l,1,seats+1]

epapport[lst1,0]

epapport[lst1,1]

epapport[lst1,20]

epapport[lst2,20]

totvotes[l_]:=Plus@@l[[All,2]]

eptotvotes[list_,seats_]:=Plus@@epapport[list,seats][[All,2]]

quota[l_,seats_]:=totvotes[l]/seats//N

squota[l_,seats_]:=If[seats==0,"no quota",totvotes[l]/seats//N]

uquota[l_,seats_]:=If[seats==0,1,totvotes[l]/seats//N]

totvotes[l_]:=Plus@@l[[All,2]]

weight[l_,n_,seats_]:=If[seats==0,"no weight",l[[n]][[2]]/squota[l,seats]]

ideal[l_,seats_]:=Module[{q=squota[l,seats],app=epapport[l,seats]},#[[2]]/q&/@app]

ideal[lst1,18]

lst1[[2]][[2]]

7775/4.8973

{squota[lst1,18],lst1[[2]][[2]]/ideal[lst1,18][[2]]}

preseats[l_,seats_]:=Floor /@ideal[l,seats]

preseats[lst1,18]

safeprs[n_]:=If[n==0,1,Sqrt[n]]

means[l_,seats_]:=Module[{votes=#[[2]]&/@l,prs=safeprs/@preseats[l,seats]//N,pplus=Sqrt/@(1+#&/@preseats[l,seats])//N},
If[seats==0,votes,votes/(prs *pplus)]]

means[lst1,0]

means[lst1,1]

means[lst1,18]

epapport[lst1,18]//TableForm

actualrep[list_,seats_]:=Module[{eap=epapport[list,seats]},If[eap[[#]][[3]]==0,0,(eap[[#]][[2]]/eap[[#]][[3]]//N)]&/@Transpose[eap][[1]]]

actualrep[lst1,9]

actualrep[lst1,18]

actualrep[lst1,18]/squota[lst1,18]

compratio[list_,seats_]:=Module[{eap=epapport[list,seats],s=squota[list,seats]},actualrep[list,seats]/s]

compratio[lst1,18]

compratio[lst1,9]

Presentation

preshow[list_,seats_]:=Module[{q=uquota[list,seats],p=preseats[list,seats],m=means[list,seats], t=eptotvotes[list,seats],a=actualrep[list,seats],c=compratio[list,seats]},Join[{#[[1]],#[[2]],#[[3]],#[[4]],If[q=="no quota","no quota", #[[2]]/q]}&/@epapport[list,seats],Transpose[{p,m,a,c}],2]]

preshow[lst1,18]

preshow[lst1,9]

arrangesimple[list_,seats_]:={#[[1]],#[[2]],#[[3]],#[[4]]}&/@preshow[list,seats]

arrangesimple[lst1,18]

arrangecomparison[list_,seats_]:={#[[1]],#[[2]],#[[3]],#[[5]],#[[8]],#[[9]]}&/@preshow[list,seats]

arrangecomparison[lst1,18]

arrangecomparison[lst1,9]

TableForm[%]

bfformatlist[list_]:=Map[Style[#,Bold,FontFamily->"Arial"]&,list,{2}]

bfformathead[l_]:=Style[#,Bold,FontFamily->"Arial"]&/@l

myf[string_]:=Style[string,Bold,FontFamily->"Arial"]

showsimple[list_,seats_]:=Column[{"Total votes = "<>ToString[eptotvotes[list,seats]]<>"  "<>"Seats = "<>ToString[seats]<>"  "<>"Quota = "<>ToString[squota[list,seats]]//myf,TableForm[bfformatlist[arrangesimple[list,seats]],TableHeadings->{None,bfformathead[{"Name","Votes","SeatsAsgd","Weight"}]}]}]

showsimple[lst1,18]

showsimple[lst1,5]

showsimple[lst1,0]

This is PartySimple.cdf

Manipulate[
DynamicModule[
{list},
Dynamic[
list=epsetup[{n1,n2,n3,n4,n5}];
showsimple[list,seats]
]
],
{{n1,8234},0,10000,1},
{{n2,7001},0,10000,1},
{{n3,5503},0,10000,1},
{{n4,4356},0,10000,1},
{{n5,2390},0,10000,1},
{{seats,10},0,100,1,Appearance->"Open"},
Paneled->False,SaveDefinitions->True
]

showcomparisons[list_,seats_]:=Column[{"Total votes = "<>ToString[eptotvotes[list,seats]]<>"          "<>"Seats = "<>ToString[seats]<>"          "<>"Quota = "<>ToString[squota[list,seats]]//myf,TableForm[bfformatlist[arrangecomparison[list,seats]],TableHeadings->{None,bfformathead[{"Name","Votes","SeatsAsgd","SeatsIdeal","VotesPerSeat","Deviation"}]}]}]

showcomparisons[lst1,0]

This is PartyComparison.cdf

Manipulate[
DynamicModule[
{list},
Dynamic[
list=epsetup[{n1,n2,n3,n4,n5}];
showcomparisons[list,seats]
]
],
{{n1,8234},0,10000,1},
{{n2,7001},0,10000,1},
{{n3,5503},0,10000,1},
{{n4,4356},0,10000,1},
{{n5,2390},0,10000,1},
{{seats,10},0,100,1,Appearance->"Open"},
Paneled->False,SaveDefinitions->True
]