Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Update:Having heard back from the author of the original C-source of this algorithm, he asked me to change the email address to his new one.

Not as concise as most of the others, but it seems fairly efficient for both memory and speed.

It probably could be golfed some more, but it defeated my attempts so far.

If your application calls for sub-setting different sets, but with the same size of both subset and set, you can generate the subsets of indices to the sets, rather that the subsets themselves and reuse the indices.

#! perl -w use strict; =pod Bit-twiddling transpositional combination generator in Perl, © 2002,BrowserUK / perlmonks.com Based upon a C implementation by Doug Moore (unkadoug@yahoo.com). Source:http://www.caam.rice.edu/~dougm/twiddle/yargbitcomb.c =cut sub Lshift1 { use integer; my $i = shift; my $ii = $i>>1; return 1 << $ii << ($i - $ii); } sub yargFirstComb # Returns the inverse gray code (yarg) of the first combination of k i +tems (i.e. {0,1,..,k-1}) { use integer; my $kk = Lshift1($_[0])-1; return $kk ^ $kk/3; }; sub leastItem # Returns the least item in a combination (i. e. leastItem({2,4,5}) == + {2} { use integer; return $_[0] & -$_[0]; }; sub yargLastComb # Returns the yarg of the last combination of k items from n (i.e. {n- +k,..,n-1}) { use integer; my ($nn, $kk) = ( Lshift1($_[0])-1, Lshift1($_[1])-1); return ($_[1]) ? $nn ^ ($kk/3) : 0; }; # Returns the yarg of the next combination after yarg input sub yargNextComb { use integer; my $comb = shift; my $grey = ($comb << 1) ^ $comb; my $i = 2; my $candidateBits; do { my $y = ($comb & ~($i - 1)) + $i; my $j = leastItem( $y ) << 1; my $h = !!($y & $j); $candidateBits = (($j - $h) ^ $grey) & ( $j - $i ); $i = $j; } while (!$candidateBits); return $comb + leastItem($candidateBits); } sub factorial { no integer; my ($f,$n) = (1,shift); $f *= $n-- while( +$n ); return $f; } sub subsets { use integer; my @AoAoCombs; my ($k, $n, $combs) = (shift, shift, 0); { no integer; $combs = factorial($n)/(factorial($k)*factorial($n-$k)); print "Generating $combs subsets of $k from a set of $n\n"; $#AoAoCombs = $combs-1; #pre-extend t +he array of array refs to its final size } die "Usage: subsets k, n\nGenerate subsets of k-elements from a se +t of n-elements where k < n.\n" unless $n and $k and $k < $n; my $comb = yargFirstComb($k); my $lastcomb = yargLastComb( $n, $k); while(1) { my $member = 0; #!! my $c = $comb ^ ($comb >> 1); # 'push' anon array ref & pre-extend anon. array space $AoAoCombs[--$combs] = []; $#{$AoAoCombs[$combs]} = $k-1; ($c & Lshift1($_)) and @{$AoAoCombs[$combs]}[$member++] = $_ f +or 0 .. $n-1; # 'unshift' last if $comb == $lastcomb; $comb = yargNextComb($comb); } return \@AoAoCombs; } my $AoAoCombs = subsets 2, 4; # Generate combinations of indices my @data1 = qw( just another perl hacker ); local $,=' '; print "Applying combined indices to @data1\n\n"; print @data1[ @{$AoAoCombs->[$_]} ], $/ for (0 .. $#$AoAoCombs); my @data2= (1,2,3,4); print "\nApplying combined indices to @data2\n\n"; print @data2[ @{$AoAoCombs->[$_]} ], $/ for (0 .. $#$AoAoCombs); # App +ly the indices to as many sets as you like print $/; no integer; my @data3 = (1..31); my @times = (times); my $start = $times[0] + $times[1]; $AoAoCombs = subsets 26, ~~@data3; @times = times; my $end = $times[0]+$times[1]; print "Generating " . @{$AoAoCombs} . " combinations of 26 from 31 too +k ", $end-$start, " seconds of cpu P-II\@233MHz\n", "including generating 169911 x 26 element anonymous arrays to stor +e the results.\n"; #print "\nApplying combined indices to @data1\n\n"; #print @data1[@{$^AoAoCombs[$_]}], $/ for (0..$#{$AoAoCombs}); + # Apply the indices __END__ # Output C:\test>191902 Generating 6 subsets of 2 from a set of 4 Applying combined indices to just another perl hacker just hacker another hacker perl hacker just perl another perl just another Applying combined indices to 1 2 3 4 1 4 2 4 3 4 1 3 2 3 1 2 Generating 169911 subsets of 26 from a set of 31 Generating 169911 combinations of 26 from 31 took 251.51 seconds of +cpu P-II@233MHz including generating 169911 x 26 element anonymous arrays to store th +e results. C:\test>

What's this about a "crooked mitre"? I'm good at woodwork!

In reply to Re: Combinatorics by BrowserUk
in thread Combinatorics by ezekiel

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2024-03-29 02:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found