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
 Werner Senior Member Posts: 350 Joined: Dec 2013
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
 « Next Oldest | Next Newest »

 Messages In This Thread Vietnamese snake puzzle - Closed - Gerald H - 05-20-2015, 09:37 AM 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 - Dave Britten - 05-20-2015, 01:24 PM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-20-2015, 01:30 PM RE: Vietnamese snake puzzle - Closed - Dave Britten - 05-20-2015, 01:35 PM RE: Vietnamese snake puzzle - Closed - Gilles - 05-20-2015, 09:01 PM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-21-2015, 04:04 AM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-21-2015, 05:30 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-21-2015, 12:19 PM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-21-2015, 08:12 AM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-21-2015, 08:41 AM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-21-2015, 10:51 AM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-21-2015, 11:21 AM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-21-2015, 11:53 AM RE: Vietnamese snake puzzle - Closed - fhub - 05-21-2015, 01:18 PM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-21-2015, 01:51 PM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-21-2015, 12:02 PM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-21-2015, 12:29 PM RE: Vietnamese snake puzzle - Closed - Thomas Klemm - 05-21-2015, 01:14 PM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-22-2015, 04:42 AM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-22-2015, 12:04 PM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-22-2015, 08:00 PM RE: Vietnamese snake puzzle - Closed - Tugdual - 05-22-2015, 10:21 PM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-22-2015, 11:32 PM RE: Vietnamese snake puzzle - Closed - Werner - 05-23-2015, 09:08 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-24-2015, 03:14 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-24-2015, 08:20 PM RE: Vietnamese snake puzzle - Closed - Werner - 05-25-2015, 06:33 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-26-2015, 04:54 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-28-2015, 09:20 PM RE: Vietnamese snake puzzle - Closed - Werner - 05-24-2015 06:40 PM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-24-2015, 08:34 PM RE: Vietnamese snake puzzle - Closed - Gilles - 05-26-2015, 08:57 PM RE: Vietnamese snake puzzle - Closed - Gerald H - 05-25-2015, 07:14 AM RE: Vietnamese snake puzzle - Closed - Werner - 05-27-2015, 10:12 AM RE: Vietnamese snake puzzle - Closed - Werner - 05-29-2015, 07:14 AM RE: Vietnamese snake puzzle - Closed - Gerson W. Barbosa - 05-31-2015, 05:37 AM

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