Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Most shuffled array

by vagabonding electron (Curate)
on Aug 24, 2014 at 09:49 UTC ( #1098451=perlquestion: print w/replies, xml ) Need Help??

vagabonding electron has asked for the wisdom of the Perl Monks concerning the following question:

Dear All,

I read with interest the following thread on SO http://stackoverflow.com/questions/25285792/generate-all-permutations-of-a-list-without-adjacent-equal-elements and since I do have a use case for this I tried to make it in perl. I need only one perfectly shuffled array so I did not deal with the generation of permutations.

Update: The task in the above thread was: how to shuffle the list so that equal elements are never (or as seldom as possible) adjacent.

Here is the code which seems to correctly manage all the examples of the above mentioned thread. What do you think about it?

Thank you in advance!

Update: sample runs:

C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 0 0 1 0 0 1 0 1 0 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 0 1 1 0 1 1 1 0 1 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 1 2 3 3 2 2 1 1 2 3 3 2 2 1 1 2 1 3 2 3 2 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 3 2 1 2 1 3 2 3 2 1 2 1 3 2 1 2 1 3 2 3 2 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 1 3 3 3 3 1 1 1 3 3 3 3 1 1 3 1 3 1 3 1 3 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 1 1 1 2 3 1 1 1 2 3 1 2 1 3 1 C:\Perl_516_portable>perl D:\PM\mostly_shuffled_008.pl 1 1 1 2 3 3 2 2 + 1 1 1 1 2 3 3 2 2 1 1 2 1 2 1 3 1 3 2

The code:

#!/perl use strict; use warnings FATAL => qw(all); use List::MoreUtils qw( zip ); die "Where is an array?\n" unless @ARGV; my @array = @ARGV; print "@array\n"; my $aa = unsort([@array]); print "@$aa\n"; sub unsort { my $aref = shift; my @tmp; my %nums; @tmp[0 .. $#$aref] = (undef) x $#$aref; @$aref = sort {$a <=> $b} @$aref; @nums{@$aref} = @tmp; return $aref if scalar keys %nums == 1; my $half = int(($#$aref + 2 )/ 2 ); if ( scalar keys %nums == 2 ) { if ( $aref->[$half - 1] == $aref->[$#$aref] ) { @$aref = ( @$aref[$half .. $#$aref], @$aref[0..$half-1] ); @$aref[$half-1, $#$aref] = @$aref[$#$aref,$half-1]; } } else { for my $i ( 0 .. $half - 1 ) { last if $i + $half > $#$aref; if ( $aref->[$i] == $aref->[$i + $half-1] ) { @$aref = ( @$aref[$i .. $#$aref], @$aref[0..$i-1] ); } } } my @first = @$aref[0..$half-1]; my @second = @$aref[$half .. $#$aref]; #################### An ugly hack for for odd-size arrays. if ( scalar @$aref % 2 ) { push @second, 0; } @tmp = zip @first, @second; if ( scalar @$aref % 2 ) { pop @tmp;} #################### @$aref = @tmp; return $aref; }

Replies are listed 'Best First'.
Re: Most shuffled array
by Athanasius (Archbishop) on Aug 24, 2014 at 15:42 UTC

      Hi Athanasius , and many thanks for improving the code! I see now that @tmp can indeed be removed... and the ugly hack as well :-)

Re: Most shuffled array
by ww (Archbishop) on Aug 24, 2014 at 12:53 UTC

    Upvoted, as the code is interesting, but reluctantly because the node would be far better (more in conformity with Monastery guidance) if readers were not required to go to another site for the problem definition and explanations of terms such as your "perfectly shuffled array."


    check Ln42!

      Thank you very much ww, I updated the node.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1098451]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2022-12-05 10:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?