chiark / gitweb /
be52f7ac3c4e60b2de94541fa69b85288fea75f3
[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         if (m/^\s+[R ]\|/) {
20             my @entries = split /\|/, $';
21             $nboxcols ||= @entries;
22             $nboxcols >= @entries or die;
23             foreach my $cboxcol (0..$#entries) {
24                 my $headix = $cboxcol + $cboxrow * $nboxcols;
25                 $boxheads[$headix] //= '';
26                 $boxheads[$headix] .= $entries[$cboxcol];
27             }
28         }
29     }
30
31     s/\s+$// foreach @boxheads;
32
33     my @specials = qw(Exhausted Surplus Threshold);
34     foreach my $si (0..$#specials) {
35         my $hi = @boxheads - @specials + $si;
36         die "$si $hi $boxheads[$hi] ?" unless $boxheads[$hi] eq $specials[$si];
37         $boxheads[$hi] .= " "; # disambiguates
38     }
39 }
40
41 sub processbody () {
42     my $cboxrow = 0;
43     my %vals;
44     my $donequota = 'X';
45     while (<>) {
46         if (m/^\s+\|--/) {
47             if ($cboxrow >= 0) {
48                 die unless $cboxrow;
49                 die unless (scalar keys %vals) == @boxheads;
50                 foreach my $k (sort grep { m/\S/ } keys %vals) {
51                     print " candidate %10s : %20s votes\n" or die $!;
52                 }
53                 my $quota = $vals{'Threshold '};
54                 if ($donequota ne $quota) {
55                     print " quota %10d\n", $quota;
56                     $donequota = $quota;
57                 }
58                 my $surplus = $vals{'Surplus '};
59                 if ($surplus ne '0') {
60                     print " surplus %10d\n", $surplus;
61                 }
62             }
63             $cboxrow = -1;
64             next;
65         }
66         if (m/^==/) {
67             $cboxrow = 0;
68             %vals = ();
69             next;
70         }
71         if (m/^\s*(\d*)\|/) {
72             die $cboxrow unless $cboxrow >= 0;
73             die $cboxrow unless !!$cboxrow == !!length $1;
74             if (length $1) {
75                 print "stage Td:\n", $1 or die $!;
76             }
77             my @entries = split /\|/, $';
78             $nboxcols >= @entries or die;
79             foreach my $cboxcol (0..$#entries) {
80                 my $headix = $cboxcol + $cboxrow * $nboxcols;
81                 my $h = $boxheads[$headix];
82                 defined $h or die;
83                 die if exists $vals{$h};
84                 my $e = $entries[$cboxcol];
85                 $e =~ s/^\s+//;
86                 $e =~ m/^\d*\.\d*$/ or die;
87                 $e =~ m/\d/ or die;
88                 $e =~ s/\.0+$//;
89                 $vals{$h} = $e;
90             }
91         }
92         
93             
94 }
95
96 parseheader();
97 processbody();