#! perl -slw
use strict;
use Data::Dump qw[ dump ]; $Data::Dump::MAX_WIDTH = 40;
use List::Util qw[ reduce ];

sub group {
    my $nGroups = shift;
    my $ave = @_ / $nGroups;

    my %groups;  push @{ $groups{ $_ } }, $_ for @_;

    while( keys %groups > $nGroups ) {
        my %sizes; push @{ $sizes{ @{ $groups{ $_ } } } }, $_ for keys %groups;

        last if keys %sizes < 3;
        my @bySize = sort{$b<=>$a} keys %sizes;
        my %bySize = map{ $_ => 1 } @bySize;
        my $changed = 0;
        SIZE: for my $size ( @bySize ) {
            next if $size >= $ave;
            my $wanted = 1; ##int( $ave - $size + 0.5 );
            {
                if( exists $bySize{ $wanted } ) {
                    my $iToMove = shift @{ $sizes{ $size } };
                    my $iToAddto = shift @{ $sizes{ $wanted } };
                    push @{ $groups{ $iToAddto } }, @{ $groups{ $iToMove } };
                    delete $groups{ $iToMove };
                    $changed++;
                    last SIZE;
                }
                else {
                    last if ++$wanted >= $size;
                    redo;
                }
            }
        }
        unless( $changed ) {
            my $iToMove = shift @{ $sizes{ $bySize[ 0 ] } };
            my $iToAddto = shift @{ $sizes{ $bySize[ 1 ] } };
            push @{ $groups{ $iToAddto } }, @{ $groups{ $iToMove } };
            delete $groups{ $iToMove };
        }
    }
    return values %groups;
}


my @list = qw(1 1 1 2 3 4 4 4 5 5 6 6 6 7 7 8 8 8);
my @lol = group( 6, @list );
print dump \@lol;

__END__
C:\test>628986
[
  [6, 6, 6],
  [3, 7, 7],
  [2, 5, 5],
  [8, 8, 8],
  [1, 1, 1],
  [4, 4, 4],
]