X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=blobdiff_plain;f=parse;h=8828deec85ee3542e80421a56ce13d2a3a034a6e;hp=c9ebc344c98c4afa200f424d2ba208c3bc918830;hb=b4beaca8bc1df0b298884292d64ec4448c1ce0c3;hpb=08989dd2b75c969d2b57da8be1a4e0bbaf7c2283;ds=sidebyside diff --git a/parse b/parse index c9ebc34..8828dee 100755 --- a/parse +++ b/parse @@ -12,6 +12,7 @@ our @choices; our %choices; our @invotes; our $defcho; +our $quorum = 0; sub addchoice { my $choname = shift @_; @@ -34,6 +35,8 @@ while (<>) { } } elsif (m/^V:\s+(\S+)\s+(\S.*)/) { push @invotes, [ $1, $2 ]; + } elsif (m/^quorum = ([0-9.]+)$/) { + $quorum = $1+0.0; } else { die "invalid input"; } @@ -67,16 +70,18 @@ foreach my $iv (@invotes) { foreach my $ib ($ia+1..$#vs) { my $va = $vs[$ia]; my $vb = $vs[$ib]; - if ($va < $vb) { $vab[$ia][$ib]++; } - elsif ($vb < $va) { $vab[$ib][$ia]++; } + if ($va < $vb) { push @{ $vab[$ia][$ib] }, $voter } + elsif ($vb < $va) { push @{ $vab[$ib][$ia] }, $voter } } } }; die "voter $voter $@" if $@; } -foreach my $iy (-2..$#choices) { - foreach my $ix (-2..$#choices) { +our @ch = map { $choices{$_} } @choices; + +foreach my $iy (-2..$#ch) { + foreach my $ix (-2..$#ch) { if ($iy==-1) { if ($ix==-1) { printf "+" or die; @@ -93,9 +98,9 @@ foreach my $iy (-2..$#choices) { printf "%5s ", $choices[$iy] or die $!; } else { my $v = \( $vab[$iy][$ix] ); - $$v += 0; - if ($$v) { - printf "%5d ", $$v or die $!; + $$v ||= [ ]; + if (@$$v) { + printf "%5d ", (scalar @$$v) or die $!; } else { printf "%5s ", "" or die $!; } @@ -104,5 +109,35 @@ foreach my $iy (-2..$#choices) { printf "\n" or die $!; } +sub drop ($$) { + my ($i,$why) = @_; + print "dropping $choices[$i]: $why\n"; + $ch[$i]{Dropped} = $why; +} + +print "# quorum\n" or die; + +foreach my $i (0..$#choices) { + next if $ch[$i]{Dropped}; + next if $i == $defi; + my $v = $vab[$i][$defi]; + next if $v >= $quorum; + drop $i, "quorum ($v < $quorum)"; +} + +print "# maj. ratio\n" or die; + +foreach my $i (0..$#choices) { + next if $ch[$i]{Dropped}; + next if $i == $defi; + my $majr = $ch[$i]{Smaj}; + $majr ||= [1,1]; + my $vad = scalar @{ $vab[$i][$defi] }; + my $vda = scalar @{ $vab[$defi][$i] }; + next if $vad * $majr->[1] > $vda * $majr->[0]; + drop $i, "majority ratio ($vad * $majr->[1] <= $vda * $majr->[0])"; +} + + #p %choices; #p @vab;