chiark / gitweb /
compute-scottish-stv: wip
[appendix-a6.git] / 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