use strict;
use warnings;
use List::Util 'sum';

# Abiturnoten im Ländervergleich (2014, KMK)

# Ergebnisse in Standardausgabe schreiben
# Um auf ein File zu schreiben, durch open OUT, ">out.txt" ersetzen
*OUT = *STDOUT;  

my (@states,%grades);
read_grades();

my @results = compute_results();

print OUT "    avg    std      5%  10% 25% 50% 75% 90%\n";     
foreach my $result (sort { $a->[1] <=> $b->[1] } @results ) {
 printf OUT "%2s: %6.4f %8.6f %3.1f %3.1f %3.1f %3.1f %3.1f %3.1f \n",@$result; 
}

close OUT;


sub compute_results {
  my @results = ();
  my @quantiles = (5.,10.,25.,50.,75.,90.);
  my $index = 0;
  foreach my $state (@states) {
    my @result = ($state);
    my %series = get_column( $index );
    my $total = sum values %series;
    push @result, 
            average( \%series ),
            stddev( \%series );
    foreach my $q (@quantiles) {
      push @result,quantile($q,\%series,$total);
    }
    push @results, \@result;          
    $index++;  
  }
  return @results;
}

# Die Notenspalte eines Bundeslandes aus Matrix %grades lesen
sub get_column {
  my $index = shift;
  my %series = ();
  foreach my $grade (keys %grades) {
    $series{$grade} = $grades{$grade}->[$index];
  }
  return %series;
}


# KMK-Daten in einen Hash of Arrays %grades aus Inline-Daten (s.u.) einlesen
sub read_grades {
  my $index = 0;
  foreach my $line (<DATA>) {
    chomp $line;  
    next unless $line =~ /\S/;
    if ($index == 0) {
      @states = split /\s+/, $line;
      shift @states;
    }
    else {
      my @numbers = split /\s+/, $line;
      (my $grade = shift @numbers) =~ s/,/./;
      foreach (@numbers) { s/\.//; }
      $grades{$grade*1} = \@numbers;
    }  
    $index++;
  }
}


# --------------------------------------------------------------
# Mittelwert, Standardabweichung und Quantile für einen xy-Hash
# (Schlüssel = Messzahlen,Werte = Häufigkeit)
# --------------------------------------------------------------

# Mittelwert eines xy-Hashs
sub average{
  my $xy = shift;
  die "Empty array" unless %$xy;
  return sum( map { $xy->{$_} * $_ } keys %$xy )
        / sum( values %$xy );
  return $a;
}

# Standardabweichung eines xy-Hashs
sub stddev{
  my $xy = shift;
  return 0 if (keys %$xy <= 1);
  my $average = average($xy);
  return ( 
    sum ( 
      map { $xy->{$_}*($_ - $average)**2 } keys %$xy ) 
      / ( sum( values %$xy ) - 1 )
    ) ** 0.5;  
}

# Quantil - $q % der Stichprobe realisieren Messwert $x oder kleiner
sub quantile { 
# $total = Summe aller $y Häufigkeiten ist optional
# So muss $total bei mehrfachem Aufruf für verschiedene $q
# nicht immer neu berechnet werden
  my ($q,$xy,$total) = @_;
  $total = sum( values %$xy ) unless $total;
  die "Perzentilzahl muss <= 100% sein (hier: $q)" if $q > 100;
  my $limit = $total*$q/100;
  my $count = 0;
  foreach my $x (sort { $a <=> $b } keys %$xy) {
    $count += $xy->{$x};
    return $x if $limit <= $count;
  }
  die "Inkonsistente Daten ($total > ".sum(values %$xy).")\n";
}

# Abiturnoten im Ländervergleich 2014, absolute Zahlen
# http://www.kmk.org/fileadmin/Dateien/pdf/Statistik/Aus_Abiturnoten_2014.pdf
__DATA__
Note BW BY BE BB HB HH HE MV NI NW RP SL SN ST SH TH
1,0 619 744 244 156 61 139 412 66 253 1.221 170 59 103 65 100 157
1,1 391 465 173 81 38 75 314 59 186 770 115 28 77 45 78 118
1,2 547 639 204 145 47 116 435 54 249 1.072 161 33 143 72 114 144
1,3 709 805 305 155 59 153 552 65 343 1.399 214 47 191 91 140 172
1,4 912 942 317 198 71 188 629 85 444 1.719 265 59 233 91 199 229
1,5 1.123 1.237 390 198 63 214 752 126 521 1.950 308 96 251 88 227 228
1,6 1.232 1.406 426 243 72 232 875 112 593 2.159 389 85 321 146 253 271
1,7 1.566 1.558 494 263 76 280 952 137 781 2.542 448 106 344 153 326 262
1,8 1.767 1.762 548 292 103 328 1.067 124 857 2.810 517 130 372 185 382 303
1,9 2.000 2.049 561 337 106 343 1.118 126 1.011 3.155 525 146 408 180 401 303
2,0 2.045 2.043 656 298 132 403 1.265 148 1.072 3.122 635 157 441 196 480 296
2,1 2.229 2.227 653 331 134 410 1.345 170 1.202 3.481 682 165 449 189 490 308
2,2 2.429 2.362 737 393 148 479 1.393 191 1.378 3.836 767 167 473 213 544 281
2,3 2.573 2.314 751 380 151 456 1.458 187 1.390 4.174 810 196 509 256 575 301
2,4 2.756 2.521 778 365 148 461 1.599 161 1.659 4.269 800 202 512 230 652 319
2,5 2.780 2.457 814 399 140 515 1.687 177 1.702 4.528 943 241 496 258 708 301
2,6 2.716 2.292 855 369 164 480 1.637 196 1.816 4.705 841 214 479 255 739 265
2,7 2.722 2.302 863 398 182 505 1.673 198 1.878 4.757 904 220 433 248 740 279
2,8 2.661 2.227 891 415 185 511 1.616 205 2.024 4.741 978 206 442 229 734 218
2,9 2.656 2.045 757 346 160 461 1.515 207 2.184 4.709 920 200 475 249 728 217
3,0 2.455 1.733 765 343 185 422 1.481 153 1.974 4.504 978 204 365 238 716 161
3,1 2.310 1.509 756 261 167 431 1.378 156 2.038 4.597 900 198 353 234 710 174
3,2 2.190 1.286 636 240 146 378 1.240 144 1.933 4.241 844 170 310 230 612 139
3,3 1.761 1.016 530 169 124 330 1.022 116 1.730 3.731 738 113 249 152 542 87
3,4 1.371 646 381 93 102 236 796 81 1.427 3.048 640 73 145 93 394 51
3,5 1.002 381 250 44 57 166 503 43 980 2.304 408 34 90 78 263 24
3,6 524 192 137 15 21 76 286 19 539 1.237 217 10 36 27 158 10
3,7 155 58 59 5 9 22 122 5 188 481 119 6 5 2 74 2
3,8 24 20 17 0 2 4 22 1 33 107 25 0 1 1 20 2
3,9 3 1 4 0 1 1 3 0 2 20 2 0 0 0 2 0
4,0 0 0 2 0 1 1 0 0 0 9 9 0 0 0 3 0