use strict;
use warnings;
use Math::Round;
use Statistics::Basic qw(:all);
use List::Util 'sum';

sub dispersion {
		my %p;
		my $pos = 0;
		push @{$p{$_}}, $pos++ while $_ = shift;
		my $var = 0;
		$var += variance( $p{$_} ) for ( keys %p );
		return $var;
}

sub measure {
    my @series = @_;
    my %count;
    $count{$_}++ for @series;
    my $norm = sum values %count;
    $_ /= $norm for values %count;
    my %score = %count;

    my $metric = 0;
    for my $elem (@series) {
        $score{$elem} -= 1;
        for (keys %score) {
            $metric += $score{$_}**2;
            $score{$_} += $count{$_};
        }
    }
    
    return $metric/@series;
}


##</code><code>##

sub mix {
		my $bag = shift;
		my @str = sort { $bag->{$a} <=> $bag->{$b} } keys %$bag;
		my $list = "";
		while( @str ) {
				my $tbi = shift @str;
				my $count = $bag->{$tbi};
				$tbi .= shift @str	while( @str and $bag->{$str[0]} == $count );
				my $l = length $list;
				if( !$l ) {
						$list = $tbi x $count;
				} else {
						for my $pos ( reverse 0..$count-1 ) {
								substr( $list, round($pos / ($count-1) * $l), 0 ) = $tbi ;
						}
				}
		}
		my @series = split '', $list;
		return \@series;
}

sub gen { # kennethk
    my $href = shift;
    my %score = %$href;
    my $norm = sum values %score;
    my @series;
    
    for (1 .. $norm) {
        my ($max, $elem) = 0;
        for (keys %score) {
            ($max, $elem) = ($score{$_}, $_) if $score{$_} >= $max;
            $score{$_} += $href->{$_};
        }
        push @series, $elem;
        $score{$elem} -= $norm;
    }
    
    return \@series;
}

sub genUK { # BrowserUK
    my $href = shift;
    my @kByV = sort{ $href->{ $b } <=> $href->{ $a } } keys %$href;
    my @dist = ( $kByV[0] ) x $href->{ $kByV[0] };
    shift @kByV;
    while( @kByV ) {
        my $k = shift @kByV;
        my $v = $href->{ $k };
        my $n = int( @dist / ( $v+1 ) );
        my $p = $n * $v;
        splice( @dist, $p, 0, $k ), $p -= $n for reverse 1 .. $v;
    }
    return \@dist;
}

sub kcott {
		my $bagref = shift;
		my %bag = %$bagref;
		my @distribution;
		
    for my $key (sort { $bag{$b} <=> $bag{$a} } keys %bag) {
        my $base_offset = int(@distribution / ($bag{$key} + 1) + 0.5); 
        my $offset = $base_offset;
				
        for (1 .. $bag{$key}) {
            next unless $_ % 2;
            splice @distribution, $offset, 0, $key;
						
            if ($_ < $bag{$key}) {
                splice @distribution, -$offset, 0, $key;
            }
						
            $offset += $base_offset + 1;
        }   
    }   
		
		return \@distribution;
}


##</code><code>##

sub evaluate {
		my $cand   = shift;
		my $bags   = shift;
		printf "\n%20s %15s %15s %s\n", "Monk", "Better:higher", "Better:lower", "Result";
		print "------------------------------------------------------------\n\n";
		for my $bag (@$bags) {
				print "bag: ";
				print join ", ", map { +"$_ => ".$bag->{$_} } sort keys %$bag ;
				print "\n\n";
				for my $monk ( sort keys %$cand ) {
						my $result = $cand->{$monk}->($bag);
						my $disp   = dispersion( @$result );
						my $score  = measure( @$result );
						printf "%20s %15.2f %15.2f %s\n", $monk, $disp, $score, join "", @$result;
				}
				print "\n";
		}
}

my $bags = [
		{ A => 4, B => 2, C => 3, D => 1, },
		{ A => 4, B => 2, C => 3, D => 1, F => 2, G => 4, H=> 2, I=>30 },
		{ A => 10, B=> 10, C => 10, },
		];

my $candidates = { # sub expects hash ref and returns array ref
		kennethk  => \&gen,
		BrowserUK => \&genUK,
		kcott     => \&kcott,
		hdb       => \&mix,
};

evaluate( $candidates, $bags );

##</code><code>##

                Monk   Better:higher    Better:lower Result
------------------------------------------------------------

bag: A => 4, B => 2, C => 3, D => 1

           BrowserUK           24.41            0.45 ACBADCBACA
                 hdb           25.72            0.37 ACBADCABCA
               kcott           25.72            0.37 ACBACDABCA
            kennethk           25.72            0.37 ACBADCABCA

bag: A => 4, B => 2, C => 3, D => 1, F => 2, G => 4, H => 2, I => 30

           BrowserUK          866.39            2.67 IIIIIIGAICIIIFBHIGIAIICDIIGIIAFBHIIICGIIIAIIIIII
                 hdb         1178.43            0.94 IAIIGIICIFIIBIAIIGIIHIDIICIFIIAIIGIBIIHICIIAIIGI
               kcott          893.56            2.31 IIIIIIAGIICIIIBHFIAGIIIIDCIIGAIFHBIIICIIGAIIIIII
            kennethk         1283.68            0.78 IIGIAICIIHIIBIFIIGIAIIDIICIIGIAIIHIIBIFIICIGIAII

bag: A => 10, B => 10, C => 10

           BrowserUK           74.25           22.44 CBCBCBCBCBCBCBCBCBCBAAAAAAAAAA
                 hdb          222.75            0.44 ACBACBACBACBACBACBACBACBACBACB
               kcott          224.75            0.44 ABCABCABCABCABCCBACBACBACBACBA
            kennethk          222.75            0.44 CBACBACBACBACBACBACBACBACBACBA