CGI/Perl Guide | Learning Center | Forums | Advertise | Login Site Search: in Perl Guide PerlGuru Forums Learning Ctr
 MAIN INDEX SEARCHPOSTS WHO'S ONLINE LOG IN

Home: Perl Programming Help: Beginner:
n Choose k

perlfarmer
User

Feb 1, 2012, 1:23 PM

Post #1 of 10 (2662 views)
 n Choose k Can't Post
Hi,

I don't have access to Math::Combinatorics on the machine I am working on (and I can't install it). So I need a routine that will take all combinations of size k from a set of size n. Not sure how to do this.

Any advice is appreciated.

Regards.

histrung
Novice

Feb 1, 2012, 2:52 PM

Post #2 of 10 (2647 views)
 Re: [perlfarmer] n Choose k [In reply to] Can't Post
 Code
`#!/usr/bin/perl use bignum; sub nCk {    my (\$n,\$k) = @_;    my (\$nFact,\$kFact,\$nkFact) = (1,1,1);    \$nFact *= \$_ foreach (1..\$n);    \$kFact *= \$_ foreach (1..\$k);    \$nkFact *= \$_ foreach (1..(\$n-\$k));    return (\$nFact/(\$kFact*\$nkFact)); } \$ans = nCk(10,3); print "Ans: \$ans\n";`
I tested it a little bit check it(no warrantee)
 Code
`nCk(10,3) = 120 # Correct nCk(100,90) = 17310309456440 # Correct`

perlfarmer
User

Feb 1, 2012, 3:06 PM

Post #3 of 10 (2644 views)
 Re: [histrung] n Choose k [In reply to] Can't Post
Thanks. But what I need is a way to extract all of the combinations from a set and, say, print them as opposed to just counting them. For example:

 Code
`nCk(4, 3, (e1, e2, e3, e4))`

would return:

 Code
`(e1, e2, e3), (e1, e2, e4), (e1, e3, e4), (e2, e3, e4)`

Regards.

(This post was edited by perlfarmer on Feb 1, 2012, 3:11 PM)

histrung
Novice

Feb 1, 2012, 3:08 PM

Post #4 of 10 (2642 views)
 Re: [perlfarmer] n Choose k [In reply to] Can't Post
Not sure what you mean.

perlfarmer
User

Feb 1, 2012, 3:12 PM

Post #5 of 10 (2640 views)
 Re: [histrung] n Choose k [In reply to] Can't Post
I just edited my response to be clearer.

Regards.

histrung
Novice

Feb 1, 2012, 3:34 PM

Post #6 of 10 (2633 views)
 Re: [perlfarmer] n Choose k [In reply to] Can't Post
Thinking

histrung
Novice

Feb 1, 2012, 10:11 PM

Post #7 of 10 (2612 views)
 Re: [histrung] n Choose k [In reply to] Can't Post
Turns out that is not as easy as I thought. That said I did find it in C and ported it to perl. The source of the port was http://www.netlib.no/netlib/toms/382
I don't have any error checking, so beware.

 Code
`./combo.pl 4 3 (e2,e3,e4),(e1,e3,e4),(e1,e2,e4),(e1,e2,e3)`
 Code
`#!/usr/bin/perl # # I ported this from C to perl using this code #       http://www.netlib.no/netlib/toms/382 #  # Original C information:   # Coded by Matthew Belmonte <mkb4@Cornell.edu>, 23 March 1996.   # This implementation Copyright (c) 1996 by Matthew Belmonte.   # Permission for use and distribution is hereby granted, subject to the  # restrictions that this copyright notice and reference list be included # in its entirety, and that any and all changes made to the program be  # clearly noted in the program text. # # Reference: # #  Phillip J Chase, `Algorithm 382: Combinations of M out of N Objects [G6]', #  Communications of the Association for Computing Machinery 13:6:368 (1970). #  sub inittwiddle {     my (\$m,\$n,\$aref) = @_;     my \$i;     \$\$aref[0] = \$n+1;     for (\$i=1; \$i != \$n-\$m+1; \$i++) {        \$\$aref[\$i] = 0;     }     while(\$i != \$n+1) {        \$\$aref[\$i] = \$i+\$m-\$n;        \$i++;     }     \$\$aref[\$n+1] = -2;     \$\$aref[1] = 1 if ( \$m == 0 ); }  sub twiddle {     my (\$xref, \$yref, \$zref, \$aref) = @_;     my (\$i,\$j,\$k) = (0,1,0);     while(\$\$aref[\$j] <= 0){        \$j++;     }     if ( \$\$aref[\$j-1] == 0) {        for (\$i=\$j-1;\$i != 1; \$i--) {           \$\$aref[\$i] = -1;        }        \$\$aref[\$j] = 0;        \$\$xref = 0;        \$\$zref = 0;        \$\$aref[1] = 1;        \$\$yref = \$j-1;     }     else {        \$\$aref[\$j-1] = 0 if ( \$j > 1 );        do {          \$j++;        } while(\$\$aref[\$j] > 0);        \$k = \$j-1;        \$i = \$j;        while ( \$\$aref[\$i] == 0 ) {           \$\$aref[\$i++] = -1;        }        if ( \$\$aref[\$i] == -1) {           \$\$aref[\$i] = \$\$aref[\$k];           \$\$zref = \$\$aref[\$k]-1;           \$\$xref = \$i-1;           \$\$yref = \$k-1;           \$\$aref[\$k] = -1;        }        else {          if ( \$i == \$\$aref[0] ){             return (1);          }          else {             \$\$aref[\$j] = \$\$aref[\$i];             \$\$zref = \$\$aref[\$i]-1;             \$\$aref[\$i] = 0;             \$\$xref = \$j-1;             \$\$yref = \$i-1;          }        }     }     return(0); }  sub nCk {    my (\$N,\$M) = @_;    my (\$i,\$x,\$y,\$z,\$ans) = (0,0,0,0,"");    my @p = ();    my @b = ();    my @tmp = ();    inittwiddle(\$M,\$N,\@p);    for (\$i=0; \$i != \$N-\$M; \$i++) {       \$b[\$i] = 0;       #print "0";       \$ans .= "0";    }    while(\$i != \$N) {       \$b[\$i++] = 1;       #print "1";       \$ans .= "1";    }    #print "\n";    push(@tmp,\$ans);    \$ans = "";    while(!twiddle(\\$x,\\$y,\\$z,\@p)){       \$b[\$x] = 1;       \$b[\$y] = 0;       for (\$i = 0; \$i != \$N; \$i++) {          #print \$b[\$i]?"1":"0";          if ( \$b[\$i] ) {              \$ans .= "1";          }          else {              \$ans .= "0";          }       }       #print "\n";       push(@tmp,\$ans);       \$ans = "";    }    my \$j;    foreach \$elm (@tmp) {       @each = split(//,\$elm);       \$ans = "(";       for(\$i=0; \$i<\$#each; \$i++) {          if ( \$each[\$i] ){             \$j = \$i+1;             \$ans .= "e\$j,";           }       }       if ( \$each[\$i]) {          \$j = \$i+1;          \$ans .= "e\$j)";       }       else {          \$ans = substr(\$ans,0,-1).")";       }       push(@ret,\$ans);     }     return @ret; }  ################# Main  if ( !defined(\$ARGV[0]) || !defined(\$ARGV[1])){    print "Usage: \$0 <n> <k>\n";    exit -1; }  @ans = nCk(\$ARGV[0],\$ARGV[1]);  print join(',',@ans);; print "\n";`

(This post was edited by histrung on Feb 2, 2012, 6:47 AM)

perlfarmer
User

Feb 2, 2012, 2:11 PM

Post #8 of 10 (2599 views)
 Re: [histrung] n Choose k [In reply to] Can't Post
Wow, thanks! I was totally stumped.

Regards.

histrung
Novice

Feb 2, 2012, 2:40 PM

Post #9 of 10 (2597 views)
 Re: [perlfarmer] n Choose k [In reply to] Can't Post
I thought it wasn't going to be hard, but I was wrong.

Hope it helps.

(This post was edited by histrung on Feb 2, 2012, 2:41 PM)

budman
User

Feb 12, 2012, 8:31 AM

Post #10 of 10 (2525 views)
 Re: [perlfarmer] n Choose k [In reply to] Can't Post
Hi

Thought I might try it out, I came up with a recursion version.

 Code
`#!/usr/bin/perl use strict;  if (scalar(@ARGV) != 2) {     print "Usage: \$0 k n\n";     print "  K items from set N\n";     exit 1; } my (\$k,\$n) = @ARGV; my @Set; push @Set, "e\$_" for (1 .. \$n);  my @Combos = combine(\$k,\@Set); my \$i = 0; printf "%d) %s\n",++\$i, "@\$_" for @Combos; print "Total Combinations: ",scalar(@Combos),"\n";  sub combine {     my (\$k, \$s) = @_;     my \$n = scalar(@\$s);     my @c = findcombos(\$k,\$n);     my @b;     foreach my \$r (@c) {         my @cmb;         push @cmb, \$s->[\$_] for @\$r;          push @b, [ @cmb ];     }     return @b; }  sub findcombos {     my (\$k,\$n,\$level,\$c,\$b) = @_;     \$level ||= 0;      # initialize arrays     unless (ref(\$c)){         push @\$c, \$_ for (0 .. \$k-1);         \$b = [];     }          my \$i = \$level;     while ( \$i < \$n && \$c->[\$level] < \$n ) {         if ( \$level + 1 == \$k ) {             #print "@\$c\n";             push @\$b, [ @\$c ];             \$c->[\$level]++;         }         else {             findcombos(\$k,\$n,\$level+1,\$c,\$b);             # advance and reset counters             my \$v = \$c->[\$level] + 1;             \$c->[\$_] = \$v++ for (\$level .. \$#\$c);         }         \$i++;     }     return @\$b unless \$level; }`

I think it may be similar to combine.
I use the arrays to keep track of the levels while processing.

Output:

cmb.pl 4 7
1) e1 e2 e3 e4
2) e1 e2 e3 e5
3) e1 e2 e3 e6
4) e1 e2 e3 e7
....
33) e3 e4 e6 e7
34) e3 e5 e6 e7
35) e4 e5 e6 e7
Total Combinations: 35

Rich

(This post was edited by budman on Feb 12, 2012, 8:39 AM)

 Announcements     PerlGuru Announcements Perl Programming Help     Frequently Asked Questions     Beginner     Intermediate     Advanced     Regular Expressions     mod_perl     DBI     Win32 Programming Help Fun With Perl     Perl Quizzes - Learn Perl the Fun Way     Perl Golf     Perl Poetry Need a Custom or Prewritten Perl Program?     I need a program that...     I Need a Programmer for Freelance Work     Throw Down The Gauntlet General Discussions     General Questions     Feedback     Tutorial/Article Suggestions for The Learning Cent     Internet Security Other Programming Languages     Javascript     PHP

 Search this forum this category all forums for All words Any words Whole Phrase (options) Powered by Gossamer Forum v.1.2.0