X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=blobdiff_plain;f=compute;h=38ad31b6f0ef85dd4d6aefd135dc3e40d1d74da5;hp=9e5e8ba0d78437704e5a656c10530889aaef80e6;hb=16858a6757d2b921469a29d4974dbd1f7c221e1d;hpb=edc4d0c340cdacbed8a4ae9eb2346bead325045c diff --git a/compute b/compute index 9e5e8ba..38ad31b 100755 --- a/compute +++ b/compute @@ -4,15 +4,57 @@ # 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)'; @@ -25,6 +67,19 @@ 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} = { @@ -66,7 +121,7 @@ our @vab; # Go through the voters and construct V(A,B) -print "\nParsing \`simple' style ballots\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 @@ -112,6 +167,9 @@ 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) { @@ -124,7 +182,7 @@ if ($defcho && $defcho->{Index} > -1) { last if $defcho; } if ($defcho) { - print "guessed default option was: $choices[$defcho->{Index}]\n"; + print "guessed default option: $choices[$defcho->{Index}]\n"; } else { print "could not guess default option, assuming there is none\n"; } @@ -236,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; @@ -246,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); } } @@ -266,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"; @@ -325,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"; @@ -333,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;