Version 2 of Imperiali

Updated 2006-09-29 06:08:50

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 Bereken -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:

http://geocities.com/jos_decoster/images/imperiali1.jpg

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

http://geocities.com/jos_decoster/images/imperiali2.jpg