brmlab/brmelect
4
0
Fork 0
mirror of https://github.com/pasky/brmelect.git synced 2025-06-07 09:33:59 +02:00
Code Issues Projects Releases Packages Wiki Activity

hlas.pl: TMA's counting script (putting it in the same repo for convenience)

Browse source
This commit is contained in:
Petr Baudis 2017-12-19 13:55:39 +01:00
parent 040013a9a2
commit b0b57a2b6c
1 changed files with 138 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

138
hlas.pl Executable file
View file

@ -0,0 +1,138 @@
#!/usr/bin/perl
# Copyright TMA 2014
# Brmlab can use this free of charge as long as TMA is member. For other licensing options contact the author.
use strict;
use warnings;
use Data::Dumper;
my $x = 1;
# pocet volenych papalasu
my $funkci;
# prave voleny papalas
my $voleny_papalas = 0;
# kandidati na papalase
my @kand = (undef,);
# listky pro papalase
my @listky;
# stav programu
my $st;
# pocet listku a neplatnych
my ($listky, $neplatne_listky) = (0,0);
# stavova masina
my %sm;
%sm = (
start => sub {
$funkci = $_;
return 'kand';
},
kand => sub {
return 'listky' if /^$/;
push @kand,$_;
return 'kand';
},
listky => sub {
return 'volby' if /^$/;
my $listek = [0,split];
# doplnit nuly na konci listku
my @tmp = (0,) x scalar @kand;
@tmp[0 .. $#$listek] = @$listek;
$listek = [ @tmp ];
# je listek platny?
my $ok = /^[0-9 ]*1[0-9 ]*$/;
@tmp = sort {$a<=>$b} (grep {$_>0} @$listek) if $ok;
my $i = 0;
#{local$"=" ";print "@tmp\n";}
while ($ok && scalar @tmp) {
#print "@tmp $i $ok\n";
$ok = (++$i == shift@tmp);
}
#{local$"=" ";print "$ok/@tmp\n";}
#print "$ok listek $_\n";
++$neplatne_listky unless $ok;
++$listky;
push @listky, $listek if $ok;
return 'listky';
},
volby => sub {
die "Nebyl odevzdan ani jeden platny hlasovaci listek." unless $listky - $neplatne_listky;
#print Dumper(\@listky);
if (++$voleny_papalas > $funkci) {
exit;
}
my $kolo = 1;
my $papalas = undef;
my $max;
for my $i (1 .. $#kand) {
local$"=" ";
my @kandidat = prepocti($i);
#print "kolo $i, @kandidat\n";
}
while ($kolo <= $#kand) {
my @kandidat = prepocti($kolo);
#print Dumper(kandidat=>\@kandidat);
($max,$papalas) = (0, undef);
for my $i (1 .. $#kandidat) {
if ($max < $kandidat[$i]) {
$max = $kandidat[$i];
$papalas = $i;
} elsif ($max == $kandidat[$i]) {
undef $papalas;
}
}
#{local$"=" ";print "kolo $kolo, @kandidat\n";}
last if defined $papalas;
#{local$"=" ";print "$kolo $papalas $zvolen @kandidat\n";}
$kolo++;
}
if (defined $papalas) {
print "Byl zvolen $kand[$papalas] v $kolo. kole volby poctem $max hlasu.\n";
uprav($papalas);
$sm{volby}->();
} else {
$papalas = $_;
die "Chybi zaznam o losovani." unless $papalas;
print "Byl vylosovan $kand[$papalas].\n";
uprav($papalas);
}
return 'volby';
},
);
$st = $sm{start};
sub prepocti($) {
my ($kolo,) = (@_);
my @kandidat = (0,) x $#kand;
for my $listek (@listky) {
#{no warnings;local$"="| |";print "|@$listek|\n";}
for my $i (1 .. $#$listek) {
++$kandidat[int$i] if $listek->[$i] > 0 && $listek->[int$i]<=$kolo;
}
}
return @kandidat;
}
sub uprav($) {
my ($papalas,) = (@_);
for my $listek (@listky) {
#{no warnings;local$"="| |";print "|@$listek|\n";}
#{local$"=" ";print "< @$listek\n";}
my $poradi = $listek->[$papalas];
next if $poradi == 0;
for my $i (1 .. $#$listek) {
$listek->[$i]-- if $listek->[$i] > $poradi;
}
$listek->[$papalas]=0;
#{local$"=" ";print "> @$listek\n";}
}
}
while (<>) {
chomp;
$st = $sm{$st->()};
}
END {
print "Odevzdano celkem $listky hlasovacich listku.\n";
my $platne_listky = $listky - $neplatne_listky;
print "Z toho $neplatne_listky hlasovacich listku neplatnych a $platne_listky platnych.\n";
}