compute-scottish-stv

   1 #!/usr/bin/perl -w
   2
   3 # Reference:
   4 # The Scottish Local Government Elections Order 2007
   5
   6 use strict;
   7
   8 # Data structures:
   9 #
  10 # vote is
  11 #   { Voter => opaque,
  12 #     Prefs => [ list ],
  13 #     Weight => 1.0 }
  14 # We edit Prefs as we go
  15
  16 # $cands{CAND}{Desc}
  17 # $cands{CAND}{Votes}
  18
  19 our $stage=0;
  20
  21 our $seats=0;
  22
  23 sub unkopt ($$) {
  24     my ($what,$opt) = @_;
  25     if ($opt =~ m/^[A-Z]/) {
  26         die "unknown option $_ for $what";
  27     } elsif ($opt =~ m/^[a-z]/) {
  28         print STDERR "warning (line $.): unknown option $_ for $what\n";
  29     }
  30 }
  31
  32 for (;;) {
  33     $_ = <>;
  34     if (m/^\| /) {
  35         foreach $_ (split / /, $') {
  36             if (m/^_?[Ss]eats=(\d+)/) {
  37                 $seats = $1;
  38             } else {
  39                 unkopt "election", $_;
  40             }
  41         }
  42     } elsif (m/^(\w+) = (\S*) \|/) {
  43         my ($cand,$desc) = @_;
  44         unkopt "candidate $cand", $_ foreach split / /, $';
  45         $cands{$cand}{Desc} = $desc;
  46     } elsif (m/^(\w*) :\s*(.*)\s*\|(.*)/) {
  47         my ($voter,$prefs,$opts) = ($1,$2,$3);
  48         $v = { Voter => $voter };
  49         push @{ $v->{Prefs} }, [ $_ =~ m/\w+/g ]
  50             foreach split /\s+/, $prefs;
  51         foreach $_ (split / /, $opts) {
  52             if (m/^_?[Ww]eight=(\d+)/(\d+)$/) {
  53                 $v->{Weight} = $1 / $2;
  54             } elsif (m/^_?[Ww]eight=([0-9.]+)$/) {
  55                 $v->{Weight} = new Math::BigRat $1;
  56             } else {
  57                 unkopt "voter $v->{Voter}", $_;
  58             }
  59         }
  60         push @allvotes, $v;
  61     } elsif (m/^\.$/) {
  62         last;
  63     } else {
  64         die "$_ ?";
  65     }
  66 }
  67
  68 sub sortballots (@) {
  69     # Takes each argument, which should be a ballot, sorts
  70     # it into $cand{CAND}{Votes} according to first preference.
  71     # Strips that first preference from the ballot.
  72     # If the first preference has been eliminated, strips it
  73     # and looks for further preferences.
  74     foreach my $v (@_) {
  75         my $firstprefs = shift @{ $v->{Prefs} };
  76         if (!$firstprefs || !@$firstprefs) {
  77             vlog $v, "no more preferences, non transferable";
  78             push @non_transferable, $v;
  79             next;
  80         }
  81         if (@$firstprefs > 1) {
  82             vlog $v, "splitting due to several equal first preferences";
  83             foreach my $fpref (@$firstprefs) {
  84                 my $v2 = {
  85                     %$v,
  86                     Weight => $v->{Weight} / @$firstprefs,
  87                     Prefs => [ [ $fpref ], @{ $v->{Prefs} } ],
  88                          };
  89                 vlog $v, "split for $fpref";
  90
  91
  92                     Voter => $
  93
  94         my @prefs
  95         my $nprefs = scalar @{ $v->{Prefs}
  96     my @input = @_;
  97
  98
  99 # $cands
 100
 101 for (;;) {
 102