Re: Looking for combinatorics with state
by BrowserUk (Patriarch) on May 26, 2018 at 05:02 UTC
|
# ! perl -slw
use strict;
sub nForS(&$@) {
my $code = shift; die "First argument must be a code ref" unl
+ess ref( $code ) eq 'CODE';
my $aref = shift; die "second argument must be an array ref" un
+less ref( $aref ) eq 'ARRAY';
my @limits = @_;
our @indices; local *indices = $aref;
@indices = ( 0 ) x @limits unless @indices;
for( my $i = $#limits; $i >= 0; ) {
$i = $#limits;
$code->( @indices ), ++$indices[ $i ]
while $indices[ $i ] < $limits[ $i ];
$i = $#limits;
$indices[ $i ] = 0, ++$indices[ --$i ]
while $i >= 0 and $indices[ $i ] == $limits[ $i ];
}
}
my @state;
my $n = 10;
nForS{ print "@_\n"; last unless --$n } \@state, 3, 6, 9;
print "First 10 permutations; enter to see the rest"; <STDIN>;
nForS{ print "@_\n"; } \@state, 3, 6, 9;
Outputs: C:\test>junk
0 0 0
0 0 1
0 0 2
0 0 3
0 0 4
0 0 5
0 0 6
0 0 7
0 0 8
0 1 0
First 10 permutations; enter to see the rest
0 1 0
0 1 1
0 1 2
0 1 3
...
2 5 6
2 5 7
2 5 8
That just demonstrates that you can save and restore that state of the iterators.
The basics of the nFor are that it doesn't iterate the data, but iterates indices, which you then use to slice the data. Eg. # ! perl -slw
use strict;
sub nForS(&$@) {
my $code = shift; die "First argument must be a code ref" unl
+ess ref( $code ) eq 'CODE';
my $aref = shift; die "Second argument must be an array ref" un
+less ref( $aref ) eq 'ARRAY';
my @limits = @_;
our @indices; local *indices = $aref;
@indices = ( 0 ) x @limits unless @indices;
for( my $i = $#limits; $i >= 0; ) {
$i = $#limits;
$code->( @indices ), ++$indices[ $i ]
while $indices[ $i ] < $limits[ $i ];
$i = $#limits;
$indices[ $i ] = 0, ++$indices[ --$i ]
while $i >= 0 and $indices[ $i ] == $limits[ $i ];
}
}
my @state;
my @alpha = 'a'..'z';
my @nums = 10 .. 20;
my @rands = map rand, 1 .. 10;
my $n = 23;
nForS{
print "$alpha[ $_[0] ] $nums[ $_[1] ] $rands[ $_[2] ] \n";
last unless --$n;
} \@state, 26, 11, 10;
print "First 23 perms; enter to continue"; <STDIN>;
nForS{
print "$alpha[ $_[0] ] $nums[ $_[1] ] $rands[ $_[2] ] \n";
} \@state, 26, 11, 10;
__DATA__
C:\test>junk
a 10 0.69268798828125
a 10 0.297698974609375
a 10 0.94830322265625
a 10 0.024749755859375
a 10 0.934661865234375
a 10 0.614898681640625
a 10 0.361328125
a 10 0.20947265625
a 10 0.556488037109375
a 10 0.879547119140625
a 11 0.69268798828125
a 11 0.297698974609375
a 11 0.94830322265625
a 11 0.024749755859375
a 11 0.934661865234375
a 11 0.614898681640625
a 11 0.361328125
a 11 0.20947265625
a 11 0.556488037109375
a 11 0.879547119140625
a 12 0.69268798828125
a 12 0.297698974609375
a 12 0.94830322265625
First 23 perms; enter to continue
a 12 0.94830322265625
a 12 0.024749755859375
a 12 0.934661865234375
a 12 0.614898681640625
a 12 0.361328125
a 12 0.20947265625
a 12 0.556488037109375
...
As you can imagine, with all the indirection, nFor() isn't fast, but it is supremely flexible.
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
In the absence of evidence, opinion is indistinguishable from prejudice.
Suck that fhit
| [reply] [d/l] [select] |
Re: Looking for combinatorics with state
by vr (Curate) on May 25, 2018 at 23:37 UTC
|
use strict;
use warnings;
use feature 'say';
use Math::GSL qw/ :all /;
use Math::GSL::Permutation qw/ :all /;
{
my $p = gsl_permutation_calloc( 5 );
say join '', map { gsl_permutation_get( $p, $_ )} 0 .. 4;
gsl_permutation_next( $p );
say join '', map { gsl_permutation_get( $p, $_ )} 0 .. 4;
my $f = gsl_fopen( 'gsl_test', 'w' );
gsl_permutation_fwrite( $f, $p );
gsl_fclose( $f );
gsl_permutation_free( $p );
}
say "\n...and next day..\n";
{
my $p = gsl_permutation_calloc( 5 );
my $f = gsl_fopen( 'gsl_test', 'r' );
gsl_permutation_fread( $f, $p );
gsl_fclose( $f );
say join '', map { gsl_permutation_get( $p, $_ )} 0 .. 4; # one repeat
+ from yesterday
gsl_permutation_next( $p );
say join '', map { gsl_permutation_get( $p, $_ )} 0 .. 4; # etc...
gsl_permutation_free( $p );
}
__END__
01234
01243
...and next day..
01243
01324
Just looked it all up (never worked with that), and if I understood what's required and how this library works, and not DRY... Just as pointer in possible direction, +this snippet ran practically as typed :)
| [reply] [d/l] |
Re: Looking for combinatorics with state (Updated)
by vr (Curate) on May 26, 2018 at 12:59 UTC
|
Considering,
Updated. Cleaner version, without (too much) poking inside other modules guts. + I always wanted to use the PadWalker for something real.
use strict;
use warnings;
use feature 'say';
use PadWalker qw/ closed_over set_closed_over /;
use Algorithm::Combinatorics qw/ combinations_with_repetition /;
my @data = qw( a b c );
my $state;
{
say "\tDay one, hard work ahead...";
my $iter = combinations_with_repetition( \@data, 3 );
say @{ $iter-> next } for 1 .. 5;
say "\tEnough work for one day!";
$state = closed_over( $iter );
}
{
say "\tDay 2, back to work...";
my $iter = combinations_with_repetition( \@data, 3 );
$iter-> next; # init
set_closed_over( $iter, $state );
say "\tDeadline! Exhaust the iterator!";
while ( my $c = $iter-> next ) { say @$c }
}
__END__
>perl comb.pl
Day one, hard work ahead...
aaa
aab
aac
abb
abc
Enough work for one day!
Day 2, back to work...
Deadline! Exhaust the iterator!
acc
bbb
bbc
bcc
ccc
We need the line with "init" comment because first call to iterator is special.
a not very clean hack would be:
use strict;
use warnings;
use feature 'say';
use Algorithm::Combinatorics qw( combinations_with_repetition );
package Algorithm::Combinatorics {
no warnings 'redefine';
sub main::combinations_with_repetition {
my ($data, $k, $ref) = @_;
__check_params($data, $k);
return __contextualize(__null_iter()) if $k < 0;
return __contextualize(__once_iter()) if $k == 0;
my @indices = $ref ? @$ref : (0) x $k;
my $iter = Algorithm::Combinatorics::Iterator->new(sub {
__next_combination_with_repetition(\@indices, @$data-1) == -1
+? undef : [ @{$data}[@indices] ];
}, [ @{$data}[@indices] ]);
my $x = __contextualize($iter); # Note: scalar context forced
return [ $x, \@indices ] # + interface changed
}
}
my @data = qw( a b c );
my ( $iter, $secret ) =
@{ combinations_with_repetition( \@data, 3 )};
say @{ $iter-> next } for 1..5;
my ( $iter_2 ) =
@{ combinations_with_repetition( \@data, 3, $secret )};
say '**********';
$iter_2-> next; # skip 1
while ( my $p = $iter_2-> next ) { say @$p }
__END__
aaa
aab
aac
abb
abc
**********
acc
bbb
bbc
bcc
ccc
| [reply] [d/l] [select] |
|
|
package Algorithm::Combinatorics { ... }
NB: The package NAMESPACE BLOCK syntax was not available prior to Perl version 5.14.
Update: It occurs to me that I should mention what is available if the aforementioned syntax is not. The following is essentially the same:
{ package NAMESPACE; statement; statement; ...; ... }
(Indeed, I think it's exactly equivalent, but I'm not quite sure about this :)
Give a man a fish: <%-{-{-{-<
| [reply] [d/l] [select] |
|
|
Yes, it is equivalent. When written on the same line as the opening curly bracket
{ package My::Package;
...
}
you can see the new feature only moved the bracket few words forward and removed a semicolon.
($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
| [reply] [d/l] [select] |
Re: Looking for combinatorics with state
by jimpudar (Pilgrim) on May 25, 2018 at 22:16 UTC
|
This sounds a bit like an XY Problem.
Maybe if you were more specific about what you are trying to do, or if you post some code which shows your attempts, we would be able to help you.
Best,
Jim
| [reply] |
Re: Looking for combinatorics with state
by stevieb (Canon) on May 25, 2018 at 20:29 UTC
|
There are several state-saving distributions/modules for Perl. Here, I will recommend JSON. JSON's a standard, and it is a cross-platform and cross-language storage format that is eerily similar to Perl's array reference and hash reference syntax. Example:
use warnings;
use strict;
use Data::Dumper;
use JSON;
my %data;
for (0..10){
$data{$_} = $_ * 5;
}
my $json = encode_json \%data;
open my $wfh, '>', 'saved.json'
or die "can't open the damned file for writing!: $!";
print $wfh $json;
close $wfh;
open my $fh, '<', 'saved.json'
or die "can't open the damned file for reading!: $!";
my $perl_href;
{
local $/;
$perl_href = decode_json $json
}
print Dumper $perl_href;
Output:
$VAR1 = {
'2' => 10,
'3' => 15,
'0' => 0,
'8' => 40,
'5' => 25,
'1' => 5,
'4' => 20,
'10' => 50,
'9' => 45,
'6' => 30,
'7' => 35
};
| [reply] [d/l] [select] |
|
|
You jumped on the word "state", but other than that, your answer is not relevant to the question.
| [reply] |
|
|
| [reply] |
Re: Looking for combinatorics with state
by Anonymous Monk on May 25, 2018 at 23:14 UTC
|
n=k+l
find all permutations for the first k letters and distribute them to different machines to find the remaining l letters. If you choose k reasonably you won't need to safe state, just finish l. | [reply] |
Re: Looking for combinatorics with state
by Anonymous Monk on Jun 01, 2018 at 18:56 UTC
|
i imagine this feature could be used like this:
my $perm = Permutation->new(\@data);
my $count = $perm->cardinality;
my $batches = 10;
my $batch_num = 3;
my $start = $count / $batches * $batch_num;
$perm->state($start);
$perm->run;
but these numbers can get large enough to require bigints. and bigints are slow enough to noticeably impact performance.
| [reply] [d/l] |
Re: Looking for combinatorics with state
by Anonymous Monk on Jun 10, 2018 at 06:21 UTC
|
| [reply] |