Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #10215

Sumbrero 5 x 3 puzzle solver

From mhx@iae.nl (Marcel Hendrix)
Subject Sumbrero 5 x 3 puzzle solver
Newsgroups comp.lang.forth
Message-ID <14920316008435@frunobulax.edu> (permalink)
Date 2012-03-19 00:11 +0200
Organization Wanadoo

Show all headers | View raw


Here is a general and quite fast solution to the 5 x 3 variant of the 
Sumbrero puzzle.

This puzzle did not yield to a brute-force attack (~I was not prepared 
to wait for a couple of hours).

-marcel

-- ----------------------------------------------------------------------
(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Game solver
 * CATEGORY    : Demo's
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : March 10, 2012, Marcel Hendrix 
 *)



	NEEDS -miscutil

	REVISION -sumbrero10 "--- Sumbrero10 puzzle   Version 0.01 ---"

	PRIVATES

DOC
(*
     The figure below shows a board containing fifteen squares, a..o. 
     Each square should eventually contain a number [1 9]. Each line
     may contain only the numbers [1 9], where duplicates are not allowed.
     It is ok to use the same number on different lines.

	    d	  j
  	 a     g     m   The board has 8 diagonal lines of squares and 
            e     k      five vertical ones. 
         b     h     n   The sum of the target numbers on the diagonals 
            f     l      and the verticals is given. 
         c     i     o   The task is to find the 15 numbers. 
        
      Sample problem:

      a + d             = 4    a <> d			1	
      b + e + g + j     = 10   b <> e <> g <> j		2
      c + f + h + k + m = 26   c <> f <> h <> k <> m	3
      i + l + n         = 14   i <> l <> n		4
      b + f + i         = 7    b <> f <> i		5
      a + e + h + l + o = 19   a <> e <> h <> l <> o	6
      d + g + k + n     = 14   d <> g <> k <> n		7
      j + m             = 13   j <> m			8
      a + b + c         = 6    a <> b <> c		9
      d + e + f         = 7    d <> e <> f		10
      g + h + i         = 10   g <> h <> i		11
      j + k + l         = 18   j <> k <> l		12
      m + n + o         = 14   m <> n <> o		13
    
    Discussion
    ----------
    A brute-force solution takes excessively long. 
    It follows that:

	2*a ==  4*b0 + 3*b1 - 2*b10 - b11     + 2*b2 +   3*b3 -     b4 -     b6 - 2*b7 - 2*b8 - 3*b9 + 2*f - 2*l -  2*n
	  b ==                                            -b3 +     b4				     -   f +   l +    n 
	2*c == -4*b0 - 3*b1 + 2*b10 + b11     - 2*b2 -     b3 -     b4 +     b6 + 2*b7 + 4*b8 + 3*b9
	2*d == -2*b0 - 3*b1 + 2*b10 + b11     - 2*b2 -   3*b3 +     b4 +     b6 + 2*b7 + 2*b8 + 3*b9 - 2*f + 2*l +  2*n
	2*e ==  2*b0 + 3*b1 - 2*b10 - b11     + 2*b2 +   3*b3 -     b4 -     b6 - 2*b7 - 2*b8 -   b9       - 2*l -  2*n
	2*g ==           b1         - b11            +     b3 -     b4 +     b6               -   b9 + 2*f       -  2*n
	2*h ==       -   b1 + 2*b10 + b11            -   3*b3 +     b4 -     b6               +   b9 - 2*f + 2*l +  4*n
	  i ==  				           b3					           -   l -    n
	  j ==   -b0 -   b1 +   b10 + b11       - b2 -     b3 		          + b7 +   b8 +   b9 	         +    n
	  k ==    b0 +   b1 -   b10             + b2 +     b3 		          - b7 -   b8 -   b9       -   l -    n
	  m ==    b0 +   b1 -   b10 - b11       + b2 +     b3      		       -   b8 -   b9             -    n
	  o ==   -b0 -   b1 +   b10 + b11 + b12 - b2 -     b3      		       +   b8 +   b9
*)
ENDDOC

0 VALUE $a	0 VALUE $b	0 VALUE $c	
0 VALUE $d      0 VALUE $e	0 VALUE $f
0 VALUE $g	0 VALUE $h      0 VALUE $i
0 VALUE $j	0 VALUE $k	0 VALUE $l
0 VALUE $m	0 VALUE $n	0 VALUE $o

CREATE problems PRIVATE
   4 , #10 , #26 ,  #14 ,   7 , #19 ,  #14 , #13 ,   6 ,   7 , #10 , #18 , #14 ,
 #17 , #29 , #16 ,  #20 , #20 , #24 ,  #25 , #13 , #14 , #22 , #19 , #18 , #10 ,
HERE problems - #13 CELLS / =: #problems PRIVATE
0 VALUE barray  PRIVATE

: bx    CREATE CELLS , DOES> @ barray + @ ; PRIVATE

	  0 bx b0     1 bx b1     2 bx b2    3 bx b3   4 bx b4
	  5 bx b5     6 bx b6     7 bx b7    8 bx b8   9 bx b9
	#10 bx b10  #11 bx b11  #12 bx b12 

: 4*b0    b0 4 * ;  : 2*b0    b0 2* ;  : 3*b1    b1 3 * ; 
: 2*b10   b10 2* ;  : 2*b2    b2 2* ;  : 3*b3    b3 3 * ;  : 2*b7    b7 2* ; 
: 2*b8    b8 2* ;   : 4*b8    b8 4 * ; : 3*b9    b9 3 * ;  : 2*f     $f 2* ;    
: 2*l     $l 2* ;   : 2*n     $n 2* ;  : 4*n     $n 4 * ;

: single2? ( a b -- bool ) = ; PRIVATE 
: single3? ( a b c -- bool ) 2DUP = >S  2 PICK = >S  =  S> OR  S> OR ; PRIVATE 
: single4? ( a b c d -- bool ) LOCALS| d c b a | a b =  a c = OR  a d = OR   b c = OR b d = OR   c d = OR ; PRIVATE
: single5? ( a b c d e -- bool ) LOCALS| e d c b a | a b =  a c = OR  a d = OR  a e = OR   b c = OR b d = OR b e = OR  c d = OR  c e = OR  d e = OR ; PRIVATE

: single? ( -- bool )
	$a $d                 = IF  FALSE EXIT  ENDIF
	$j $m                 = IF  FALSE EXIT  ENDIF
	$i $l $n       single3? IF  FALSE EXIT  ENDIF
	$b $f $i       single3? IF  FALSE EXIT  ENDIF
	$a $b $c       single3? IF  FALSE EXIT  ENDIF
	$d $e $f       single3? IF  FALSE EXIT  ENDIF
	$g $h $i       single3? IF  FALSE EXIT  ENDIF
	$j $k $l       single3? IF  FALSE EXIT  ENDIF
	$m $n $o       single3? IF  FALSE EXIT  ENDIF
	$b $e $g $j    single4? IF  FALSE EXIT  ENDIF
	$d $g $k $n    single4? IF  FALSE EXIT  ENDIF
	$c $f $h $k $m single5? IF  FALSE EXIT  ENDIF 
	$a $e $h $l $o single5? IF  FALSE ELSE  TRUE  ENDIF ; PRIVATE

: range? ( u -- bool ) 1 #10 WITHIN ;
: testA ( -- bool )   4*b0    3*b1 + 2*b10 -  b11 -        2*b2 + 3*b3 +  b4 -  b6 - 2*b7 -  2*b8 - 3*b9 -   2*f +  2*l - 2*n -  2/  DUP TO $a  range? ; PRIVATE
: testB ( -- bool ) 0                                               b3 -  b4 + 			              $f -   $l +  $n +      DUP TO $b  range? ; PRIVATE
: testC ( -- bool ) 0 4*b0 -  3*b1 - 2*b10 +  b11 +        2*b2 -   b3 -  b4 -  b6 + 2*b7 +  4*b8 + 3*b9 +                       2/  DUP TO $c  range? ; PRIVATE
: testD ( -- bool ) 0 2*b0 -  3*b1 - 2*b10 +  b11 +        2*b2 - 3*b3 -  b4 +  b6 + 2*b7 +  2*b8 + 3*b9 +   2*f -  2*l + 2*n +  2/  DUP TO $d  range? ; PRIVATE
: testE ( -- bool )   2*b0    3*b1 + 2*b10 -  b11 -        2*b2 + 3*b3 +  b4 -  b6 - 2*b7 -  2*b8 -   b9 -          2*l - 2*n -  2/  DUP TO $e  range? ; PRIVATE
: testG ( -- bool )             b1            b11 -                 b3 +  b4 -  b6 +                  b9 -   2*f +        2*n -  2/  DUP TO $g  range? ; PRIVATE
: testH ( -- bool ) 0           b1 - 2*b10 +  b11 +               3*b3 -  b4 +  b6 -                  b9 +   2*f -  2*l + 4*n +  2/  DUP TO $h  range? ; PRIVATE
: testI ( -- bool ) 					            b3 					             $l -  $n -      DUP TO $i  range? ; PRIVATE
: testJ ( -- bool ) 0   b0 -    b1 -   b10 +  b11 +          b2 -   b3 -              b7 +     b8 +   b9 +                 $n +      DUP TO $j  range? ; PRIVATE
: testK ( -- bool )     b0      b1 +   b10 -                 b2 +   b3 +              b7 -     b8 -   b9 -           $l -  $n -      DUP TO $k  range? ; PRIVATE
: testM ( -- bool )     b0      b1 +   b10 -  b11 -          b2 +   b3 +                       b8 -   b9 -                 $n -      DUP TO $m  range? ; PRIVATE
: testO ( -- bool ) 0   b0 -    b1 -   b10 +  b11 +  b12 +   b2 -   b3 -                       b8 +   b9 +                           DUP TO $o  range? ; PRIVATE

: REPORT ( ix -- ) CR ." y = ["  $a . $b . $c . $d . $e . $f . $g . $h . $i . $j . $k . $l . $m . $n . $o 0 .R ." ]" ."  (" 0 .R ." ) " ; PRIVATE
: .B     ( -- )    CR ." b = ["  b0 . b1 . b2 . b3 . b4 . b5 . b6 . b7 . b8 . b9 . b10 . b11 . b12 0 .R ." ]" ; PRIVATE
: (NEW)  ( -- )    #problems CHOOSE #13 CELLS * problems + TO barray ; PRIVATE (NEW) 
: NEW    ( -- )    (NEW) .B ;

-- No smart backtracking is used, simply try all possibilities.
: (SMART) ( -- #tries )
	0 LOCAL #tries
	#10 1 DO  I TO $f  
 	  #10 1 DO  I TO $l 
	    #10 1 DO  I TO $n  
	    	      1 +TO #tries 
		      testA        testB AND testC AND testD AND
		      testE   AND  testG AND testH AND testI AND  
		      testJ   AND  testK AND testM AND testO AND 
		      single? AND IF  #tries REPORT  ENDIF
	        LOOP 
	      LOOP 
	    LOOP ; PRIVATE

: SMART	TIMER-RESET (SMART) .ELAPSED ;

:ABOUT	CR ." Try SMART to solve the Sumbrero puzzle " .B 
	CR ."     NEW generates a new problem for you." 
	CR ."     File contains " #problems DUP . ." problem" ?s ;

		.ABOUT -sumbrero10 CR
		DEPRIVE

                              (* End of Source *)

-- output ----------------------------------------------------------------------------

FORTH> in sumbrero10
Creating --- Sumbrero10 puzzle   Version 0.01 ---

Try SMART to solve the Sumbrero puzzle
b = [4 10 26 14 7 19 14 13 6 7 10 18 14]
    NEW generates a new problem for you.
    File contains 2 problems
 ok
FORTH> new smart
b = [4 10 26 14 7 19 14 13 6 7 10 18 14]
y = [3 1 2 1 2 4 3 5 2 4 6 8 9 4 1] (310) 0.006 seconds elapsed. ok
FORTH> new smart
b = [17 29 16 20 20 24 25 13 14 22 19 18 10]
y = [8 5 1 9 7 6 8 2 9 9 3 6 4 5 1] (455) 0.005 seconds elapsed. ok

Back to comp.lang.forth | Previous | Next | Find similar | Unroll thread


Thread

Sumbrero 5 x 3 puzzle solver mhx@iae.nl (Marcel Hendrix) - 2012-03-19 00:11 +0200

csiph-web