normalise

   1 #!/usr/bin/perl -w
   2 #
   3 # usage:
   4 #  normalise [NORM-OPTIONS...] [--] INPUT-FILES...
   5 #
   6 # NORM-OPTIONS are
   7 #   +OPTNAME[=OPTVAL]           Election option
   8 #   CAND=[DESCRIPTION]
   9 #   +CAND+OPTNAME[=OPTVAL]      Candidate option
  10 #   --                          End of options to normalise
  11 #   -...                        Reserved for future options to normalise
  12
  13 use strict;
  14
  15 our @options;
  16 our %candidates; # $candidates{CAND}{Desc}, {Opts}[]
  17 our %candref; # $candref{CAND} => msg of why needed
  18 our @ballots;
  19
  20 my $candvoter_re = '\w+';
  21 my $cands_re = '\w+(?,\w+)*';
  22 my $opt_re = '\w+(?:=\S*)?';
  23
  24 sub badinput ($) {
  25     die "bad input: $_[0]";
  26 }
  27
  28 sub normalise_opts_list ($$) {
  29     # $ctx is one of Election Candidate Ballot
  30     my ($os,$ctx) = @_;
  31     $os //= '';
  32     my @o;
  33     foreach my $o (split /\s+/, $os) {
  34         if ($o =~ m/^\w+$/) {
  35             push @o, $&;
  36         } elsif ($o =~ s/^_[Tt]ie\=//) {
  37             $o =~ m/^($cands_re)([<>])($cands_re)$/
  38                 or badinput "bad value \`$_' for tie option";
  39             my ($l,$op,$r) = ($1,$2,$3);
  40             ($l,$op,$r) = ($r,'>',$l) if $op eq '<';
  41             $candref{$_} = "tie break spec" foreach $o =~ m/\w+/g;
  42             $l = join ',', sort split /\,/, $l;
  43             $r = join ',', sort split /\,/, $r;
  44             $l =~ m/\b$_\b/ and badinput "reflexive tie"
  45                 foreach split /\,/, $r;
  46             push @o, "$l$op$r";
  47         } elsif ($o =~ m/^\w+\=\S+$/) {
  48             push @o, $&;
  49         } elsif ($o !~ m/\S/) {
  50         } else {
  51             badinput "bad option \`$o'";
  52         }
  53     }
  54     return @o;
  55 }
  56
  57 sub normalise_opts ($$) {
  58     my ($os,$ctx) = @_;
  59     my @o = normalise_opts_list $os, $ctx;
  60     return " | @o";
  61 }
  62
  63 sub setcanddesc ($$) {
  64     my ($cand,$desc) = @_;
  65
  66     if (length $desc) {
  67         badinput "multiple descriptions for $cand" if
  68             defined $candidates{$cand}{Desc};
  69         $candidates{$cand}{Desc} = $desc;
  70     }
  71 }
  72
  73 while (@ARGV) {
  74     $_ = shift @ARGV;
  75     if (m/^--$/) {
  76         last;
  77     } elsif (m/^(\w+)=([^|]+)$/) {
  78         setcanddesc $1, $2;
  79     } elsif (m/^\+($opt_re)$/) {
  80         push @options, $1;
  81     } elsif (m/^\+(\w+)\+($opt_re)$/) {
  82         push @{ $candidates{$1}{Opts} }, $2;
  83     } elsif (m/^-/) {
  84         die "unknown normalise option \`$_'\n";
  85     } else {
  86         # oh!
  87         unshift @ARGV, $_;
  88         last;
  89     }
  90 }
  91
  92 while (<>) {
  93     next unless m/\S/;
  94     next if m/^\#/;
  95     s/^\s+//;
  96     s/\s+$//;
  97     if (m/^\|/) {
  98         push @options, normalise_opts_list $', 'Election';
  99     } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
 100         use Data::Dumper;
 101 print STDERR Dumper($1,$2,$3);
 102         my ($cand,$desc,$opts) = ($1,$2,$3);
 103         push @{ $candidates{$cand}{Opts} }, normalise_opts $opts, 'Candidate';
 104         setcanddesc $cand, $desc;
 105     } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
 106         my ($voter,$opts) = ($1,$3);
 107         my @p;
 108         foreach my $p (split /\s+/, $2) {
 109             if ($p =~ m/^\w+(?:\=\w+)*$/) {
 110                 push @p, $&;
 111                 $candidates{$_} //= { } foreach $p =~ m/\w+/g;
 112             } elsif ($p eq '') {
 113                 # empty entry can only happen if voter casts no prefs at all
 114             } else {
 115                 badinput "bad vote preference \`$p'";
 116             }
 117         }
 118         push @ballots, "$voter : @p".normalise_opts $opts, 'Ballot';
 119     } elsif (m/^\.$/) {
 120     } else {
 121         badinput "unknown line format \`$_'";
 122     }
 123 }
 124
 125 print "| @options\n" or die $!;
 126
 127 foreach my $cand (sort keys %candref) {
 128     badinput "missing candidate $cand (ref. by $candref{$cand}"
 129         unless defined $candidates{$cand};
 130 }
 131
 132 foreach my $cand (sort keys %candidates) {
 133     my $c = $candidates{$cand};
 134     $c->{Desc} //= $cand;
 135     $c->{Opts} //= [ ];
 136     my $opts = $c->{Opts};
 137     print "$cand = $c->{Desc} | @$opts\n" or die $!;
 138 }
 139
 140 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
 141
 142 print $_,"\n" or die $! foreach
 143     sort { vsortkey($a) cmp vsortkey($b) } @ballots;
 144
 145 print ".\n" or die $!;