Re^2: Distribution of * new * Levels and Writeups

[ZlR]

err, well ok but it was really a quick hack ...

use strict ;
use warnings ;

my %distrib ;
my %levels ;
my %contrib ; 

# Read up some data
while (<DATA>) {
    my@line = split ; 
    my $lev = $line[1] ;
    $lev =~ s/[()]//g ;
    $distrib{$lev} = $line[2] ;   
    $levels{$lev} = $line[0] ;   
    $contrib{$lev} = $line[3] ; 
} 

# Get some %
my $total ;     
my %percents ;
my $totalcont ;
my %percentscont ;
$total += $distrib{$_} foreach keys %distrib ;
$percents{$_} = 100 * $distrib{$_} / $total foreach keys %distrib ; 
$totalcont += $contrib{$_} foreach keys %contrib ;
$percentscont{$_} =  100 * $contrib{$_} / $totalcont  foreach keys %co
+ntrib ; 

# There must be a better way ...
my %drawhash ;
my $letter = 'A' ; 
my $accu = 0 ;
foreach  ( reverse  sort {$a <=> $b} keys %levels ) {
    $drawhash{$letter} .= " $_" ;
    $accu += $percents{$_} ; 
    if ( $accu > 1) { $letter++ ; $accu = 0 }
}


print_result ( \%percents ) ;
print "\n" ; 
print_result ( \%percentscont ) ;


sub print_result {

    my $refpercents = shift ; 
    my %percents = %$refpercents ; 
    my $result ;
    
    # Save ourselves some html typing
    my %colors = ( 'A' => 'red',
            'B' => 'orange',
            'C' => 'yellow',
            'D' => 'magenta',
            'E' => '00CC99',
            'F' => '006666', 
            'G' => '33FF99',
            'H' => '33CCFF',
            'I' => '0066FF' ) ; 
    
    foreach  my $cle  (keys %drawhash) {
        my @ligne = split " ", $drawhash{$cle}  ;
        my $count = 0 ;
        $count += $percents{$_} foreach (@ligne)  ;
        $result .=  $cle  x $count  
    }
    
    my @rez = split "", $result ; 

    my @odd ; 
    foreach (0..9) { push @odd, 2*$_+1}
    my $cpt = scalar @odd  ; 

    foreach (@odd) {
        $cpt-- ; 
        print " " x $cpt;  
        my @tranche =  splice @rez, 0, $_ ; 
        foreach (@tranche) { print "<font color=\"", $colors{$_},"\">"
+,$_,"</font>" } 
        print "\n"
    } 

}

__DATA__
Pope (28)    1    606
Archbishop (23)    1    5512
Bishop (22)    6    25233
Chancellor (21)    5    15430
Canon (20)    9    19889
Abbot (19)    10    13303
Monsignor (18)    18    21494
Prior (17)    30    20272
Parson (16)    33    19638
Vicar (15)    49    25967
Priest (14)    93    31140
Curate (13)    161    36056
Deacon (12)    85    16309
Chaplain (11)    155    21689
Hermit (10)    186    20818
Friar (9)    269    79538
Pilgrim (8)    377    21647
Monk (7)    329    14459
Scribe (6)    509    13805
Beadle (5)    506    9466
Sexton (4)    560    6733
Acolyte (3)    955    7584
Novice (2)    1839    8505
initiate (1)    30470    44805