X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=blobdiff_plain;f=compute;h=bd9ed7c6ab9e0b01d9a89f4cdcff95eed7ec6c07;hp=222c40f721734c22a72f91aec21474466bb81f0a;hb=af19a4306f157650f182d15cf4e02325f372b2d7;hpb=6f39f4a7a7c4404c3e16694ec9ad044f881ab233 diff --git a/compute b/compute index 222c40f..bd9ed7c 100755 --- a/compute +++ b/compute @@ -1,10 +1,60 @@ #!/usr/bin/perl -w +# +# parses some input about ballots and computes the result according +# to Debian Constitution A.6. +# +# usage: .../compute [...] +# (uses stdin if none supplied) +# +# input files can be in any order and should contain lines like: +# +# :: , (=), , .... +# V: +# = +# = [:] +# = [default] +# nodefault +# quorum = +# +# where +# +# is any non-whitespace characters +# +# and are abbreviations for choices on the ballot. +# They must be ASCII alphanumeric. Numeric preferences are +# not recommended as they are confusing (particularly when +# tally sheets are in use). +# +# It is best to avoid FD, SQ and NOTA except for the default +# option; if no default option is specified, it will default +# to one of these unless a "nodefault" line is found. +# +# In the "::" form, the commas are optional. Either ( ) or = may +# be used to indicate a set of equal preferences. +# +# is a tally sheet preference order: that is, +# a single uppercase base36 digit for each ballot choice, +# (in the order they were specified by "=" lines), giving +# the voter's preference rank for that option. The numbers +# need not be distinct or contiguous. "-" may be used for +# unranked preferences. +# +# : is the majority ratio for the option +# +# is the quorum +# +# and also allowed are +# +# #-comments } all +# blank lines } ignored +# lines starting with whitespace } + use strict; use utf8; use autodie; -use Data::Printer; use Graph::Directed; +use Graph::Writer::GraphViz; binmode STDIN, 'encoding(UTF-8)'; binmode STDOUT, 'encoding(UTF-8)'; @@ -17,9 +67,24 @@ our @invotes_cc; our $defcho; our $quorum = 0; +our $gfile; + +while (@ARGV && $ARGV[0] =~ /^-/) { + local $_ = shift @ARGV; + if (m/^--?$/) { + last; + } elsif (s/^-g//) { + $gfile = $_; + } else { + die "bad usage\n"; + } +} + sub addchoice { my $choname = shift @_; - my $cho = $choices{$choname} = { @_, Index => (scalar @choices) }; + my $cho = $choices{$choname} = { + @_, Index => (scalar @choices) + }; push @choices, $choname; return $cho; } @@ -29,7 +94,7 @@ while (<>) { next if m/^\s*\#/; next unless m/\S/; next if m/^\s/; - if (m/^([A-Z]+)\s*\=\s*(\S.*)$/) { + if (m/^([A-Z0-9]+)\s*\=\s*(\S.*)$/) { my ($choname, $desc) = ($1,$2); my $cho = addchoice($choname, Desc => $desc); if ($desc =~ m/\[(\d+):(\d+)\]/) { @@ -43,30 +108,29 @@ while (<>) { push @invotes_cc, [ $1, "$'" ]; } elsif (m/^quorum = ([0-9.]+)$/) { $quorum = $1+0.0; + } elsif (m/^nodefault$/) { + $defcho = { Index => -1 } } else { die "invalid input"; } } -$defcho ||= $choices{FD}; -if (!$defcho) { - $defcho = addchoice('FD', Desc => "Further Discussion"); -} -my $defi = $defcho->{Index}; -die "FD has smaj?!" if $defcho->{Smaj}; - 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) -print "\nPreference matrix\n"; +print "\nParsing \`simple' style ballots\n# devotee-tally-begin\n" + if @invotes_cc; +# actually, we pre-parse them into @invotes_v +# since we want to show them as a tally sheet anyway foreach my $iv (@invotes_cc) { $_ = uc $iv->[1]; foreach my $chn (m/\b\w+\b/g) { - $choices{$chn} or addchoice($chn, Desc => "($chn from voter ballot)"); + next if $choices{$chn}; + addchoice($chn, Desc => "($chn from voter ballot)"); } } @@ -88,7 +152,7 @@ foreach my $iv (@invotes_cc) { foreach (split /\s+/) { foreach (split /=/) { my $cho = $choices{$_}; - $cho or die "unknown option $_ ($voter)"; + $cho or die "unknown choice $_ ($voter)"; my $ix = $cho->{Index}; $ranks[$ix] = $rank; } @@ -103,6 +167,33 @@ foreach my $iv (@invotes_cc) { push @invotes_v, [ $vstr, $voter ]; } +print "# devotee-tally-end\n" + if @invotes_cc; + +print "\nDetermining default option\n"; + +if ($defcho && $defcho->{Index} > -1) { + print "default option was specified: $choices[$defcho->{Index}]\n"; +} elsif ($defcho) { + print "no default option\n"; +} else { + foreach my $try (qw(FD SQ NOTA)) { + $defcho = $choices{$try}; + last if $defcho; + } + if ($defcho) { + print "guessed default option: $choices[$defcho->{Index}]\n"; + } else { + print "could not guess default option, assuming there is none\n"; + } +} + +my $defi = $defcho->{Index}; +die "FD has smaj?!" if $defcho->{Smaj}; + +print "\nParsing devotee tally sheet ballots\n" + if @invotes_v > @invotes_cc; + foreach my $iv (@invotes_v) { my ($votestr,$voter) = @$iv; eval { @@ -112,7 +203,7 @@ foreach my $iv (@invotes_v) { my $vchr = $vs[$ix]; if ($vchr eq '-') { $vs[$ix] = 1000; - } elsif ($vchr =~ m/[0-9a-z]/) { + } elsif ($vchr =~ m/[0-9A-Z]/) { $vs[$ix] = ord($vchr); } else { die "bad vote char"; @@ -130,6 +221,8 @@ foreach my $iv (@invotes_v) { die "voter $voter $@" if $@; } +print "\nPreference matrix\n"; + our @ch = map { $choices{$_} } @choices; # Print the counts V(A,B) @@ -168,27 +261,29 @@ sub drop ($$) { $ch[$i]{Dropped} = $why; } -print "\nQuorum A.6(2) (quorum is $quorum)\n"; +if (defined $defi) { + print "\nQuorum A.6(2) (quorum is $quorum)\n"; -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)"; -} + 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 "\nMajority ratio A.6(3)\n"; - -foreach my $i (0..$#choices) { - next if $ch[$i]{Dropped}; - next if $i == $defi; - my $majr = $ch[$i]{Smaj}; - $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])"; + print "\nMajority ratio A.6(3)\n"; + + foreach my $i (0..$#choices) { + next if $ch[$i]{Dropped}; + next if $i == $defi; + my $majr = $ch[$i]{Smaj}; + $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:$vda <= $majr->[1]:$majr->[0])"; + } } print "\nDefeats A.6(4)\n"; @@ -199,9 +294,9 @@ sub chremain () { return grep { !$ch[$_]{Dropped} } (0..$#ch); } -foreach my $ia (chremain()) { +foreach my $ia (0..$#ch) { $defeats->add_vertex($choices[$ia]); - foreach my $ib (chremain()) { + foreach my $ib (0..$#ch) { my $vab = scalar @{ $vab[$ia][$ib] }; my $vba = scalar @{ $vab[$ib][$ia] }; next unless $vab > $vba; @@ -209,6 +304,13 @@ foreach my $ia (chremain()) { print "defeat: $choices[$ia] beats $choices[$ib]", " ($vab > $vba = +$diff)\n"; $defeats->add_edge($choices[$ia],$choices[$ib]); + my $label = "$diff($vab:$vba)"; + if (@invotes_v < 10) { + $label .= "\n". join ' ', @{ $vab[$ia][$ib] }; + $label .= "\n/". join ' ', @{ $vab[$ib][$ia] }; + } + $defeats->set_edge_attribute($choices[$ia],$choices[$ib], + label => $label); } } @@ -229,17 +331,29 @@ sub weaker ($$) { return 0; } +our $showg = $defeats->deep_copy(); + +foreach my $ix (0..$#ch) { + my $cho = $ch[$ix]; + next unless $cho->{Dropped}; + $defeats->delete_vertex($choices[$ix]); +} + our $schwartz; -for (;;) { +for (my $dropiter = 1; ; $dropiter++) { # loop from A6(5) print "defeats graph: $defeats\n"; - print "\nTransitive closure A.6(5)\n"; + print "\nTransitive closure A.6(5) (iteration $dropiter)\n"; my $tdefeats = $defeats->transitive_closure(); + # this makes the debugging output prettier + foreach my $ch (@choices) { + $tdefeats->delete_edge($ch,$ch); + } print "closure graph: $tdefeats\n"; print "\nSchwartz set A.6(6)\n"; @@ -288,6 +402,11 @@ for (;;) { my ($ca,$cb) = @$weakest; print "a weakest defeat is $ca > $cb\n"; $defeats->delete_edge($ca,$cb); + my $label = $showg->get_edge_attribute($ca,$cb,'label'); + $label .= "\ndropped - weakest in iter.$dropiter"; + $showg->set_edge_attribute($ca,$cb,'label',$label); + $showg->set_edge_attribute($ca,$cb,'style','dotted'); + $showg->set_edge_attribute($ca,$cb,'graphviz',{constraint=>0}); } print "\nDefeats within the Schwartz set, go round again\n"; @@ -296,15 +415,35 @@ for (;;) { print "no defeats within the Schwartz set\n"; print "final schwartz set:\n\n"; +my $winxlabel; if ($schwartz->vertices() == 1) { print "WINNER IS:\n"; + $winxlabel = "winner"; } else { print "WINNER IS ONE OF (CASTING VOTE DECIDES):\n"; + $winxlabel = "potential winner"; } printf " %-5s %s\n", $_, $choices{$_}{Desc} foreach ($schwartz->vertices()); +if (defined $gfile) { + foreach my $cho (values %choices) { + my $chn = $choices[$cho->{Index}]; + my $label = "$chn\n$cho->{Desc}"; + if ($cho->{Dropped}) { + $label .= "\nDropped: $cho->{Dropped}"; + } + if ($schwartz->has_vertex($chn)) { + $label .= "\n$winxlabel"; + } + $showg->set_vertex_attribute($chn, 'label', $label); + } + + my $gwriter = new Graph::Writer::GraphViz -format => 'ps'; + $gwriter->write_graph($showg, $gfile); +} + print ".\n"; #p %choices;