use strict;
use warnings;
use feature 'say';

use List::Util qw/ shuffle /;
use List::MoreUtils qw/ part samples singleton /;

use ntheory qw/ forperm lastfor /;
use Algorithm::Combinatorics qw/ permutations /;

use Benchmark 'cmpthese';

my @input = shuffle( qw( a a a a b b b c c ));      # corner-cases
@input = shuffle( qw( a a a b b ));                 #

srand 123;

@input = fake_data( 555, 55 );
#say scalar @input;                 # 2096

sub fake_data {
    my ( $uniq, $pivot ) = @_;

    my @tmp = map { sprintf '< %06d >', rand 1e9 } 0 ... $uniq;
    my @out;
    push @out, @tmp[ 0 .. $_ ] for 0 .. $pivot;
    @out = shuffle( @out, @tmp[ $pivot + 1 .. $uniq ]);

    return @out
}

cmpthese 10, {
    SO_fixed   => sub { die unless SO_fixed( \@input )},
    my_shuffle => sub { die unless my_shuffle( \@input )},
};

sub brute {
    my $input_ref = shift;
    my @output;

    forperm {
        my $prev = '';
        for ( @_ ) {
            return if $prev eq $input_ref-> [ $_ ];
            $prev = $input_ref-> [ $_ ]
        }
        @output = @{ $input_ref }[ @_ ];
        lastfor, return
    } @$input_ref;
    
    return \@output
}

sub brute2 {
    my $input_ref = shift;
    my @output;

    my $iter = permutations( $input_ref );
    PERM: while ( my $p = $iter-> next ) {
        my $prev = '';
        for ( @$p ) {
            next PERM if $prev eq $_;
            $prev = $_
        }
        @output = @$p;
        last PERM
    }

    return \@output
}

sub SO_fixed {
    my $input_ref = shift;

    my %counts; ++$counts{ $_ } for @$input_ref;

    my @strings = shuffle keys %counts;

    LOOP: {
        my $any = 0;

        for my $string ( keys( %counts ) ) {
            next if $counts{ $string } == 1;
            $counts{ $string } --;
            $any = 1;

            my @safe =
                grep { $_ == 0        || $strings[ $_ - 1 ] ne $string }
                grep { $_ == @strings || $strings[ $_ ]     ne $string }
                0 .. @strings;
            return undef unless @safe;

            my $pick = $safe[ rand( @safe ) ];

            splice( @strings, $pick, 0, $string );
        }
        redo LOOP if $any
    }
    
    return \@strings
}

sub my_shuffle {
    my $input_ref = shift;
    my @output;

    my %counts; $counts{ $_ } ++ for @$input_ref;

    my ( $single, $multi ) = part { $counts{ $_ } > 1 } keys %counts;
    my @multi = sort { $counts{ $b } <=> $counts{ $a }} @$multi;

    my @pool = ( 0 .. $#$input_ref );

    for my $str ( @multi ) {
        my $count = $counts{ $str };
        
        my @take;
        if ( $count <= @pool / 2 ) {
# case 1
            my @excess = sort { $a <=> $b } samples( 2 * $count, @pool );
            my $n = int rand 2;
            my @idx = grep { $n ^ $_ % 2 } 0 .. $#excess;
            @take = @excess[ @idx ];
        }
        elsif ( 2 * $count - 1 == @pool ) {
# case 2
#die 'This code is unreachable for realistic input';

            my @idx = grep { not $_ % 2 } 0 .. $#pool;
            @take = @pool[ @idx ];
        }
        else {
# case 3
#die 'This code is unreachable for realistic input';

            my $prev = -2;
            my @ok = grep {
                my $res = $_ - $prev;
                $prev = $_;
                $res > 1
            } @pool;
            
            return undef if $count > @ok;
            
            @take = samples( $count, @ok );
        }

        @pool = singleton @pool, @take;
        @output[ $_ ] = $str for @take;
    }

    @output[ @pool ] = @$single if @pool;

    return \@output;
}

__END__

            (warning: too few iterations for a reliable count)
             Rate   SO_fixed my_shuffle
SO_fixed   2.29/s         --       -95%
my_shuffle 42.7/s      1763%         --