parse

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use utf8;
   4
   5 use Data::Printer;
   6
   7 binmode STDIN, 'encoding(UTF-8)' or die;
   8 binmode STDOUT, 'encoding(UTF-8)' or die;
   9 binmode STDERR, 'encoding(UTF-8)' or die;
  10
  11 our @choices;
  12 our %choices;
  13 our @invotes;
  14 our $defcho;
  15 our $quorum = 0;
  16
  17 sub addchoice {
  18     my $choname = shift @_;
  19     my $cho = $choices{$choname} = { @_, Index => (scalar @choices) };
  20     push @choices, $choname;
  21     return $cho;
  22 }
  23
  24 while (<>) {
  25     s/\s+$//;
  26     next if m/^\s*\#/;
  27     next unless m/\S/;
  28     if (m/^([A-Z]+)\s*\=\s*(\S.*)$/) {
  29         my ($choname, $desc) = ($1,$2);
  30         my $cho = addchoice($choname, Desc => $desc);
  31         if ($desc =~ m/\[(\d+):(\d+)\]/) {
  32             $cho->{Smaj} = [$1,$2];
  33         } elsif ($desc =~ m/\[default\]/) {
  34             $defcho = $cho;
  35         }
  36     } elsif (m/^V:\s+(\S+)\s+(\S.*)/) {
  37         push @invotes, [ $1, $2 ];
  38     } elsif (m/^quorum = ([0-9.]+)$/) {
  39         $quorum = $1+0.0;
  40     } else {
  41         die "invalid input";
  42     }
  43 }
  44
  45 $defcho ||= $choices{FD};
  46 if (!$defcho) {
  47     $defcho = addchoice('FD', Desc => "Further Discussion");
  48 }
  49 my $defi = $defcho->{Index};
  50 die "FD has smaj?!" if $defcho->{Smaj};
  51
  52 our @vab; # $vab[$ia][$ib] = V(A,B)
  53
  54 foreach my $iv (@invotes) {
  55     my ($votestr,$voter) = @$iv;
  56     eval {
  57         length $votestr eq @choices or die "wrong vote vector length";
  58         my @vs = split //, $votestr;
  59         foreach my $ix (0..$#vs) {
  60             my $vchr = $vs[$ix];
  61             if ($vchr eq '-') {
  62                 $vs[$ix] = 1000;
  63             } elsif ($vchr =~ m/[0-9a-z]/) {
  64                 $vs[$ix] = ord($vchr);
  65             } else {
  66                 die "bad vote char";
  67             }
  68         }
  69         foreach my $ia (0..$#vs) {
  70             foreach my $ib ($ia+1..$#vs) {
  71                 my $va = $vs[$ia];
  72                 my $vb = $vs[$ib];
  73                 if ($va < $vb) { push @{ $vab[$ia][$ib] }, $voter }
  74                 elsif ($vb < $va) { push @{ $vab[$ib][$ia] }, $voter }
  75             }
  76         }
  77     };
  78     die "voter $voter $@" if $@;
  79 }
  80
  81 our @ch = map { $choices{$_} } @choices;
  82
  83 foreach my $iy (-2..$#ch) {
  84     foreach my $ix (-2..$#ch) {
  85         if ($iy==-1) {
  86             if ($ix==-1) {
  87                 printf "+" or die;
  88             } else {
  89                 printf "------" or die;
  90             }
  91         } elsif ($ix==-1) {
  92             printf "|" or die;
  93         } elsif ($ix==-2 && $iy==-2) {
  94             printf "V(Y,X)" or die;
  95         } elsif ($iy==-2) {
  96             printf "%5s ", $choices[$ix] or die $!;
  97         } elsif ($ix==-2) {
  98             printf "%5s ", $choices[$iy] or die $!;
  99         } else {
 100             my $v = \( $vab[$iy][$ix] );
 101             $$v ||= [ ];
 102             if (@$$v) {
 103                 printf "%5d ", (scalar @$$v) or die $!;
 104             } else {
 105                 printf "%5s ", "" or die $!;
 106             }
 107         }
 108     }
 109     printf "\n" or die $!;
 110 }
 111
 112 sub drop ($$) {
 113     my ($i,$why) = @_;
 114     print "dropping $choices[$i]: $why\n";
 115     $ch[$i]{Dropped} = $why;
 116 }
 117
 118 print "# quorum\n" or die;
 119
 120 foreach my $i (0..$#choices) {
 121     next if $ch[$i]{Dropped};
 122     next if $i == $defi;
 123     my $v = $vab[$i][$defi];
 124     next if $v >= $quorum;
 125     drop $i, "quorum ($v < $quorum)";
 126 }
 127
 128 print "# maj. ratio\n" or die;
 129
 130 foreach my $i (0..$#choices) {
 131     next if $ch[$i]{Dropped};
 132     next if $i == $defi;
 133     my $majr = $ch[$i]{Smaj};
 134     $majr ||= [1,1];
 135     my $vad = scalar @{ $vab[$i][$defi] };
 136     my $vda = scalar @{ $vab[$defi][$i] };
 137     next if $vad * $majr->[1] > $vda * $majr->[0];
 138     drop $i, "majority ratio ($vad * $majr->[1] <= $vda * $majr->[0])";
 139 }
 140
 141
 142 #p %choices;
 143 #p @vab;