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:
Permutations

 



meconopsis
Novice

Jun 27, 2015, 3:16 PM

Post #1 of 11 (3693 views)
Permutations Can't Post

I've written some perl to solve a "26 variables A..Z each having a unique value in range 1..26" problem given constraints such as "w*w=x" etc.

It works a treat and runs in under 10 seconds.

But I think the "perm" subroutine and the way I call it is ugly. Is there a better way of doing this.

The subroutine accepts an input array, an output scalar, an option counter and an output array. It chooses one scalar from the input array and returns it (or "" if all done) and copies all the other entries in the input array to the output array. Are references actually needed?

The code (in part) is:

Code
sub perm { 
$iref = shift( @_ ) ; # input array for this variable.
$vref = shift( @_ ) ; # value to/from input array, this variable.
$cref = shift( @_ ) ; # down count before end of perm
$oref = shift( @_ ) ; # output array for next variable to use.

$$cref = @$iref + 1 unless $$vref ;
push( @$iref, $$vref ) if $$vref ;
if ( --$$cref ) {
$$vref = shift( @$iref ) ;
} else {
$$vref = "" ;
}
@$oref = @$iref ;
return $$vref ;
}

@wo = ( 1..26 ) ;
$a = $b = $c = $d = $e = $f = $g = $h = $i = $j = $k = $l = $m = "" ;
$n = $o = $p = $q = $r = $s = $t = $u = $v = $w = $x = $y = $z = "" ;
$cnt = 0 ;

while ( perm( \@wo, \$w, \$wc, \@xo ) ) {
while ( perm( \@xo, \$x, \$xc, \@yo ) ) {
next unless $w * $w == $x ; ### 6
while ( perm( \@yo, \$y, \$yc, \@zo ) ) {
etc...



Laurent_R
Veteran / Moderator

Jun 28, 2015, 7:15 AM

Post #2 of 11 (3672 views)
Re: [meconopsis] Permutations [In reply to] Can't Post

Hi meconopsis,

I do not understand what you are trying to do and since you don't supply the full code, it is difficult to figure out what there might be in the missing part. So I can't comment on your algorithm, not knowing what it is supposed to do.

I would only say that you should use (as much as possible) lexical variables (declared with my in the smallest possible scope (rather than global package variables as you do), and you should start your programs with the following pragmas:

Code
use strict; 
use warnings;

Initially, this will probably fill your screen with warnings of all sorts and probably refuse to compile, but then you'll find out soon that it is extremely useful to find subtle bugs and write better code.


BillKSmith
Veteran

Jun 28, 2015, 12:28 PM

Post #3 of 11 (3658 views)
Re: [meconopsis] Permutations [In reply to] Can't Post

I do not understand your problem well enough to suggest a better solution. (I suspect that you should be using a CPAN module to generate the permutations.) However, I can suggest improvements to your perl style. I will not address the issue of execution speed because it is more important to develop programs that people can understand. (If speed becomes a problem, we can use tools to identify the problem areas and consider changes to them.)
The first problem with your code is that it uses far too many variables. (All of them global and most implicitly declared.) Good practice dictates (as Laurnt already posted) that we should always use the pragmas “use strict” and “use warnings”. Strict requires that we explicitly declare all variables. We help the reader of our code if declare all variables as lexical and declare them in the smallest possible scope. In your case, this requires lot of additional typing, but it is still a good first step. Also note that all your variables are intended to contain only integer values. Initializing them to a null string misleads the reader into thinking that they will contain strings. If you do not initialize them at all, they will have the value undef. Like the null string, this value is considered false.

Code
sub perm { 
my $iref = shift(@_); # input array for this variable.
my $vref = shift(@_); # value to/from input array, this variable.
my $cref = shift( @_ ) ; # down count before end of perm
my $oref = shift(@_); # output array for next variable to use.

$$cref = @$iref + 1 unless $$vref;
push( @$iref, $$vref ) if $$vref;
$$vref = --$cref ? shift @$iref : undef;
@$oref = @$iref;
return $$vref;
}

#$a = $b = $c = $d = $e = $f = $g = $h = $i = $j = $k = $l = $m = "";
#$n = $o = $p = $q = $r = $s = $t = $u = $v = $w = $x = $y = $z = "";
#$cnt = 0;

my @wo = ( 1 .. 26 );
my $w;
my $wc;
my @xo;
while ( perm( \@wo, \$w, \$wc, \@xo ) ) {
my $x;
my @yo;
while ( perm( \@xo, \$x, \$xc, \@yo ) ) {
next unless $w * $w == $x; ### 6
my $y;
my @zo;
while ( perm( \@yo, \$y, \$yc, \@zo ) ) {
# etc...
}
}
}


I find it confusing that every call to the subroutine has two arguments (the second and third) which are only referenced from within the subroutine. With some effort, we discover that they are defined this way to provide each instance of the subroutine with its own set of persistent memory. Unfortunately, every solution that I have considered for this problem has equally bad problems.

Please try to give us a complete description of your problem. Post a complete working example for a simpler case (perhaps only three or four variables rather than twent-six.) We can help you find a better solution and then later generalize for the full problem.
Good Luck,
Bill


meconopsis
Novice

Jun 28, 2015, 2:03 PM

Post #4 of 11 (3647 views)
Re: [BillKSmith] Permutations [In reply to] Can't Post

OK, here is the whole thing.


Code
sub perm { 
$iref = shift( @_ ) ; # input array for this variable.
$vref = shift( @_ ) ; # value to/from input array, this variable.
$cref = shift( @_ ) ; # down count before end of perm
$oref = shift( @_ ) ; # output array for next variable to use.

$$cref = @$iref + 1 unless $$vref ;
push( @$iref, $$vref ) if $$vref ;
if ( --$$cref ) {
$$vref = shift( @$iref ) ;
} else {
$$vref = "" ;
}
@$oref = @$iref ;
return $$vref ;
}

@wo = ( 1..26 ) ;
$a = $b = $c = $d = $e = $f = $g = $h = $i = $j = $k = $l = $m = "" ;
$n = $o = $p = $q = $r = $s = $t = $u = $v = $w = $x = $y = $z = "" ;
$cnt = 0 ;

while ( perm( \@wo, \$w, \$wc, \@xo ) ) {
while ( perm( \@xo, \$x, \$xc, \@yo ) ) {
next unless $w * $w == $x ; ### 6
while ( perm( \@yo, \$y, \$yc, \@zo ) ) {
while ( perm( \@zo, \$z, \$zc, \@io ) ) {
next unless $x * $y == $z ; ### 7
while ( perm( \@io, \$i, \$ic, \@ao ) ) {
next unless $i * $w == $z ; ### 14
while ( perm( \@ao, \$a, \$ac, \@bo ) ) {
$aa = $a * $a ;
while ( perm( \@bo, \$b, \$bc, \@co ) ) {
next unless $b < $aa ; ### (1)
while ( perm( \@co, \$c, \$cc, \@do ) ) {
next unless $aa == $b + $c ; ### 1
while ( perm( \@do, \$d, \$dc, \@eo ) ) {
while ( perm( \@eo, \$e, \$ec, \@fo ) ) {
while ( perm( \@fo, \$f, \$fc, \@go ) ) {
next unless $c + $d == $e * $f ; ### 2
while ( perm( \@go, \$g, \$gc, \@ho ) ) {
while ( perm( \@ho, \$h, \$hc, \@jo ) ) {
next unless $g + $h == $i ; ### 3
while ( perm( \@jo, \$j, \$jc, \@ko ) ) {
while ( perm( \@ko, \$k, \$kc, \@oo ) ) {
next unless $h + $j == $k ; ### 4
while ( perm( \@oo, \$o, \$oc, \@to ) ) {
next unless $e * $y == $o ; ### 10
while ( perm( \@to, \$t, \$tc, \@qo ) ) {
next unless $e + $t == $g ; ### 11
while ( perm( \@qo, \$q, \$qc, \@no ) ) {
next unless $a * $e == $q ; ### 13
while ( perm( \@no, \$n, \$nc, \@vo ) ) {
next unless $n + $t == $f ; ### 12
while ( perm( \@vo, \$v, \$vc, \@lo ) ) {
next unless $h + $o == $v * $w ; ### 8
while ( perm( \@lo, \$l, \$lc, \@mo ) ) {
while ( perm( \@mo, \$m, \$mc, \@ro ) ) {
next unless $m + $n == $l ; ### 5
while ( perm( \@ro, \$r, \$rc, \@so ) ) {
while ( perm( \@so, \$s, \$sc, \@po ) ) {
next unless $g + $s == $r ; ### 9
while ( perm( \@po, \$p, \$pc, \@uo ) ) {
while ( perm( \@uo, \$u, \$uc, \@_o ) ) {
next unless $p + $w == $u ;
print "a$a b$b c$c d$d e$e f$f g$g h$h i$i j$j k$k l$l m$m " ;
print "n$n o$o p$p q$q r$r s$s t$t u$u v$v w$w x$x y$y z$z\n" ;
$cnt++;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
print "$cnt " ;


Do all the perm parameters NEED to be variable references, or is there a neater way of doing it?

The program intentionally uses 26 sets of 3 global variables.
(1) An array containing numbers or strings - in this instance it is numbers, but strings is also possible in other applications. The perm subroutine works its way through the array returning a new value from the array on each call until such time as all the array has been used when it returns an empty string.
(2) A scalar containing the current value from the array which has been shrunk by that value. (eg is array started life as [a, b, c, d] then after the first call, the scalar would contain 'a' and the array [b, c, d]. On the next call, the scalar is put back onto the array and another value returned in the scalar 'b' and [c, d, a].
(3) A counter which says how many times to do the above before returning "" instead of an array value.


FishMonger
Veteran / Moderator

Jun 28, 2015, 3:21 PM

Post #5 of 11 (3636 views)
Re: [meconopsis] Permutations [In reply to] Can't Post

26 nested while loops? Ouch/yuck/icky!!

Either use one of the related modules on CPAN or learn how to use the int, rand and pop functions.

Here are some of the choices.

Math::Combinatorics - Perform combinations and permutations on lists
http://search.cpan.org/dist/Math-Combinatorics/lib/Math/Combinatorics.pm

Math::Permute::Array - Perl extension for computing any permutation of an array. The permutation could be access by an index in [0,cardinal] or by iterating with prev, cur and next.
http://search.cpan.org/~jnquintin/Math-Permute-Array-0.043/lib/Math/Permute/Array.pm

Algorithm::Permute - Handy and fast permutation with object oriented interface
http://search.cpan.org/~edpratomo/Algorithm-Permute-0.12/Permute.pm

Algorithm::FastPermute - Rapid generation of permutations
http://search.cpan.org/~robin/Algorithm-FastPermute-0.999/FastPermute.pm

Math::GSL::Combination - Combinations
http://search.cpan.org/~ambs/Math-GSL-0.35/lib/Math/GSL/Combination.pm


(This post was edited by FishMonger on Jun 28, 2015, 3:30 PM)


meconopsis
Novice

Jun 28, 2015, 4:28 PM

Post #6 of 11 (3623 views)
Re: [FishMonger] Permutations [In reply to] Can't Post

There's nowt wrong with 26 nested while loops - especially here where I trim them down using 'next' as I go, so the whole thing runs fast enough.

I just want to know if I have to do the subroutine part using references, or is there a better way.


FishMonger
Veteran / Moderator

Jun 28, 2015, 5:11 PM

Post #7 of 11 (3617 views)
Re: [meconopsis] Permutations [In reply to] Can't Post


Quote
the whole thing runs fast enough

Maybe for you, but it's far from being fast . My test runs took over 3 seconds for a task that should only take a fraction of a second and that code is not very maintainable.


Quote
I just want to know if I have to do the subroutine part using references, or is there a better way.

When passing multiple arrays to a sub, you need to pass them as references. The scalars don't need and rarely ever be passed as references.

Yes, there are much better ways to do this such as using one of the proven modules which have been tested by millions of people. If you don't want to use one of the modules, then at least look over their code to get better ideas on how to accomplish this task.


BillKSmith
Veteran

Jun 29, 2015, 6:42 AM

Post #8 of 11 (3564 views)
Re: [meconopsis] Permutations [In reply to] Can't Post

First let me try to accurately describe the problem. You wish to find one (at least) permutation of twenty-six objects (in this case integers) which satisfies a set of (in this case sixteen) constraints.

Your solution searches a tree of possible permutations, pruning entire branches as soon as a single violation is found. All that is left is the solution! I doubt that you could find an algorithm that is faster in theory.

The problem is in your implementation. (I will admit that thirty-five years ago, I would have considered the FORTRAN equivalent of this code to be an excellent program.) In the mean time, we have learned a great deal about the importance of maintainable code and things that we should (and should not) do to achieve it. When subroutines were invented, they were only used to avoid repeating code by gathering common fragments in one place. (Your perm is an excellent example of this.)

I can now answer your specific question about references. Given this design of perm (note that it uses all of its arguments for both input and output.) and perl's argument passing mechanism, all the arguments must indeed be passed as references.

No one is willing to work on your full program. It is just to hard to make even simple changes. (This of course is the issue which needs improvement.) In my previous post, I asked you to make up and post a simple example (The permutation of three or four objects with only one or two constraints) that we could work on. We understand that a solution would not be of any use unless it can be generalized to at least twenty-six objects.

Do not expect much more help if your are not willing to do your part.
Good Luck,
Bill


meconopsis
Novice

Jun 29, 2015, 11:48 AM

Post #9 of 11 (3539 views)
Re: [BillKSmith] Permutations [In reply to] Can't Post

OK, here is a 4 variable version. (I haven't actually run it.)


Code
sub perm { 
$iref = shift( @_ ) ; # input array for this variable.
$vref = shift( @_ ) ; # value to/from input array, this variable.
$cref = shift( @_ ) ; # down count before end of perm
$oref = shift( @_ ) ; # output array for next variable to use.

$$cref = @$iref + 1 unless $$vref ;
push( @$iref, $$vref ) if $$vref ;
if ( --$$cref ) {
$$vref = shift( @$iref ) ;
} else {
$$vref = "" ;
}
@$oref = @$iref ;
return $$vref ;
}

@wo = ( 1..4 ) ;
$w = $x = $y = $z = "" ;
$cnt = 0 ;

while ( perm( \@wo, \$w, \$wc, \@xo ) ) {
while ( perm( \@xo, \$x, \$xc, \@yo ) ) {
next unless $w * $w == $x ;
while ( perm( \@yo, \$y, \$yc, \@zo ) ) {
while ( perm( \@zo, \$z, \$zc, \@io ) ) {
next unless $w + $y == $z ;
print "w$w x$x y$y z$z\n" ;
$cnt++;
}
}
}
}
print "$cnt " ;



(This post was edited by meconopsis on Jun 29, 2015, 11:49 AM)


BillKSmith
Veteran

Jun 30, 2015, 12:47 PM

Post #10 of 11 (3493 views)
Re: [meconopsis] Permutations [In reply to] Can't Post

I am still looking into your problem. Your simple test case does run and find one solution. It is a big help in understanding the full problem.

So far, I have made a number of minor improvements, but have made no progress in eliminating the deeply nested loops. Both Fishmonger and I had suggested using a CPAN module to generate the permutations. Unfortunately, I do not see a way to integrate your concept of "next" with this. Testing all 26! permutations is clearly out of the question.

I hope that you consider my change to the subroutine interface an improvement.

Code
use strict; 
use warnings;
my @wo = (1..4 ) ;
my @zo;
my($w, $x, $y, $z);
my $cnt = 0 ;

my @xo;
W:
while ( $w = perm( \@wo, $w, 0, \@xo ) ) {
my @yo;
X:
while ( $x = perm( \@xo, $x, 1, \@yo ) ) {
next X unless $w * $w == $x ;
my @zo;
Y:
while ( $y = perm( \@yo, $y, 2, \@zo ) ) {
my @io;
Z:
while ( $z = perm( \@zo, $z, 3, [] ) ) {
next Z unless $w + $y == $z ;
print "w=$w x=$x y=$y z=$z\n" ;
$cnt++;
}
}
}
}
print "$cnt Solution(s) found.\n" ;

sub perm {
my $iref = shift( @_ ) ; # input array for this variable.
my $v = shift( @_ ) ; # value to/from input array, this variable.
my $c = shift( @_ ) ; # Index to specify counter
my $oref = shift( @_ ) ; # output array for next variable to use.
CORE::state @counts;

if ($v) {
push( @$iref, $v ) ; # Restore previous element
}
else {
$counts[$c] = @$iref + 1 ; # Set length of fifo list.
}
my $out_char = --$counts[$c] ? shift @$iref : undef;
@$oref = @$iref ;
return $out_char ;
}


OUTPUT:

Code
w=2 x=4 y=1 z=3 
1 Solution(s) found.



Your algorithm can probably be implemented as a recursion. Such a solution should be much easier to maintain. So far, I have not been able to get it rightFrown
Good Luck,
Bill


meconopsis
Novice

Jun 30, 2015, 3:23 PM

Post #11 of 11 (3489 views)
Re: [BillKSmith] Permutations [In reply to] Can't Post

Some useful tips in there. Thanks Bill.

 
 


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

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