#!/usr/bin/perl 
#===============================================================================
#
#         FILE:  1.pl
#
#        USAGE:  ./1.pl
#
#  DESCRIPTION:  j
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  Andrey Kostenko (), <andrey@kostenko.name>
#      COMPANY:  Rambler Internet Holding
#      VERSION:  1.0
#      CREATED:  22.12.2009 22:18:40 MSK
#     REVISION:  ---
#===============================================================================

use 5.010;
use strict;

sub a {
    my @a = @_;
    my $v = int rand scalar @a;
    my %a = ();
    $a{$_} = ( $a{$_} || 0 ) + 1 foreach @a;
    my @b = (undef) x scalar(@a);
    my $i;
    while ( grep { ! defined $_ } @b ) {
        my @d = grep { (( $v == 0 || $_ ne $b[$v - 1]) && ($v == scalar( @a ) - 1 || $_ ne $b[$v + 1])) } keys %a;
        warn "@b\n", return a(@a) unless @d;
        $_ = $d[ int rand scalar @d ];
        --$a{$_} or delete $a{$_};
        $b[$v] = $_;
        my @v = grep  {! defined $b[$_]} (0..$#a);
        last unless @v;
        $v = $v[ int rand scalar @v];
    }
    return @b;
}
my @a = ( ('a') x 100, ('b') x 100, ('c') x 100, ('d') x 100 );
say join " ", a(@a);