X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;ds=sidebyside;f=parse;h=7ca1ed6aa70817165ca476ac6323a37f4404506e;hb=708d36a1a95409c926ac4be1a343faa41cf09052;hp=16f09266a2471eff0551b4f25f31e5ba1a6951c8;hpb=6c044868abff470bc659ffd315bcf5a1cea20ded;p=appendix-a6.git diff --git a/parse b/parse index 16f0926..7ca1ed6 100755 --- a/parse +++ b/parse @@ -57,6 +57,8 @@ our @vab; # Go through the voters and construct V(A,B) +print "\nDefeats matrix\n"; + foreach my $iv (@invotes) { my ($votestr,$voter) = @$iv; eval { @@ -122,7 +124,7 @@ sub drop ($$) { $ch[$i]{Dropped} = $why; } -print "# quorum A.6(2)\n"; +print "\nQuorum A.6(2) (quorum is $quorum)\n"; foreach my $i (0..$#choices) { next if $ch[$i]{Dropped}; @@ -132,7 +134,7 @@ foreach my $i (0..$#choices) { drop $i, "quorum ($v < $quorum)"; } -print "# maj. ratio A.6(3)\n"; +print "\nMajority ratio A.6(3)\n"; foreach my $i (0..$#choices) { next if $ch[$i]{Dropped}; @@ -147,52 +149,105 @@ foreach my $i (0..$#choices) { my $defeats = Graph::Directed->new; # A.6(4) -foreach my $ia (0..$#ch) { - foreach my $ib (0..$#ch) { - my $vab = $vab[$ia][$ib]; - my $vba = $vab[$ib][$ia]; +sub chremain () { + return grep { !$ch[$_]{Dropped} } (0..$#ch); +} + +foreach my $ia (chremain()) { + $defeats->add_vertex($ia); + foreach my $ib (chremain()) { + my $vab = scalar @{ $vab[$ia][$ib] }; + my $vba = scalar @{ $vab[$ib][$ia] }; next unless $vab > $vba; print "defeat: $choices[$ia] beats $choices[$ib] ($vab > $vba)\n"; $defeats->add_vertex($ia,$ib); } } -print "# transitive closure A.6(5)\n"; +sub weaker ($$) { + # A.6(7)(1) + my ($def1,$def2) = @_; + my ($ia,$ix) = @$def1; + my ($ib,$iy) = @$def1; + return 1 if $vab[$ia][$ix] < $vab[$ib][$iy]; + return 1 if $vab[$ia][$ix] == $vab[$ib][$iy] + && $vab[$ix][$ia] > $vab[$iy][$ib]; + return 0; +} + +our $schwartz; + +for (;;) { + # loop from A6(5) -my $tdefeats = $defeats->transitive_closure(); + print "defeats graph: $defeats\n"; -print "# schwartz set A.6(6)\n"; + print "\nTransitive closure A.6(5)\n"; -my $schwartz = $defeats->copy(); + my $tdefeats = $defeats->transitive_closure(); -foreach my $ia (0..$#ch) { - foreach my $ib (0..$#ch) { - next if $tdefeats->has_edge($ia,$b); - next if !$tdefeats->has_edge($b,$ia); - print "not in Schwartz set: $choices[$ia] because $choices[$ib]\n"; - $schwartz->delete_vertex($ia); - last; + print "closure graph: $tdefeats\n"; + + print "\nSchwartz set A.6(6)\n"; + + $schwartz = $defeats->copy(); + + foreach my $ia (chremain()) { + foreach my $ib (chremain()) { + next if $tdefeats->has_edge($ia,$ib); + next if !$tdefeats->has_edge($ib,$ia); + print "not in Schwartz set: $choices[$ia] because $choices[$ib]\n"; + $schwartz->delete_vertex($ia); + last; + } } -} -print "# dropping weakest defeats A.6(7)\n"; + print "\nDropping weakest defeats A.6(7)\n"; -my @weakest = (); + our @weakest = (); -foreach my $edge (@{ $schwartz->edges() }) { - if (!@weakest) { - # no weakest edges yet - } elsif (weaker($edge, $weakest[0])) { - # this edge is weaker than previous weakest, start new set - @weakest = (); - } elsif (weaker($weakest[0], $edge)) { - # weakest edge is weaker than this one, ignore this one - next; - } else { - # weakest edge is exactly as weak as this one, add this one + foreach my $edge ($schwartz->edges()) { + if (!@weakest) { + # no weakest edges yet + } elsif (weaker($edge, $weakest[0])) { + # this edge is weaker than previous weakest, start new set + @weakest = (); + } elsif (weaker($weakest[0], $edge)) { + # weakest edge is weaker than this one, ignore this one + next; + } else { + # weakest edge is exactly as weak as this one, add this one + } + push @weakest, $edge; } - push @weakest, $edge; + + last unless @weakest; + + printf "weakest defeats %d > %d", + (scalar @{ $vab[$_->[0]][$_->[1]] }), + (scalar @{ $vab[$_->[1]][$_->[0]] }); + foreach my $weakest (@weakest) { + my ($ia,$ib) = @$weakest; + print "weakest defeat $choices[$ia] > $choices[$ib]\n"; + $defeats->delete_edge($ia,$ib); + } + + print "defeats within the Schwartz set, round again\n"; } -b#p %choices; +print "no defeats within the Schwartz set\n"; +print "final schwartz set:\n\n"; + +if ($schwartz->vertices() == 1) { + print "WINNER IS:\n"; +} else { + print "WINNER IS ONE OF (CASTING VOTE DECIDES):\n"; +} + +printf " %-5s %s\n", $choices[$_], $ch[$_]{Desc} + foreach ($schwartz->vertices()); + +print ".\n"; + +#p %choices; #p @vab;