#!/usr/bin/perl -w use strict; use utf8; use Data::Printer; binmode STDIN, 'encoding(UTF-8)' or die; binmode STDOUT, 'encoding(UTF-8)' or die; binmode STDERR, 'encoding(UTF-8)' or die; our @choices; our %choices; our @invotes; our $defcho; sub addchoice { my $choname = shift @_; my $cho = $choices{$choname} = { @_, Index => (scalar @choices) }; push @choices, $choname; return $cho; } while (<>) { s/\s+$//; next if m/^\s*\#/; next unless m/\S/; if (m/^([A-Z]+)\s*\=\s*(\S.*)$/) { my ($choname, $desc) = ($1,$2); my $cho = addchoice($choname, Desc => $desc); if ($desc =~ m/\[(\d+):(\d+)\]/) { $cho->{Smaj} = [$1,$2]; } elsif ($desc =~ m/\[default\]/) { $defcho = $cho; } } elsif (m/^V:\s+(\S+)\s+(\S.*)/) { push @invotes, [ $1, $2 ]; } 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) foreach my $iv (@invotes) { my ($votestr,$voter) = @$iv; eval { length $votestr eq @choices or die "wrong vote vector length"; my @vs = split //, $votestr; foreach my $ix (0..$#vs) { my $vchr = $vs[$ix]; if ($vchr eq '-') { $vs[$ix] = 1000; } elsif ($vchr =~ m/[0-9a-z]/) { $vs[$ix] = ord($vchr); } else { die "bad vote char"; } } foreach my $ia (0..$#vs) { 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]++; } print "\$vab[$ia][$ib]=$vab[$ia][$ib] # $voter $va<$vb\n"; print "\$vab[$ib][$ia]=$vab[$ib][$ia] # $voter $va>$vb\n"; } } }; die "voter $voter $@" if $@; } foreach my $iy (-2..$#choices) { foreach my $ix (-2..$#choices) { if ($iy==-1) { if ($ix==-1) { printf "+" or die; } else { printf "------" or die; } } elsif ($ix==-1) { printf "|" or die; } elsif ($ix==-2 && $iy==-2) { printf "V(Y,X)" or die; } elsif ($iy==-2) { printf "%5s ", $choices[$ix] or die $!; } elsif ($ix==-2) { printf "%5s ", $choices[$iy] or die $!; } else { my $v = \( $vab[$iy][$ix] ); $$v += 0; if ($$v) { printf "%5d ", $$v or die $!; } else { printf "%5s ", "" or die $!; } } } printf "\n" or die $!; } #p %choices; #p @vab;