 Keep It Simple, Stupid PerlMonks

### Re^3: Algorithm RFC: fast (pseudo-)random shuffle with no repetition

 on Sep 25, 2023 at 09:17 UTC Need Help??

if compressibility can serve as measure of entropy...
Very-pseudo...

Call it mad science, but I was quite amused with what follows. Let's consider 2 solutions to OP task:

• supf i.e. "shuffle/unshift/push/first"
• mrcs i.e. "matrix rows/columns shuffle"

The former by tybalt98, code almost verbatim from 11154602, and the idea for the latter suggested by LanX. Other than "(almost) equidistant most frequent key(s)", I had no solid basis to say "very-pseudo", but gut feeling only. The mrcs is, as I said, quite visual and therefore e.g. OK as a demo to teach students. I didn't add error checking, neither optimized for speed (it won't become faster than supf, but fast enough already). Here's "result predictability" measurement:

```Looks like "supf" provides 100% of possible entropy
Looks like "mrcs" provides 67% of possible entropy
```

This is for entertainment only, I don't think I'm qualified for "what's randomness?" discussion.

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

use List::Util qw/ first shuffle max /;
use Compress::Zlib 'compress';
use POSIX 'ceil';

use constant ITEM => qr(< \d+ >);

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

my \$low_mark  = gauge(( \@input ) x 100 );
my \$high_mark = gauge( map [ shuffle @input ], 0 .. 99 );

my \$supf_mark = gauge( map verify( supf( \@input )), 0 .. 99 );
my \$mrcs_mark = gauge( map verify( mrcs( \@input )), 0 .. 99 );

printf "Looks like \"supf\" provides %.0f%% of possible entropy\n",
100 * ( \$supf_mark - \$low_mark ) / ( \$high_mark - \$low_mark );
printf "Looks like \"mrcs\" provides %.0f%% of possible entropy\n",
100 * ( \$mrcs_mark - \$low_mark ) / ( \$high_mark - \$low_mark );

sub gauge { length compress join '', map @\$_, @_ }

sub verify {
my \$r = shift;
my \$s = join '', @\$r;
die if \$s =~ /(ITEM)\1/;
return \$r
}

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

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

return @out
}

sub supf {                      # shuffle/unshift/push/first
my \$input_ref = shift;

my @in = shuffle @\$input_ref;
my @out = shift @in;

LOOP:
while( @in )
{
for my \$in ( 0 .. \$#in )
{
if( \$in[\$in] ne \$out ) # put at start
{
unshift @out, splice @in, \$in, 1;
next LOOP;
}
elsif( \$in[\$in] ne \$out[-1] ) # put at end
{
push @out, splice @in, \$in, 1;
next LOOP;
}
else # put in first middle place it fits
{
if( my \$pick = first {
\$out[\$_ - 1] ne \$in[\$in] and \$out[\$_] ne \$in[\$in] } 1 .. \$
+#out )
{
splice @out, \$pick, 0, splice @in, \$in, 1;
next LOOP;
}
}
}
die "FAILED\nin\n @in\nout\n @out";
}
return \@out;
}

sub mrcs {                      # matrix rows/columns shuffle
my \$input_ref = shift;

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

my \$nrows = max values %counts;
my \$ncols = ceil @\$input_ref / \$nrows;

my @frequent_keys = grep { \$counts{ \$_ } == \$nrows } keys %counts;
delete @counts{ @frequent_keys };

my @arranged = (( map {( \$_ ) x \$nrows } @frequent_keys ),
( map {( \$_ ) x \$counts{ \$_ }} keys %counts ));
\$#arranged = \$nrows * \$ncols - 1;

my @matrix = map [ splice @arranged, 0, \$nrows ], 0 .. \$ncols - 1;

my @row_perm = shuffle 1 .. \$ncols - 1;     # exclude 0th column
my @col_perm = shuffle 0 .. \$nrows - 1;

for my \$col ( @matrix ) {
splice @\$col, 0, \$nrows, @\$col[ @col_perm ];
}
splice @matrix, 1, \$ncols - 1, @matrix[ @row_perm ];

my @ret = grep defined, map {       # transpose & flatten
my \$row_i = \$_;
map { \$matrix[ \$_ ][ \$row_i ]} 0 .. \$ncols - 1
} 0 .. \$nrows - 1;

return \@ret;
}

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11154656]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2023-12-01 09:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?