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
Search
Member List
Calendar
Help
/
Vietnamese snake puzzle - Closed
