Post Reply 
Vietnamese snake puzzle - Closed
05-24-2015, 06:40 PM (This post was last modified: 05-25-2015 06:37 AM by Werner.)
Post: #29
RE: Vietnamese snake puzzle - Closed
My RPL solution to the arithmetic puzzle (long):
all timings are for EMU48 on my laptop. It's about 120 times faster than a real 48GX.

First, generate permutations:
The following routine will accept a list L on level 2 and an executable object
ob in level 1, and will apply ob to all permutations of the list L. All result
objects (from executing ob), if any, will be wrapped up in an output list.

It does not use Heap's algorithm, for two reasons:
- Heap's algorithm uses a single object swap between permutations. But a swap in RPL is a ROLL and a ROLLD, and it can be done with just a single ROLL.
- at every level, the order at the beginning and end of the level are the same - which is not the case for Heap's algorithm

Code:
@ DOPERM1
@  In : L ob
@  out: { r1..rM }
@
@ L : a list of objects { l1 .. lN }
@ ob: an executable object
@  In : l1 .. lN permutation of the list objects
@  Out: r1..rm l1..lN
@ ob receives the list objects in the first N levels of the stack, in permuted
@ order. It must leave them in the same order, and place any result object(s)
@ above them. These will all be wrapped up in the end in the output list.
@ the original list size N is available to ob as the compiled local variable \<-N

\<<
  DEPTH DUP DUP            @ two levels of dummies to be filled in later
  \-> ob D DoP \<-N
  \<<

    \<<                @ definition of the recursive function DoP
      \-> n
      \<<
        IF n 1 SAME THEN    @ at bottom level, execute ob
          ob EVAL
        ELSE            @ else, recurse
          1 n START
            n ROLL
            n 1 - DoP EVAL
          NEXT
        END
      \>>
    \>>
    'DoP' STO

    LIST\-> '\<-N' STO        @ explode the list on the stack, save N
    \<-N DoP EVAL        @ permute(N)

    \<-N DROPN            @ drop permutations
    DEPTH D - 2 +        @ wrap results in a list
    IF DUP 0 \>= 
    THEN \->LIST 
    ELSE DROP
    END
  \>>
\>>

To simply generate all permutations in a list, for instance, the following ob
can be used:

Code:
@ l1 .. lN -> { l1 .. lN } l1 .. lN
\<< \<-N \->LIST DUP LIST\-> DROP\>>
running
Code:
{ 1 2 3 }
\<< \<-N \->LIST DUP LIST\-> DROP\>>
DOPERM1
results in
Code:
 { { 2 1 3 } { 2 3 1 } { 3 2 1 } { 3 1 2 } { 1 3 2 } { 1 2 3 } }

and listing all solutions to the arithmetic challenge can be done like this:

Code:
\<<
  { 1 2 3 4 5 6 7 8 9 }
  \<<
    9 DUPN
    \-> A B C D E F G H I
    '(13*B*I + G*H*C)/(C*I) + A + D - F + 12*E'
    IF 87 SAME THEN 9 \->LIST DUP EVAL END
  \>>
  DOPERM1
\>>

427 seconds, 136 solutions, 9! = 362880 permutations tested
We may speed this up unrolling inner loops and so, but we're still testing 362880
permutations. We had better find ways to cut this number down.
Suppose we find B C G H I first, an test whether (13*B*I + G*H*C)/(C*I) is an
integer. If it isn't, there's no need to further test all permutations of A D E
and F. We can do this if we change DOPERM1 as follows:

Code:
@ DOPERM2
@
@  In : L ob
@  out: { r1..rM }
@
@ L : a list of objects { l1 .. lN }
@ ob: an executable object
@  In : l1 .. lN level
@  Out: r1..rm l1..lN 0/1
@ ob receives the list objects in levels 2..N+1 of the stack, in permuted
@ order. Stack level 1 contains the level of the permutation, n.
@ On output, l1..lN must be left in the same place, and any result object(s)
@ must be placed above them. These will all be wrapped up in the end in the output
@ list.
@ Stack level 1 must contain 0 or 1 (anu non-zero number will do)
@ 0 : conyinue permuting
@ 1 : skip permutation level, saving level! permutations
@ the original list size N is available to ob as the compiled local variable \<-N

\<<
  DEPTH DUP DUP
  \-> ob D DoP \<-N
  \<<
    \<<
      \-> n
      \<<
        IF n ob EVAL NOT THEN    @ level check, skip if test(n) true
          1 n START
            n ROLL
            n 1 - DoP EVAL
          NEXT
        END
      \>>
    \>>
    'DoP' STO
    LIST\-> '\<-N' STO
    \<-N DoP EVAL
    \<-N DROPN
    DEPTH D - 2 +
    IF DUP 0 \>= THEN \->LIST ELSE DROP END
  \>>
\>>

This time, the simple permutation list generating 'ob' looks like this:

Code:
\<<
  IF 1 SAME
  THEN
   \<-N \->LIST DUP LIST\->
  ELSE 0
  END
\>>

and the ob for straightforward generation of all solutions like this:

Code:
\<<
  IF 1 SAME
  THEN
      9 DUPN
      \-> A B C D E F G H
      '(13*B*I + G*H*C)/(C*I) + A + D - F + 12*E'
      IF 87 SAME THEN 9 \->LIST DUP EVAL END
      1
  ELSE 0
  END
\>>

The execution now takes even longer: 495 seconds
This time, however, we can cut the permutations short: once we selected 5 numbers (when permutation 'level' equals 4), we can perform our test, as follows:

Code:
\<<
  { 1 2 3 4 5 6 7 8 9 }
  \<<
    CASE
    DUP 4 SAME THEN DROP
      9 DUPN 4 DROPN 
      \-> C I B G H '(13*B*I+G*H*C) MOD (C*I)'
    END
    DUP 1 SAME THEN DROP
      9 DUPN
      \-> C I B G H E F A D
      '(13*B*I + G*H*C)/(C*I) + A + D - F + 12*E'
      IF 87 SAME THEN 9 \->LIST DUP EVAL END
      1
    END 
    DROP 0
    END
  \>>
  DOPERM2
\>>
56 seconds, 136 solutions, 29232 level-1 permutations checked

We can check C or I are not 5 or 7:

Code:
\<<
  { 1 2 3 4 5 6 7 8 9 }
  \<<
    CASE
    DUP 1 SAME THEN DROP
      9 DUPN
      \-> C I B G H A D E F
      '(13*B*I + G*H*C)/(C*I) + A + D - F + 12*E'
      IF 87 SAME THEN 9 \->LIST DUP EVAL END
      1
    END 
    DUP 4 SAME THEN DROP
      9 DUPN 4 DROPN 
      \-> C I B G H '(13*B*I+G*H*C) MOD (C*I)'
    END
    DUP 7 SAME THEN DROP
      { 5 7 } 9 PICK POS
    END
    DUP 8 SAME THEN DROP
      { 5 7 } 10 PICK POS
    END
    DROP 0
    END
  \>>
  DOPERM2
\>>
52 seconds, 136 solutions, 29232 level-1 permutations checked

We can unroll the level-4 permutations. Since A and D are commutable, we need
generate only 8 permutations (the bottom 2 need not be swapped if those are A
and D). At the same time, we can re-use the already calculated amount
(13*B*I + G*H*C)/(C*I)
Also, let's output the solutions in ABCDEFGHI order again:

Code:
\<<
  { 1 2 3 4 5 6 7 8 9 }
  \<<
    CASE
    DUP 4 SAME THEN DROP
      9 DUPN DROP2
      \-> C I B G H J ob
      \<<
        '(13*B*I+G*H*C)/(C*I)' EVAL
        IF DUP FP
        THEN DROP
        ELSE
          'J' STO            @ save value (13*B*I+G*H*C)/(C*I)
          \<<                @ ob to execute at level-1
            4 DUPN
            \-> E F A D
            \<<
              'J+A+D-F+12*E' EVAL
              IF 87 SAME THEN
                A B C D E F G H I
                9 \->LIST
                10 ROLLD
              END
            \>>
          \>>
          'ob' STO

          1 4 START            @ level-4 permutations unrolled
            4 ROLL            @ and without level-2 swap
            ROT ob EVAL
            ROT ob EVAL
            ROT ob EVAL
          NEXT

        END
        1
      \>>
    END
    DUP 7 SAME THEN DROP
      { 5 7 } 9 PICK POS
    END
    DUP 8 SAME THEN DROP
      { 5 7 } 10 PICK POS
    END
    DROP 0
    END
  \>>
  DOPERM2
\>>
15 seconds for 68 solutions, 14616 level-1 permutations checked

We can roughly halve that number again by generating the 36 (G,H) combinations
first and permuting the 7 other numbers

Code:
\<<
 {}
 1 8 FOR G
  G 1 + 9 FOR H
    9 8 7 6 5 4 3 2 1 
    H ROLL DROP 
    G ROLL DROP
    7 \->LIST

  \<<
    CASE
    DUP 4 SAME THEN DROP
      7 DUPN DROP2
      \-> B C I J ob
      \<<
        '(13*B*I+G*H*C)/(C*I)' EVAL
        IF DUP FP
        THEN DROP
        ELSE
          'J' STO            @ save value (13*B*I+G*H*C)/(C*I)
          \<<                @ ob to execute at level-1
            4 DUPN
            \-> E F A D
            \<<
              'J+A+D-F+12*E' EVAL
              IF 87 SAME THEN
                A B C D E F G H I
                9 \->LIST
                8 ROLLD
              END
            \>>
          \>>
          'ob' STO

          1 4 START            @ level-4 permutations unrolled
            4 ROLL            @ and without level-2 swap
            ROT ob EVAL
            ROT ob EVAL
            ROT ob EVAL
          NEXT

        END
        1
      \>>
    END
    DUP 7 SAME THEN DROP
      { 5 7 } 9 PICK POS
    END
    DUP 8 SAME THEN DROP
      { 5 7 } 10 PICK POS
    END
    DROP 0
    END
  \>>

    DOPERM2 +
  NEXT
 NEXT
\>>
10 seconds, 34 solutions, 7308 level-1 solutions checked

To be complete, here's a version to find all solutions where B/C and G*H/I
are integers:

Code:
\<<
 {}
 1 8 FOR G
  G 1 + 9 FOR H
    9 8 7 6 5 4 3 2 1 
    H ROLL DROP 
    G ROLL DROP
    7 \->LIST

    \<<
      CASE
      DUP 4 SAME THEN DROP
        7 DUPN DROP2
        \-> B C I J ob
        \<<
          'G*H/I' EVAL
          IF DUP FP
          THEN DROP
          ELSE
            '13*B/C' EVAL + 'J' STO
            \<<
              4 DUPN
              \-> E F A D
              \<<
                'J+A+D-F+12*E' EVAL
                IF 87 SAME THEN
                  A B C D E F G H I
                  9 \->LIST
                  8 ROLLD
                END
              \>>
            \>>
            'ob' STO

            1 4 START
              4 ROLL
              ROT ob EVAL
              ROT ob EVAL
              ROT ob EVAL
            NEXT

          END
          1
        \>>
      END
      DUP 5 SAME THEN DROP
        7 PICK 7 PICK MOD        @ test C divides B
      END
      DROP 0
      END
    \>>

    DOPERM2 +
  NEXT
 NEXT
\>>
3.8 seconds, 5 solutions, 4632 level-1 permutations checked

Code:
{ { 5 4 1 9 2 7 3 8 6 }
  { 9 3 1 6 2 5 7 8 4 }
  { 6 9 3 5 2 1 7 8 4 }
  { 5 3 1 7 2 6 8 9 4 }
  { 5 2 1 3 4 7 8 9 6 }
}

Cheers, Werner
Find all posts by this user
Quote this message in a reply
Post Reply 


Messages In This Thread
RE: Vietnamese snake puzzle - Dave Britten - 05-20-2015, 11:27 AM
RE: Vietnamese snake puzzle - Gerald H - 05-20-2015, 11:33 AM
RE: Vietnamese snake puzzle - Gerald H - 05-20-2015, 12:58 PM
RE: Vietnamese snake puzzle - Closed - Werner - 05-24-2015 06:40 PM



User(s) browsing this thread: 1 Guest(s)