Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Happy 2006

by Perl Mouse (Chaplain)
on Jan 10, 2006 at 16:09 UTC ( #522221=CUFP: print w/ replies, xml ) Need Help??

After seeing the following puzzle floating around the net, I decided to automate it:
Take the digits 9, 8, 7, 6, 5, 4, 3, 2, 1 in that order. Insert one or more basic math operators (addition, subtraction, division, multiplication) so that the result makes 2006.
#!/usr/bin/perl use strict; use warnings; my @o = (" + ", " - ", " * ", " / ", ""); my @s = (" ", "-"); my @d = (0, 1 .. 9); my $year = @ARGV ? shift : 2006; for my $o8 (@o) { for my $o7 (@o) { for my $o6 (@o) { for my $o5 (@o) { for my $o4 (@o) { for my $o3 (@o) { for my $o2 (@o) { for my $o1 (@o) { for my $s (@s) { my $expr = "$s$d[9]$o8$d[8]$o7$d[7]$o6$d[6]$o5" . "$d[5]$o4$d[4]$o3$d[3]$o2$d[2]$o1$d[1]"; print "$expr == $year\n" if $year == eval $expr; }}}}}}}}} __END__ 2006 == -9 + 8 * 7 + 654 * 3 - 2 - 1 2006 == 9 + 8 * 7 + 654 * 3 - 21 2006 == 9 + 8 * 7 * 6 * 5 - 4 + 321 2006 == 9 * 8 - 7 + 654 * 3 - 21
I'm sure there are cleverer ways of writing the nested loop, using some kind of module. But cut-and-paste is fast, and this takes less programmer time.
Perl --((8:>*

Comment on Happy 2006
Download Code
Re: Happy 2006
by Roy Johnson (Monsignor) on Jan 10, 2006 at 17:36 UTC
    An arguably cleverer way to write the nested loop without using some kind of module:
    use strict; use warnings; my $year = @ARGV ? shift : 2006; my $ops = '{-,+,x,/,}'; my $globpat = '{-,}' . (join $ops, (reverse 1..9)); print $globpat, "\n"; for (glob $globpat) { tr/x/*/; print "$_ == $year\n" if $year == eval; }

    Caution: Contents may have been coded under pressure.
      I'm not a big fan of the glob trick - there's always the possibility something matches (although for the given pattern, that's pretty unlikely). But just for kicks, I compared your solution with mine:
      $ /usr/bin/time ./perlmouse ; /usr/bin/time ./ray_johnson -9 + 8 * 7 + 654 * 3 - 2 - 1 == 2006 9 + 8 * 7 + 654 * 3 - 21 == 2006 9 + 8 * 7 * 6 * 5 - 4 + 321 == 2006 9 * 8 - 7 + 654 * 3 - 21 == 2006 56.60user 0.19system 2:04.01elapsed 39%CPU (0avgtext+0avgdata 0maxresi +dent)k 0inputs+0outputs (356major+87minor)pagefaults 0swaps -9+8*7+654*3-2-1 == 2006 9+8*7+654*3-21 == 2006 9+8*7*6*5-4+321 == 2006 9*8-7+654*3-21 == 2006 56.98user 3.45system 2:43.21elapsed 41%CPU (0avgtext+0avgdata 0maxresi +dent)k 0inputs+0outputs (398major+21556minor)pagefaults 0swaps
      The running time is about the same, but your solution uses a lot more memory, as it makes a list of all possible expressions to test before making the first test, while my solution tests each expressions right after it is constructed. My solution has a lot less pagefaults.
      Perl --((8:>*
        The running time is about the same, but your solution uses a lot more memory, as it makes a list of all possible expressions to test before making the first test, while my solution tests each expressions right after it is constructed. My solution has a lot less pagefaults.
        Ah, someday soon, glob will be an iterator in scalar context.

        -QM
        --
        Quantum Mechanics: The dreams stuff is made of

Re: Happy 2006
by ambrus (Abbot) on Jan 10, 2006 at 17:50 UTC
Re: Happy 2006
by Limbic~Region (Chancellor) on Jan 10, 2006 at 20:11 UTC
    Perl Mouse,
    After finishing my solution, I realized that I must have intepreted the puzzle wrong. I thought each term was evaluated left to right in succession not as 1 entire expression. *shrug*

    Here is the (likely incorrect) code I came up with intentionally avoiding eval $string;

    Cheers - L~R

      I don't quite understand how your program is supposed to work, but the results are indeed incorrect. It seems all your operators have the same precedence?
      +9*8*7-6+5*4-3-2-1 == 512 +98/7+654*3+2/1 == 1978 +98/7+654*3+2*1 == 1978
      Perl --((8:>*
        Perl Mouse,
        No, just each term in the expression is evaluated independently. This is how we did similar puzzles in school. The program works as follows:

        Algorithm::Loops generates all the permutation of operators needed and then the numbers are zipped forming a single string. This is the point where eval $string would produce the same results as your code. Instead, I break each term apart and keep a running total of the value which is returned.

        In my opinion, what would make the puzzle much more interesting would be to require single expression evaluation as your solution does but prohibit the use of eval $string. Here is my original solution modified accordingly though it is quite slow and a bit obfu now. Thanks for the puzzle.

        Cheers - L~R

Re: Happy 2006 (Golf)
by BrowserUk (Pope) on Jan 11, 2006 at 00:51 UTC

    This has been seen to produce 3 of the 4 possibles.

    perl -e"($_='987654321')=~s[(?!$)][pos()?(qw[+ - * /],('')x4)[rand 8]: +int(rand 2)?'':'-']ge while 2006!=eval;print;"

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      Some golfing nitpicks:
      • Instead of int(rand 2)?'':'-', you can write '-'x rand 2, saving seven characters.
      • No need to quote 987654321, Perl will happely turn this integer into a string for you. This saves two characters.
      • Use $` instead of pos(). Three characters.
      • If you use an empty pattern in the substitution, Perl will do the right thing. Another five characters.
      • Use s### instead of s[][] for one character savings.
      Result:
      $ perl -e'($_=987654321)=~s##$`?(qw[+ - * /],("")x4)[rand 8]:"-"x rand + 2#ge while 2006!=eval;print' 9+8*7+654*3-21
      Perl --((8:>*

        I'll go along with most of that except

        If you use an empty pattern in the substitution, Perl will do the right thing. Another five characters.

        Without the negative lookahead, the regex will produce a very high proportion of invalid expressions because it will insert an operator at the very end of the string:

        9+8*7*6*54/3-2/1- -9-8-7*6+5/43/2+1 987+6/54321 98/7-6+5-4/321+ 9*8/7/6/54-3/2-1 9/876*543/21 -9*8/76543*2-1- -987/65-432+1* 9*8+7+65*432*1- 9876/5*43+21 9876-54321* 987/6-5-4/3-21/ 9-8+7*65432+1 98765+432*1+ -9*8-7*65432-1+ 9+87*6543*21 9-87*65*4-3-2*1 -987654-321+ 98*76/54*32*1- -9-876/5-432*1* -987*654+321 9/87+6543*21 98-7654/3+21 -98*7-6-5*4321 98+7+6/5+4*3+2-1 -98+76+54*3/2+1/ 9876543/21 -9-8+76-54321*

        Not always, and so it can be expected to still produce occasional correct answers, but it will take much longer and somehow offends my sensibilities :)


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Happy 2006
by Aristotle (Chancellor) on Jan 13, 2006 at 01:42 UTC
    use strict; use warnings; use Set::CrossProduct; my @ops = qw( * + - / ); my $expr = '2006 == ' . join ' %s ', 1 .. 9; my $xp = Set::CrossProduct->new( [ map \@ops, $expr =~ /%s/g ] ); while( my @attempt = $xp->get ) { my $attempt = sprintf $expr, @attempt; print $attempt, "\n" if eval $attempt; }

    Makeshifts last the longest.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://522221]
Approved by McDarren
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (6)
As of 2014-08-23 02:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (171 votes), past polls