Imperiali

Calculate number of seats per party using the 'Imperiali' system as used in Flanders (Belgium) for local elections.

Each party gets a vote count. This vote count is the number of votes for the party. This count includes:

Votes for the party only
Votes for the party and one or more individuals of the same party
Votes for one or more individuals of the same party

Each of the above counts as '1' in the vote count.

To calculate the seats, all vote counts are divide by 2, 3, 4, 5, 6, ... These division results are sorted high to low and seats are allocated according to this sorted list. When allocating the last seat and the division results are equal for two or more parties, the party with the largest vote count gets the seat. When the vote count is also equal, the candidate with the most individual votes gets the seat. If they have the same number of individual votes, the oldest candidate gets the seat. These last two rules are not implemented in this script. When not sure which party gets the seat, the seats still to be decide are colored orange. Allocated seats are colored green.

 # List of parties
 set partl {a b g h k}

 # Maximum number of candiates per party, also number of seats to be chosen
 set kandmax 17

 # Number of candidates per party
 set kandl(a) 17
 set kandl(b) 17
 set kandl(g) 17
 set kandl(h) 1
 set kandl(k) 17

 ###############################################################################
 # Make no changes below this line
 ###############################################################################

 set f [frame .f]
 pack $f -fill both -expand true

 set col 0
 set row 0

 # Naan van partijen
 incr row

 set l1 [label $f.lstemc -text "Vote count"]
 grid $l1 -column $col -row $row
 incr row

 for { set i 0 } { $i < $kandmax } { incr i } {
     set l [label $f.lkand$i -text $i]
     grid $l -column $col -row $row
     incr row
 }

 set row 0
 incr col

 foreach part $partl {
     set l0 [label $f.l$part -text $part -bd 1 -relief raised]
     grid $l0 -column $col -row $row -sticky ewns
     incr row

     set stemcijfer($part) 0
     set e1 [entry $f.esc$part -textvariable stemcijfer($part) -width 10 -justify right]
     grid $e1 -column $col -row $row -sticky ewns
     incr row

     for { set i 0 } { $i < $kandl($part) && $i < $kandmax } { incr i } {
         set quotienteff($part,$i) 0
         set quotient($part,$i) 0
         set l [label $f.quot$part$i -textvariable quotient($part,$i) -width 14 -anchor e \
                    -justify right -bd 1 -relief raised]
         grid $l -column $col -row $row -sticky ewns
         incr row
     }

     set row 0
     incr col 2
 }

 set b [button .b -text Calculate -command bereken]
 pack $b

 proc sort_qe_sc { a b } {
     foreach {aqe asc apart ai} $a { break }
     foreach {bqe bsc bpart bi} $b { break }
     if { ($aqe < $bqe) || ($aqe == $bqe && $asc < $bsc) } {
         return -1
     } elseif { $aqe == $bqe && $asc == $bsc } {
         return 0
     } else {
         return 1
     }
 }

 proc bereken { } {
     global partl kandmax kandl stemcijfer lijst voorkeur quotient f

     set ql {}

     foreach part $partl {
         set div 2
         for { set i 0 } { $i < $kandl($part) } { incr i } {
             set quotienteff($part,$i) [expr {double($stemcijfer($part)) / $div}]
             set quotient($part,$i) [format "%7.4f" $quotienteff($part,$i)]
             $f.quot$part$i configure -bg gray50
             lappend ql [list $quotienteff($part,$i) $stemcijfer($part) $part $i]
             incr div
         }
     }

     set ql [lsort -decreasing -command sort_qe_sc $ql]

     # Zoek zelfde quotient rond kandmax-de plaats
     set qsc [lindex $ql [expr {$kandmax - 1}]]
     foreach {mqe msc mpart mi} $qsc { break }

     set qscl {}

     set cnt 0
     foreach q $ql {
         foreach {qe sc part i} $q { break }
         if { $qe > $mqe || $qe == $mqe && $sc > $msc } {
             $f.quot$part$i configure -bg green
             set quotient($part,$i) "$quotient($part,$i) ([expr {$cnt + 1}])"
             incr cnt
         } elseif { $qe == $mqe && $sc == $msc } {
             lappend qscl [list $qe $sc $part $i]
         }
     }

     if { [llength $qscl] == [expr {$kandmax - $cnt}] } {
         foreach q $qscl {
             foreach {qe sc part i} $q { break }
             $f.quot$part$i configure -bg green
             set quotient($part,$i) "$quotient($part,$i) ([expr {$cnt + 1}])"
             incr cnt
         }
     } else {
         foreach q $qscl {
             foreach {qe sc part i} $q { break }
             $f.quot$part$i configure -bg orange
             set quotient($part,$i) "$quotient($part,$i)"
         }
     }

     return
 }

This is an example when all seats can be allocated:

In this example, the last seats still needs to be assigned using the individual vote count or age of the candidates:

Relevant Wikipedia article: http://en.wikipedia.org/wiki/Highest_averages_method

Category Application