laziness, impatience, and hubris PerlMonks

### Re^2: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's

by marioroy (Parson)
 on Dec 29, 2020 at 05:01 UTC Need Help??

Greetings,

karlgoethebier pinged me to give parallel a try. I tried 2 versions using GrandFather's demonstration.

Running serially:

```print "\$_\n" for GenUniStrings(9, 25);

Running parallel:

This is possible. One way is generating a small sample as input data for the workers to process.

```my (\$numOnes, \$strLen) = (9, 25);

my @input_data = uniq map { substr \$_, 0, \$numOnes - 1 }
GenUniStrings(\$numOnes - 1, \$numOnes * 2 - 2);

print "\$_\n" for @input_data;

__END__
11111111
11111110
11111101
11111100
11111011
11111010
11111001
11111000
...
00000111
00000110
00000101
00000100
00000011
00000010
00000001
00000000

MCE::Map:

```use strict;
use warnings;

use List::MoreUtils 'uniq';
use MCE::Map;

sub GenUniStrings {
# https://www.perlmonks.org/?node_id=11121889
my (\$numOnes, \$strLen) = @_;
my @strings;

die "Number of ones can't be zero or negative" if \$numOnes < 1;

for my \$prefixSize (0 .. \$strLen - \$numOnes) {
my \$prefix = '0' x \$prefixSize;
my \$tailLen = \$strLen - \$prefixSize - 1;

if (\$numOnes == 1) {
push @strings, \$prefix . '1' . ('0' x \$tailLen);
} else {
push @strings, map {\$prefix . '1' . \$_}
GenUniStrings(\$numOnes - 1, \$tailLen);
}
}

return @strings;
}

my (\$numOnes, \$strLen) = (9, 25);

my @input_data = uniq map { substr \$_, 0, \$numOnes - 1 }
GenUniStrings(\$numOnes - 1, \$numOnes * 2 - 2);

# print "\$_\n" for @input_data;
# exit;

MCE::Map::init {
max_workers => MCE::Util::get_ncpu() >> 1,
chunk_size => 1,
};

my @strings = mce_map {
my \$count = \$numOnes - tr/1//;
} @input_data;

print "\$_\n" for @strings;

MCE workers writing directly to STDOUT:

```use strict;
use warnings;

use List::MoreUtils 'uniq';
use MCE;

sub GenUniStrings {
# https://www.perlmonks.org/?node_id=11121889
my (\$numOnes, \$strLen) = @_;
my @strings;

die "Number of ones can't be zero or negative" if \$numOnes < 1;

for my \$prefixSize (0 .. \$strLen - \$numOnes) {
my \$prefix = '0' x \$prefixSize;
my \$tailLen = \$strLen - \$prefixSize - 1;

if (\$numOnes == 1) {
push @strings, \$prefix . '1' . ('0' x \$tailLen);
} else {
push @strings, map {\$prefix . '1' . \$_}
GenUniStrings(\$numOnes - 1, \$tailLen);
}
}

return @strings;
}

my (\$numOnes, \$strLen) = (9, 25);

my @input_data = uniq map { substr \$_, 0, \$numOnes - 1 }
GenUniStrings(\$numOnes - 1, \$numOnes * 2 - 2);

# print "\$_\n" for @input_data;
# exit;

STDOUT->autoflush;

MCE->new(
max_workers => MCE::Util::get_ncpu() >> 1,
chunk_size => 1,
input_data => \@input_data,
init_relay => '',
user_func => sub {
my \$count = \$numOnes - tr/1//;
my @strings = map { \$head . \$_ }

MCE::relay { print "\$_\n" for @strings; };
}
)->run;

Results:

Writing to STDOUT involves overhead in itself. Therefore, I reran again after validation and directed the output to /dev/null. The results were captured on a MacBook laptop. The serial demonstration is likely fast enough if also factoring writing to disk.

```\$ time perl serial.pl >/dev/null

real  0m5.957s
user  0m5.851s
sys   0m0.099s

\$ time perl mce_map.pl >/dev/null

real  0m2.468s
user  0m9.015s
sys   0m0.596s

\$ time perl mce_relay.pl >/dev/null

real  0m1.988s
user  0m7.067s
sys   0m0.507s

Regards, Mario

• Comment on Re^2: Generate all unique combinations of 1 and 0 using specified length of "0"-string and count of 1's

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2022-12-03 18:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?