in reply to Algorithm RFC: fast (pseudo-)random shuffle with no repetition

What is actually against calculating the valid permutations in advance? A try:

#!/usr/bin/env perl

use strict;
use warnings;
use Algorithm::Permute;
use feature qw(say);
use Data::Dump;

my $n = [ 1, 2, 3, 3, 3, 4, 8 ];
my $p = Algorithm::Permute->new($n, 7);

my $m3 = qr/(.)\1\1/;
my $m2 = qr/(.)\1/;
my @v;

while ( my @r = $p->next ) {
    my $s = pack( "(A*)*", @r );
    next if $s =~ /$m3/;
    next if $s =~ /$m2/;
    push( @v, $s );
}

dd \@v;

__END__

[download]

«The Crux of the Biscuit is the Apostrophe»

  • Comment on Re: Algorithm RFC: fast (pseudo-)random shuffle with no repetition
  • Download Code

Replies are listed 'Best First'.
Re^2: Algorithm RFC: fast (pseudo-)random shuffle with no repetition
by LanX (Saint) on Sep 23, 2023 at 21:28 UTC
    > What is actually against calculating the valid permutations in advance? A try:

    Runtime ...

    from the OP

    > > Both brute subroutines below aren't actually used: they are totally unusable for lists with ~15 unique strings or more, plus any decent amount of duplicates.

    Your approach is even worse, instead of brute-forcing one random result, you try to brute-force all possible solutions in advance.

    NB 15! = 1.3e12

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    see Wikisyntax for the Monastery

[reply]

      It seems like that is actually a bit unwieldy. Another try:

      
#!/usr/bin/env perl

use strict;
use warnings;
use Algorithm::Permute;
use Data::Dump;
use List::Util qw(shuffle);
use feature    qw(say);

my @n = shuffle( 1, 1, 1, 2, 3, 3, 3, 4, 5, 5, 5, 6, 7, 8, 11, 12, 13,
+ 14, 14, 15 );
my $p = Algorithm::Permute->new( \@n, 20 );

my $m3 = qr/(.)\1\1/;
my $m2 = qr/(.)\1/;

PERMUTE: {
    my @r = $p->next;
    dd \@r;
    my $s = pack( "(A*)*", @r );
    if ( $s =~ /($m3)/ ) {
    # say $1;
    # sleep 1;
        goto PERMUTE;
    }
    if ( $s =~ /($m2)/ ) {
        # say $1;
        # sleep 1; 
        goto PERMUTE;
    }
    say join " ", @r;
}

__END__

      [download]

      Minor update: Fixed dead code.

      «The Crux of the Biscuit is the Apostrophe»

[reply]
[d/l]
        A good algorithm must not fail on edge cases.

        One can easily find many where there are no or only few solutions.

        Now try blindly guessing permutations, till you find the only possible solution for ( (1)x8 , 2..8 )

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        see Wikisyntax for the Monastery

[reply]
[d/l]

In Section Seekers of Perl Wisdom