[FWP] Cookbook Inspired Equation Solver.

[Alistair.McGlinchy@marks-and-spencer.com]

Hi All,

I was flipping through the cookbook yesterday and discovered the section
(4.19) on permutations. When I was looking through the table I noticed that
10! is only 3.6 million. That's not a very big number these days I thought.
The combination of this and thoughts of my first game of Perl golf lead to
writing the code at the bottom of the page 

The original question was to find unique digits A,B, ..., I between 1 and 9
such that ABCD / EFGHI = 1 / 66.  I think the best result from this game was
written as:
perl -le"print grep{($_.$_*66)!~/(.).*\1|0/}1e3..1e4"

Anyway below is some code which will solve this any of those silly equations
for you. But it still takes too long, as far as I'm concerned because all
3.6 Million are checked one by one.  Now that I've written it I'm thinking
of lots of ways to speed it up.
- Mark-Jason Dominus' algorithm seemed the obvious place to start, but I
couldn't quickly work out where to put the firstChar<>0 escape clause.
- Given that perms of 0..9 (or 1..9) are in a sense constant. I wonder if a
text file cache of all the perms would be faster than computing them every
time? 
- Also is the s///  and eval combination really the best way of doing this

Any ideas or comments?

[Evil thought:  Should I dare one of you to turn this into a golf competion.
Te hee!}

Cheers,

Alistair 
(my apologies for the uncontrollably big .sig file)
########################################
use strict;
my $line = "ABCD / EFGHI == 1 / 66";
# my $line = "C + AWK + APL + GREP == PERL";
my @vals=1..9;

my (%chars,@chars);
map {$chars{$_}=1} grep /[A-Z]/, split //,uc($line);
@chars=keys %chars;
die "Too many chars for distinct charcters ".join(",",@chars)."\n" if
@chars>@vals;

my %firstChars;
$firstChars{$1}=1 while ($line=~/\b([A-Z])/ig);

print "Solving:\n$line\n";
permute([@vals], []);

sub permute {
    my @items = @{ $_[0] };
    my @perms = @{ $_[1] };
    unless (@items) {
		$_=$line;
		for my $i (0..$#chars) {
			s/$chars[$i]/$perms[$i]/eg;
		} 
		print "$_\n" if eval;
    } else {
        my(@newitems,@newperms,$i);
        foreach $i (0 .. $#items) {
			# $items[$i] will be added to the begining of the
perms
			# this will eventually become the $#items-th entry
in the complete perm
			# we must bail if this is 0 and it will be assigned
to a key of firstChars
			next if ($items[$i]==0 and
$firstChars{$chars[$#items]});
            @newitems = @items;
            @newperms = @perms;
            unshift (@newperms,splice(@newitems, $i, 1));
            permute([@newitems], [@newperms]);
        }
    }
}


__________________________________________________________________________________________

Registered Office:
Marks and Spencer plc
Michael House, Baker Street,
London, W1A 1DN
Registered No. 214436 in England and Wales.

Telephone  (020) 7935 4422
Facsimile  (020) 7487 2670

www.marks-and-spencer.com

This e-mail is Confidential. If you received it by mistake, please let us know and then
delete it from your system; you should not copy, disclose, or distribute its contents to
anyone nor act in reliance on this e-mail, as this is prohibited and may be unlawful.
___________________________________________________________________________________________

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe