First pass at it...
#!/usr/bin/perl use strict; # https://www.perlmonks.org/?node_id=11154597 use warnings; my %uniq; my $n = 0; while( <DATA> ) { $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
Sample Output:
Line 3 Line 2 Line 1 Line 3 Line 8 Line 4 Line 3
In reply to Re: Algorithm RFC: fast (pseudo-)random shuffle with no repetition
by tybalt89
in thread Algorithm RFC: fast (pseudo-)random shuffle with no repetition
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |