#!/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; sub addchoice { my $cho = shift @_; $choices{$cho} = { @_, Index => (scalar @choices) }; push @choices, $cho; } while (<>) { s/\s+$//; next if m/^\s*\#/; next unless m/\S/; if (m/^([A-Z]+)\s*\=\s*(\S.*)$/) { my ($cho, $desc) = ($1,$2); my $smaj; if ($desc =~ m/\[(\d+):(\d+)\]/) { $smaj = [$1,$2]; } addchoice($cho, Desc => $desc, Smaj => $smaj); } elsif (m/^V:\s+(\S+)\s+(\S.*)/) { push @invotes, [ $1, $2 ]; } else { die "invalid input"; } } if (!$choices{FD}) { addchoice('FD', Desc => "Further Discussion"); } our $chofd = $choices{FD}; die "FD has smaj?!" if $chofd->{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 (0..$#vs) { my $va = $vs[$ia]; my $vb = $vs[$ib]; if ($va < $vb) { $vab[$ia][$ib]++; } elsif ($vb < $va) { $vab[$ib][$ia]++; } } } } die "voter $voter $@" if $@; } print p %choices; print p @vab;