chiark / gitweb /
openstvoutput24compare: wip, fixes
[appendix-a6.git] / openstvoutput24compare
1 #!/usr/bin/perl -w
2
3 use strict;
4
5 our $nboxcols;
6 our @boxheads;
7
8 sub parseheader () {
9     my $cboxrow = 0;
10
11     while (<>) {
12         last if m/^==/;
13         next unless m/^ R/..0;
14
15         if (m/^\s+\|[-+]+\s*$/) {
16             $cboxrow++;
17             next;
18         }
19         s/\n$//;
20         if (m/^\s+[R ]\|/) {
21             my @entries = split /\|/, $';
22             $nboxcols ||= @entries;
23             $nboxcols >= @entries or die;
24             foreach my $cboxcol (0..$#entries) {
25                 my $headix = $cboxcol + $cboxrow * $nboxcols;
26                 $boxheads[$headix] //= '';
27                 $boxheads[$headix] .= $entries[$cboxcol];
28             }
29         }
30     }
31
32     s/\s+$// foreach @boxheads;
33
34     my @specials = qw(Exhausted Surplus Threshold);
35     foreach my $si (0..$#specials) {
36         my $hi = @boxheads - @specials + $si;
37         die "$si $hi $boxheads[$hi] ?" unless $boxheads[$hi] eq $specials[$si];
38         $boxheads[$hi] .= " "; # disambiguates
39     }
40 }
41
42 sub processbody () {
43     my $cboxrow = 0;
44     my %vals;
45     my $donequota = 'X';
46     while (<>) {
47         s/\n$//;
48         if (m/^\s+\|--/) {
49             if ($cboxrow >= 0) {
50                 die unless $cboxrow;
51                 die unless (scalar keys %vals) == @boxheads;
52                 foreach my $k (sort grep { !m/ $/ } keys %vals) {
53                     my $e = $vals{$k};
54                     next unless length $e;
55                     printf " candidate %-10s : %20s votes\n",
56                         $k, $e
57                         or die $!;
58                 }
59                 my $quota = $vals{'Threshold '};
60                 if ($donequota ne $quota) {
61                     printf " quota   %10s\n", $quota;
62                     $donequota = $quota;
63                 }
64                 my $surplus = $vals{'Surplus '};
65                 if ($surplus ne '0') {
66                     printf " surplus %10s\n", $surplus;
67                 }
68             }
69             $cboxrow = -1;
70             next;
71         }
72         if (m/^==/) {
73             $cboxrow = 0;
74             %vals = ();
75             next;
76         }
77         if (m/^\s*(\d*)\|/) {
78             next unless $cboxrow >= 0;
79             die "$cboxrow $1" unless !$cboxrow == !!length $1;
80             if (length $1) {
81                 printf "stage %d:\n", $1 or die $!;
82             }
83             my @entries = split /\|/, $';
84             $nboxcols >= @entries or die;
85             foreach my $cboxcol (0..$#entries) {
86                 my $headix = $cboxcol + $cboxrow * $nboxcols;
87                 my $h = $boxheads[$headix];
88                 defined $h or die;
89                 die if exists $vals{$h};
90                 my $e = $entries[$cboxcol];
91                 $e =~ s/^\s+//;
92                 if (length $e) {
93                     $e =~ m/^\d*\.\d*$/ or die;
94                     $e =~ m/\d/ or die;
95                     $e =~ s/\.0+$//;
96                 }
97                 $vals{$h} = $e;
98             }
99             $cboxrow++;
100             next;
101         }
102         if (!m/\S/) {
103             last;
104         }
105         die;
106     }
107 }
108
109 sub processfinal () {
110     while (<>) {
111         s/\n$//;
112         if (s/^Winners are //) {
113             s/\.$//;
114             my @w = split /\, /;
115             if (@w == 1) {
116                 @w = split / and /, $w[0];
117             } else {
118                 $w[$#w] =~ s/^and //;
119             }
120             print "Winners:\n";
121             @w = sort @w;
122             foreach my $i (0..$#w) {
123                 printf "  %s\n", $w[$i];
124             }
125             print "done.\n";
126         }
127     }
128 }
129
130 parseheader();
131 processbody();
132 processfinal();