CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Beginner: Re: [histrung] n Choose k: Edit Log



histrung
Novice

Feb 1, 2012, 10:11 PM


Views: 1442
Re: [histrung] n Choose k

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)


Edit Log:
Post edited by histrung (Novice) on Feb 2, 2012, 6:22 AM
Post edited by histrung (Novice) on Feb 2, 2012, 6:36 AM
Post edited by histrung (Novice) on Feb 2, 2012, 6:47 AM


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives