Skip to content

Commit aa51cf8

Browse files
committed
A script to convert to CIVS ballot format from a format in which the ballot orders the choices.
1 parent 085c287 commit aa51cf8

File tree

1 file changed

+133
-0
lines changed

1 file changed

+133
-0
lines changed

convert-rankings.pl

+133
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,133 @@
1+
#!/usr/bin/env perl
2+
use strict 'refs';
3+
use warnings;
4+
use Text::CSV;
5+
use Text::CSV::Encoded;
6+
use File::Basename;
7+
use Scalar::Util qw(looks_like_number);
8+
9+
sub usage {
10+
my $base = &basename($0);
11+
print STDERR "Usage: $base <ranking.csv>\n\n";
12+
print STDERR " Converts ballots in ordering format into CIVS format.\n";
13+
print STDERR " For example, a file containing:\n\n";
14+
print STDERR "a,b,c,d\n";
15+
print STDERR "c,a,b,e\n";
16+
print STDERR "a,c,b,d\n";
17+
print STDERR "\n produces output as follows:\n";
18+
print STDERR '
19+
### list of choices ###
20+
a
21+
b
22+
c
23+
d
24+
e
25+
### ballots ###
26+
1,2,3,4,-
27+
2,3,1,-,4
28+
1,3,2,4,-', "\n";
29+
30+
exit 1;
31+
}
32+
33+
my $nl = "\r\n";
34+
my $csv = Text::CSV::Encoded->new({ encoding_in => "UTF-8",
35+
encoding_out => "UTF-8" });
36+
37+
# The sources that must be present in each output row
38+
my %req_sources;
39+
40+
# merge rows with duplicate keys in the same file?
41+
my $merge_dups = 0;
42+
43+
# report source files?
44+
my $report_sources = 0;
45+
46+
sub TrimSuffix {
47+
my $result = $_[0];
48+
$result =~ s/\.csv$//;
49+
return $result;
50+
}
51+
52+
while ($#ARGV >= 0 && $ARGV[0] =~ /^-/) {
53+
my $opt = shift @ARGV;
54+
print STDERR "Unknown option $opt.\n";
55+
usage()
56+
}
57+
58+
my @req_sources = keys %req_sources;
59+
# print STDERR "Requiring keys to be in these files: ", (join ', ', @req_sources), "\n";
60+
my $nreq_sources = 1 + $#req_sources;
61+
62+
# remove leading and trailing whitespace and commas and
63+
# collapse multiple whitespace into one.
64+
sub clean {
65+
my $x = $_[0];
66+
chomp $x;
67+
$x =~ s/\s*$//g;
68+
$x =~ s/\s\s+$/ /g;
69+
$x =~ s/^\s*//g;
70+
$x =~ s/,*$//g;
71+
$x =~ s/^,*//g;
72+
return $x;
73+
}
74+
75+
if ($#ARGV < 0) {
76+
usage();
77+
exit(1);
78+
}
79+
my $file = $ARGV[0];
80+
open my $fileh, '<', $file;
81+
82+
my %names;
83+
my @orderings = ();
84+
my $num_rows = 0;
85+
86+
while (1) {
87+
my $row = $csv->getline($fileh);
88+
if (!defined($row)) { last; }
89+
90+
my @ordering = @{$row};
91+
# printf "%s\n", join ",", @{$row};
92+
93+
foreach my $name (@ordering) {
94+
$name = &clean($name);
95+
$names{$name} = 1;
96+
}
97+
$orderings[$num_rows++] = $row;
98+
}
99+
100+
# print "number of rows: $num_rows\n";
101+
102+
my @name_list = sort {
103+
if (looks_like_number($a) && looks_like_number($b)) { return $a <=> $b }
104+
if (looks_like_number($a)) { return -1 }
105+
if (looks_like_number($b)) { return 1 }
106+
return $a cmp $b
107+
} (keys %names);
108+
my $num_names = $#name_list + 1;
109+
110+
# print "number of names: $num_names\n";
111+
print "### list of choices ###\n";
112+
foreach my $name (@name_list) {
113+
print "$name\n";
114+
}
115+
116+
print "### ballots ###\n";
117+
for (my $i = 0; $i < $num_rows; $i++) {
118+
my @ordering = @{$orderings[$i]};
119+
my $first = 1;
120+
foreach my $name (@name_list) {
121+
my $rank = "-";
122+
print "," unless $first;
123+
$first = 0;
124+
for ($j = 0; $j <= $#ordering; $j++) {
125+
if ($ordering[$j] eq $name) {
126+
$rank = $j + 1;
127+
last;
128+
}
129+
}
130+
print $rank;
131+
}
132+
print "\n";
133+
}

0 commit comments

Comments
 (0)