chiark / gitweb /
wip
[appendix-a6.git] / parse
1 #!/usr/bin/perl -w
2 use strict;
3 use utf8;
4
5 use Data::Printer;
6
7 binmode STDIN, 'encoding(UTF-8)' or die;
8 binmode STDOUT, 'encoding(UTF-8)' or die;
9 binmode STDERR, 'encoding(UTF-8)' or die;
10
11 our @choices;
12 our %choices;
13 our @invotes;
14 our $defcho;
15
16 sub addchoice {
17     my $choname = shift @_;
18     my $cho = $choices{$choname} = { @_, Index => (scalar @choices) };
19     push @choices, $choname;
20     return $cho;
21 }
22
23 while (<>) {
24     s/\s+$//;
25     next if m/^\s*\#/;
26     next unless m/\S/;
27     if (m/^([A-Z]+)\s*\=\s*(\S.*)$/) {
28         my ($choname, $desc) = ($1,$2);
29         my $cho = addchoice($choname, Desc => $desc);
30         if ($desc =~ m/\[(\d+):(\d+)\]/) {
31             $cho->{Smaj} = [$1,$2];
32         } elsif ($desc =~ m/\[default\]/) {
33             $defcho = $cho;
34         }
35     } elsif (m/^V:\s+(\S+)\s+(\S.*)/) {
36         push @invotes, [ $1, $2 ];
37     } else {
38         die "invalid input";
39     }
40 }
41
42 $defcho ||= $choices{FD};
43 if (!$defcho) {
44     $defcho = addchoice('FD', Desc => "Further Discussion");
45 }
46 my $defi = $defcho->{Index};
47 die "FD has smaj?!" if $defcho->{Smaj};
48
49 our @vab; # $vab[$ia][$ib] = V(A,B)
50
51 foreach my $iv (@invotes) {
52     my ($votestr,$voter) = @$iv;
53     eval {
54         length $votestr eq @choices or die "wrong vote vector length";
55         my @vs = split //, $votestr;
56         foreach my $ix (0..$#vs) {
57             my $vchr = $vs[$ix];
58             if ($vchr eq '-') {
59                 $vs[$ix] = 1000;
60             } elsif ($vchr =~ m/[0-9a-z]/) {
61                 $vs[$ix] = ord($vchr);
62             } else {
63                 die "bad vote char";
64             }
65         }
66         foreach my $ia (0..$#vs) {
67             foreach my $ib ($ia+1..$#vs) {
68                 my $va = $vs[$ia];
69                 my $vb = $vs[$ib];
70                 if ($va < $vb) { $vab[$ia][$ib]++; }
71                 elsif ($vb < $va) { $vab[$ib][$ia]++; }
72             }
73         }
74     };
75     die "voter $voter $@" if $@;
76 }
77
78 foreach my $iy (-2..$#choices) {
79     foreach my $ix (-2..$#choices) {
80         if ($iy==-1) {
81             if ($ix==-1) {
82                 printf "+" or die;
83             } else {
84                 printf "------" or die;
85             }
86         } elsif ($ix==-1) {
87             printf "|" or die;
88         } elsif ($ix==-2 && $iy==-2) {
89             printf "V(Y,X)" or die;
90         } elsif ($iy==-2) {
91             printf "%5s ", $choices[$ix] or die $!;
92         } elsif ($ix==-2) {
93             printf "%5s ", $choices[$iy] or die $!;
94         } else {
95             my $v = \( $vab[$iy][$ix] );
96             $$v += 0;
97             if ($$v) {
98                 printf "%5d ", $$v or die $!;
99             } else {
100                 printf "%5s ", "" or die $!;
101             }
102         }
103     }
104     printf "\n" or die $!;
105 }
106
107 #p %choices;
108 #p @vab;