gmane.comp.lang.perl.qotw.discuss

Perl QOTW #2010-02-22 - Freecell Scans with Short Solutions

Shlomi Fish — 2010-02-22T15:31:32

IMPORTANT: Please do not post solutions, hints, or other spoilers
until at least 60 hours after the date of this message.  Thanks.

Requests for clarifications and other discussion would be OK.

---------------

Today I'm borrowing the collective wisdom of the Perl Quiz-of-the-Whatever
forum for an algorithmic task I need to accomplish for my own project.
The project in question is Freecell Solver ( http://fc-solve.berlios.de/ ),
which is an automated solver for http://en.wikipedia.org/wiki/FreeCell and 
several other types of card solitaire. 

fc-solve starts from the initial layout of the solitaire game and recurses
into more and more positions, which are counted by the solver's iterations,
until it reaches the final, solved state where all cards were moved to the
foundations.

After a certain number of iterations (which are roughly indicative of 
how long it took it to run), it yields a solution of a certain length ,which 
is desired to be as short as possible. Note that it may also report that it
is unable to solve the board (after going over all the derived positions) or 
that it could not find a solution within the quota of iterations that have
been allocated for it. 

Now, fc-solve has many different atomic scans, that when run alone, each
yields different solutions with different iteration counts and lengths.

In this Subversion directory, I have collected the iterations counts and the
solutions lengths of a sample of boards - the first 32,000 games in Microsoft
Windows FreeCell:

http://svn.berlios.de/svnroot/repos/fc-solve/trunk/fc-solve/presets/soft-
threads/meta-moves/auto-gen/

(short URL - http://xrl.us/bgwj3o ; there's also an https:// equivalent, which
may work better, but it's a self-signed certificate).

After installing the dependencies - PDL (= the Perl Data Language) , 
Class::XSAccessor and Exception::Class (and maybe some others) you can query 
it by using the script query.pl like that:

<<<
shlomi[fcs]:$presets$ scan_id="1"
shlomi[fcs]:$presets$ board_idx="120"
shlomi[fcs]:$presets$ perl query.pl -l "$scan_id" "$board_idx"
123
128

(First line is the iterations count; second line is the solution's length).

You probably would like to inspect the query.pl source code and
see how you can access the data directly using PDL, and possibly use PDL
to convert it to a different format.

Now, what I'd like to do is create a meta-scan that runs several of these
individual scans one after the other, each with a certain quota of iterations, 
and will select the shortest solution of all those that were able to solve
the board. 

Let's look at a numeric example (based on the actual statistics):

----------------------------------------------------------------
Deal No. | Scans Statistics                                    |
         | 1 Iters | 1 Len | 2 Iters | 2 Len | 3 Iters | 3 Len |
----------------------------------------------------------------
 1       |  123    | 127   |  1711   | 120   | 1285    | 161   |
 2       |   98    | 145   |    96   | 138   |   98    | 107   |
 3       |  125    | 115   |   104   | 109   |   93    | 110   |
 4       |  117    | 123   |   236   | 129   |  447    | 153   |
 5       |  110    | 143   |   101   | 136   |  691    | 175   |
 6       |  403    | 176   |   262   | 122   |  125    | 130   |
 7       | 1260    | 134   |   307   | 125   | 1823    | 165   |
 8       |   70    |  98   |    70   |  98   |  122    | 125   |
 9       |   -1    |  -1   | 47169   | 135   | 1097    | 136   |
10       |  189    | 135   |   115   | 125   | 3043    | 202   |
----------------------------------------------------------------

Now if I allocate 400 iterations to each of the three scans here (and
none to any other) then for deal #1, scan #1 will yield a solution of
127 steps, while scan #2 will not yield any solution at all (since it requires
1,711 iterations) and neither will scan #3 giving us a solution of 127 moves.

For deal #2 all scans will finish well before the iterations limit, and the
shortest solution chosen will be scan #3 with its 107 steps solution. 

Etc.

Let's suppose I have a total of $tot iterations to split among all the 
scans in scans.txt in the distribution, into < at >q[0 .. $last_scan] quotas.

My question is: given $tot, what should < at >q be so it will, on average,
yield the shortest solutions for the 32,000 sample board?

Hope you enjoy this quiz.

Regards,

Shlomi Fish

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Peter Scott — 2009-10-13T04:40:37

My last submission was more for clarity than efficiency.  This one is 
a bit more efficient, in generating the list for one side in advance, 
but a bit less clear:

use strict;
use warnings;

my ($left, $right) = < at >ARGV;

my < at >left;
iter( $left,  sub { push < at >left, shift                                     } );
iter( $right, sub { eval == eval $_[0] and print "$_ = $_[0]\n" for < at >left } );

sub iter
{
   my ($side, $cb) = < at >_;

   my $count = length($side) - 1;
   for my $num ( 0 .. 2**$count - 1)
   {
     my $i = $count;
     (my $side = $side) =~ s/(.)(?=.)/$1 . ($num & 1 << --$i ? '+' : '')/ge;
     $cb->( $side );
   }
}

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Peter Scott — 2009-10-12T19:54:23

Here's my solution, which also uses binary number counting to decide 
where to put the + signs.  I have been unable to remove the duplicated 
code without making it much less clear and no shorter.

use strict;
use warnings;

my ($left, $right) = < at >ARGV;

my ($count_left, $count_right) = map { length() - 1 } ($left, $right);

for my $left_num ( 0 .. 2**$count_left - 1)
{
   my $left = $left;
   my $i = $count_left;
   $left =~ s/(.)(?=.)/$1 . ($left_num & 1 << --$i ? '+' : '')/ge;

   for my $right_num ( 0 .. 2**$count_right - 1 )
   {
     my $right = $right;
     my $i = $count_right;
     $right =~ s/(.)(?=.)/$1 . ($right_num & 1 << --$i ? '+' : '')/ge;
     print "$left == $right\n" if eval $left == eval $right;
   }
}

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : PlusifiedEquations

Josh Narins — 2009-10-08T00:04:21

http://www.flowersofpeace.com/telephone_code.html

Since I, by default, use +, - * and / I also make sure not to divide by zero :)



On Wed, Oct 7, 2009 at 1:50 PM, Jeff Yoak <jeff-orzAD85Mt8U< at >public.gmane.org> wrote:

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Jeff Yoak — 2009-10-07T17:50:52

Somehow I missed the original statement of the problem, but these  
solutions, perhaps with a slight mod in some cases, could be used to  
solve the current problem at http://mathfactor.uark.edu/ .  As the  
poster of that particular problem, I can say that anyone who wanted to  
share code with a solution would be welcome.

Cheers,
Jeff

On Oct 7, 2009, at 9:55 AM, Ronald J Kimball wrote:

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Ronald J Kimball — 2009-10-07T16:55:00

Yay, the list is back.  Here's my solution.  I generate the plusified
expressions iteratively by doing repeated increments, treating the
expression itself as a binary string with '+' and '' representing 1 and 0:

  s/(.*\d)(\d.*)/my $x = $2; $x =~ tr!+!!d; "$1+$x"/e

To be more efficient, I don't store both sets of results.  First, I
calculate and store the results for the second expression only.  Then, I
generate results one at a time for the first expression, print any matches
immediately, and throw away the result.  This gives the correct order of
output without any sorting.

#!perl

use strict;
use warnings;

< at >ARGV == 2
  or die usage();

foreach (< at >ARGV) {
  /^\d+\z/
    or die usage();
}

my %p2;

my ($p1, $p2) = < at >ARGV;

do {
  push < at >{ $p2{do_eval($p2)} }, $p2;
} while ($p2 = next_plusify($p2));

do {
  if (my $match = $p2{do_eval($p1)}) {
    print "$p1 = $_\n" for < at >$match;
  }
} while ($p1 = next_plusify($p1));

sub next_plusify {
  my ($exp) = < at >_;
  $exp =~ s/(.*\d)(\d.*)/my $x = $2; $x =~ tr!+!!d; "$1+$x"/e
    or return;
  return $exp;
}

sub do_eval {
  my ($exp) = < at >_;
  $exp =~ s/\+0+(?=\d)/\+/g;
  eval $exp;
}

sub usage {
  return "$0 <int> <int>\n";
}

__END__

Ronald

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Shlomi Fish — 2009-10-07T13:20:15

I have a few solutions. The first one I wrote in Perl using Moose and a lot of 
stuff that will be suitable for C++. I later translated it to C++ because the 
kid who asked me for a solution doesn't know Perl. Then I wrote a different 
Perl implementation without using Moose, but with using eval. The first Perl 
solution was kinda slow , the C++ version was very fast, and the third Perl 
implementation was somewhere in between.

Moose version:

[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
#!/usr/bin/perl 

package State::Side;

use strict;
use warnings;

use Moose;

has 'last_digits' => (is => "rw", isa => "Str");
has 'last_sum' => (is => "rw", isa => "Int");
has 'next_digits' => (is => "rw", isa => "Str");
has 'terminator_cb' => (is => "rw", isa => "CodeRef");
has 'formula' => (is => "rw", isa => "Str");

sub recurse
{
    my $self = shift;

    my $num_left = length($self->next_digits()) ;

    if ($num_left == 0)
    {
        $self->last_sum(
            $self->last_sum() + $self->last_digits()
        );
        $self->last_digits("");
       
        return $self->terminator_cb()->(
            $self
        );
    }

    my $next_digit = substr($self->next_digits(), 0, 1);
    # Handle the not plus
    blessed($self)->new(
        last_sum => $self->last_sum(),
        last_digits => 
            ($self->last_digits() . $next_digit),
        next_digits => substr($self->next_digits(), 1),
        terminator_cb => $self->terminator_cb(),
        formula => $self->formula() . $next_digit,
    )->recurse();

    # Handle the with plus.

    # No leading plus.
    if ($self->last_digits() ne "")
    {
        blessed($self)->new(
            last_sum => $self->last_sum()+$self->last_digits(),
            last_digits => $next_digit,
            next_digits => substr($self->next_digits(), 1),
            terminator_cb => $self->terminator_cb(),
            formula => $self->formula() . "+" . $next_digit,
        )->recurse();
    }

    return;
}

package main;

sub solve_for_right
{
    my ($left_state, $right) = < at >_;

    State::Side->new(
        last_sum => 0,
        last_digits => "",
        next_digits => $right,
        terminator_cb => sub { 

            my ($right_state) = < at >_;

            if ($left_state->last_sum() == $right_state->last_sum())
            {
                print $left_state->formula(), " = ", 
                      $right_state->formula(), "\n"
                      ;
            }

            return;
        },
        formula => "",
    )->recurse();

    return;
}

sub solve_for
{
    my ($left, $right) = < at >_;

    State::Side->new(
        last_sum => 0,
        last_digits => "",
        next_digits => $left,
        terminator_cb => sub { 
            my ($left_state) = < at >_;

            solve_for_right($left_state, $right);
            return;
        },
        formula => "",
    )->recurse();

    return;
}

my ($l, $r) = < at >ARGV;
solve_for($l, $r);


]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]

C++ version:
------------

[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[

#include <list>
#include <iostream>
#include <cstdlib>


namespace PlusEquation
{
    using namespace std;

    class StateSide;

    typedef list<char> Str;
    typedef void (*terminator_cb_t)(StateSide * self, void * context);

    int int_val(Str & s)
    {
        Str::iterator i = s.begin();
        int ret = 0;
        while (i != s.end())
        {
            ret = ret*10 + (*i-'0');
            i++;
        }
        return ret;
    }

    Str Str_val(int val)
    {
        Str ret;

        while (val)
        {
            ret.push_front('0'+val%10);
            val /= 10;
        }

        return ret;
    }

    ostream& operator<<(ostream& cout, Str & s)
    {
        Str::iterator i = s.begin();

        while (i != s.end())
        {
            cout << (*i);
            i++;
        }

        return cout;
    }

    class StateSide
    {
        protected:
        Str last_digits;
        int last_sum;
        Str next_digits;
        Str formula;
        terminator_cb_t terminator_cb;
        void * context;
        
        public:
        
        StateSide(
                int new_last_sum,
                Str & new_last_digits,
                Str & new_next_digits,
                terminator_cb_t new_terminator_cb,
                void * new_context,
                Str & new_formula
                )
            : last_sum(new_last_sum), context(new_context), 
              terminator_cb(new_terminator_cb)
        {
            last_digits = new_last_digits;
            next_digits = new_next_digits;
            formula = new_formula;
        };
        void recurse(void);
        Str & get_formula(void) { return formula; }
        int get_last_sum(void) { return last_sum; }
    };

    void StateSide::recurse(void)
    {
        int num_left = next_digits.size();

        if (num_left == 0)
        {
            last_sum += int_val(last_digits);
            last_digits = Str();
            terminator_cb(
                this,
                context
            );
            return;
        }
        char next_digit = next_digits.front();

        {
            // Handle the not plus
            Str new_last_digits(last_digits);
            new_last_digits.push_back(next_digit);

            Str new_next_digits(next_digits);
            new_next_digits.pop_front();

            Str new_formula(formula);
            new_formula.push_back(next_digit);

            
            StateSide(
                    last_sum,
                    new_last_digits,
                    new_next_digits,
                    terminator_cb,
                    context,
                    new_formula
            ).recurse();
        }

        // Handle the with plus
        
        // No leading plus.
        if (! last_digits.empty())
        {
            Str new_last_digits;
            new_last_digits.push_back(next_digit);

            Str new_next_digits(next_digits);
            new_next_digits.pop_front();

            Str new_formula(formula);
            new_formula.push_back('+');
            new_formula.push_back(next_digit);

            StateSide(
                    last_sum + int_val(last_digits),
                    new_last_digits,
                    new_next_digits,
                    terminator_cb,
                    context,
                    new_formula
            ).recurse();
        }

        return;
    }

   

    void solve_final_callback (StateSide * right_state, void * context)
    {
        StateSide * left_state = (StateSide *)context;

        if (left_state->get_last_sum() == right_state->get_last_sum())
        {
            cout << left_state->get_formula()  << " = "
                 << right_state->get_formula() << endl
                 ;
        }
    }

    void solve_for_right (StateSide * left_state, void * context)
    {
        int right = *(int *)context;

        Str last_digits;
        Str formula;
        Str right_str = Str_val(right);

        StateSide(
            0,
            last_digits,
            right_str,
            solve_final_callback,
            ((void *)left_state),
            formula
        ).recurse();
    }

    void solve_for(int left, int right)
    {
        Str last_digits;
        Str formula;
        Str left_str = Str_val(left);

        StateSide(
            0,
            last_digits,
            left_str,
            solve_for_right,
            ((void *)&right),
            formula
        ).recurse();
    }
};

int main(int argc, char * argv[])
{
    if (argc != 3)
    {
        std::cerr << "Usage: ./fondi-plus [num1] [num2]" << std::endl;
        return -1;
    }
    
    PlusEquation::solve_for(atoi(argv[1]), atoi(argv[2]));

#if 0
    PlusEquation::Str s;

    s.push_back('1');
    s.push_back('0');
    s.push_back('5');

    std::cout << PlusEquation::int_val(s) << std::endl;
#endif

    return 0;
}

]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]

Perl version using eval:

[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
#!/usr/bin/perl 

use strict;
use warnings;

my < at >n = < at >ARGV;
die "Wrong" if grep { !/\A\d+\z/ } < at >n;

r("", [map{ [split//, $_] } < at >n], []);

sub myeval
{
    my $s = shift;
    $s =~ s{(\d+)}{int($1)}eg;
    return eval $s;
}

sub r
{
    my ($expr, $list_of_rests, $list_of_exprs) = < at >_;
    
    if (!< at >$list_of_rests)
    {
        print join(" = ", < at >$list_of_exprs), "\n";
    }
    else
    {
        my $rest = shift(< at >$list_of_rests);
        if (!< at >$rest)
        {
            if ((!< at >$list_of_exprs) || 
                (myeval($expr) == myeval($list_of_exprs->[0])))
            {
                r("", 
                    [map { [< at >$_] } < at >$list_of_rests], 
                    [< at >$list_of_exprs, $expr]
                );
            }
            return;
        }
        else
        {
            my $first = shift(< at >$rest);
            for my $suffix ("", (length($expr)?"+":()))
            {
                r(
                    $expr.$suffix.$first, 
                    [map { [< at >$_] } $rest,< at >$list_of_rests],
                    [< at >$list_of_exprs]
                );
            }
        }
    }
    return;
}


]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]

Regards,

Shlomi Fish

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : PlusifiedEquations

Josh Narins — 2009-10-07T10:37:29

I'll put the code up online after I get home from work today at
http://www.flowersofpeace.com/telephone_code.html

On Wed, Oct 7, 2009 at 6:36 AM, Josh Narins <josh.narins-Re5JQEeQqe8AvxtiuMwx3w< at >public.gmane.org> wrote:

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : PlusifiedEquations

Josh Narins — 2009-10-07T10:36:37

I set up my solution about a half year before the contest was
announced, although I would prefer if no one requests any answers to
future contests at this time.

Mine started when I noticed that my telephone number was a true
equation. Someone mentioned at work that the current calendar day was
a perfect square, or something quite like that, I mentioned my
telephone number, and someone asked for a programmatic solution.

My solution allows up to eight operators, +, -, *, /, **, ^, & and I,
but as a party trick, the first four are the default. It's also a
recursive solution around the number of digits, so you can blow out
your memory if you could think of some more operators.

Like the previous answer, I use eval. I also skip all numbers that
begin with 0 but basically because this is designed as a party trick,
and some people simply don't appreciate being told 1+01=2. I also
eliminate 0.

I also didn't care where the = was, so I try it at all meaningful locations.

Since it is recursive, I currently limit it to 10 digit numbers:

http://www.flowersofpeace.com/telephone

Also, if you have a mobile phone and live in NYC, you might like

http://www.flowersofpeace.com/weather


Someone nearby here at work did the same problem with an iterative solution

Re: Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Chris Charley — 2009-10-07T02:31:03

Hello Shlomi,

I have heard that 'a thousand monkeys at a thousand
typewriters will eventually type out the entire works
of Shakespeare'. So, I put my best team of monkeys
on this problem and it resulted in the program below.  :-)

This was a good exercise. My solution saw that
the '+' signs distributed between the numbers
as a power set.

For example, for the number 7637, I first
modified it to be '7 6 3 7', (with 3 spaces as placeholders).
The power set distributing '+'s for this number would be:
000
001
010
011
100
101
110
111

There are 8, (2**3), ways the plus sign could be
distributed. To generate the 8 expressions, I
tested the binary representation (above). If the bit was 1,
I replaced the space with a '+' and if not, removed
the space (placeholder). The results are:
7637
763+7
76+37
76+3+7
7+637
7+63+7
7+6+37
7+6+3+7

Then, I used string 'eval' to get the sum and placed
it and the expression in the %sums hash.

 $sums{$number}{$sum}{$expr} = ();

After calculating all the sums, I found a match If
a sum from the 'left' side == a sum from the 'right'.


*** requirement 2:
2. They will be sorted so consecutive digits will
   take precedence over "+"'s.

To achieve this requirement, I sorted the results
using nsort() from the module 'Sort::Naturally'.



Two errors I encountered were:

1. The worst error, (because it silently gave incorrect sums),
was when an expression had an octal number. I stumbled
across this by chance and if not discovered, would have
made my program incorrect. I don't know how a person
could have caught this using tests unless he was aware
that octal addition was an (incorrect) possibility.

An example of an octal number (derived from one of
the numbers you provided) would be the expression:

1+010

(one of the arrangements when given the number 1010
to distribute the plus signs through).

It gives the sum '9' when what you really wanted was '11'.
I guess I never would have caught it except by the chance
that you just happened to use this number in one
of your examples for the problem.


2. (I think) you were not aware when setting up the
problem that more than 1 arrangement on ONE side could
have the same sum. From my %sums hash:

'11' => {
        '1+0+10' => undef,
        '1+010' => undef,
        '10+1+0' => undef
      },

For the sample numbers you had as input, none of the
solutions had more than one value per side. But my
code addresses this by doing a 'cross product'
(in the output section) to allow for this possibility .

Cheers,

Chris

NOTE: 1. Program dies if you supply one or more 0's as
      one of the numbers.

      2. Can't use a number longer than 31 digits.



*** Program

#!/usr/bin/perl
use strict;
use warnings;
use Sort::Naturally;

< at >ARGV == 2  or die "Must supply two numbers: $!";
my %sums;

for my $number (< at >ARGV) { # Left then Right
 
 # plus signs distribute between digits as a power set
 # i.e., if a number is 4 digits long, find pwr set (2**3)
 my $nbits = length($number)-1;
 my $nsubsets = 2**$nbits;
 
 for my $subset (0 .. $nsubsets-1) {
  
  # if $number is '7637', then $expr is '7 6 3 7'
  (my $expr = $number) =~ s/\B/ /g;
  
  for my $shift (reverse 0 .. $nbits-1) {
   $expr =~ s/ /$subset & (1 << $shift) ? '+' : ''/e;
  }
  
  # remove 'leading' 0's (to prevent octal addition)
  (my $eval_str = $expr) =~ s/\+0+\B/+/g;
  
  my $sum = eval "$eval_str" or die $!;
  $sums{$number}{$sum}{$expr} = ();
 }
}

my < at >data;
my ($L, $R) = < at >ARGV;
for my $sum (keys %{ $sums{$L} }) {
 next unless exists $sums{$R}{$sum};
 # Cross Product
 for my $L_expr ( keys %{ $sums{$L}{$sum} } ) {
  for my $R_expr ( keys %{ $sums{$R}{$sum} } ) {
   push < at >data, "$L_expr=$R_expr";
  }
 }
}

print join("\n", reverse nsort < at >data), "\n";

Perl 'Medium' Quiz-of-the-Whatever for 2009-08-11 : Plusified Equations

Shlomi Fish — 2009-08-11T14:55:06

IMPORTANT: Please do not post solutions, hints, or other spoilers
until at least 60 hours after the date of this message.  Thanks.

---------------

We are given two positive integers $L and $R we need to find Plusified 
expressions of both for which Eval($E_L) == Eval($E_R). So what is a plusified 
expression? It is an expression where we can choose whether to add a single 
"+" between any consecutive digit. So for example the number 123 has the 
following plusified expression:

* 123
* 12+3
* 1+23
* 1+2+3


So if we are given 123 and 96 we can form the following plusified equation:

* 12+3 == 9+6

Your mission is to write a Perl program (or an equivalent program in any 
programming language) that will find all solutions to the plusified equation 
of two numbers given as input. To normalise the output we'll rule that:

1. The equations should be given one at each line.

2. They will be sorted so consecutive digits will take precedence over "+"'s.

3. A "+" has no surrounding spaces.

4. The = sign does have a preceding and following space.

As an example:

{{{{{{{{{{{{{
$ ./plusified-equation 12341234 1010
1+23+41+2+34 = 101+0
1+2+3+4+1+2+3+4 = 10+10
}}}}}}}}}}}}}

Enjoy!

Regards,

Shlomi Fish