#!/usr/bin/perl use strict; # https://www.perlmonks.org/?node_id=11154597 use warnings; my %uniq; my $n = 0; while( ) { $uniq{ $_ }++; $n++; } grep { $n + 1 < $_ * 2 } values %uniq and die "Cannot be done!\n"; my @norep; while( %uniq ) { my @allowed = grep { @norep == 0 || $_ ne $norep[-1] } keys %uniq; my @choices = grep { $uniq{$_} * 2 >= $n + 1 } @allowed; # required choices @choices or @choices = @allowed or die "FAILED at n = $n\n", @norep; @choices = map { ($_) x $uniq{$_} } @choices; # weighting choices push @norep, my $pick = $choices[ rand @choices ]; --$uniq{ $pick } or delete $uniq{ $pick }; $n--; } print @norep; __DATA__ Line 1 Line 2 Line 3 Line 3 Line 3 Line 4 Line 8 #### Line 3 Line 2 Line 1 Line 3 Line 8 Line 4 Line 3