From 5dc538aedf489281785ce32f25dcaa18385ac6a5 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 2 Feb 2014 20:16:11 +0000 Subject: [PATCH 1/1] wip --- parse | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 60 insertions(+), 4 deletions(-) diff --git a/parse b/parse index 8828dee..e176ecc 100755 --- a/parse +++ b/parse @@ -3,6 +3,7 @@ use strict; use utf8; use Data::Printer; +use Graph::Directed; binmode STDIN, 'encoding(UTF-8)' or die; binmode STDOUT, 'encoding(UTF-8)' or die; @@ -49,7 +50,11 @@ if (!$defcho) { my $defi = $defcho->{Index}; die "FD has smaj?!" if $defcho->{Smaj}; -our @vab; # $vab[$ia][$ib] = V(A,B) +our @vab; +# $vab[$ia][$ib] = V(A,B) +# Actually, it's a list of voters who prefer A to B (A.6(3)(1)) + +# Go through the voters and construct V(A,B) foreach my $iv (@invotes) { my ($votestr,$voter) = @$iv; @@ -80,6 +85,7 @@ foreach my $iv (@invotes) { our @ch = map { $choices{$_} } @choices; +# Print the counts V(A,B) foreach my $iy (-2..$#ch) { foreach my $ix (-2..$#ch) { if ($iy==-1) { @@ -115,7 +121,7 @@ sub drop ($$) { $ch[$i]{Dropped} = $why; } -print "# quorum\n" or die; +print "# quorum A.6(2)\n" or die $!; foreach my $i (0..$#choices) { next if $ch[$i]{Dropped}; @@ -125,19 +131,69 @@ foreach my $i (0..$#choices) { drop $i, "quorum ($v < $quorum)"; } -print "# maj. ratio\n" or die; +print "# maj. ratio A.6(3)\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]; + $majr ||= [1,1]; # A.6(3)(3) 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])"; } +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]; + next unless $vab > $vba; + print "defeat: $choices[$ia] beats $choices[$ib] ($vab > $vba)\n" + or die $!; + $defeats->add_vertex($ia,$ib); + } +} + +print "# transitive closure A.6(5)\n" or die $!; + +my $tdefeats = $defeats->transitive_closure(); + +print "# schwartz set A.6(6)\n" or die $!; + +my $schwartz = $defeats->copy(); + +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" + or die $!; + $schwartz->delete_vertex($ia); + last; + } +} + +print "# dropping weakest defeats A.6(7)\n" or die $!; + +my @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 + } + push @weakest, $edge; +} #p %choices; #p @vab; -- 2.30.2