Vietnamese snake puzzle - Closed

[Tugdual]

(05-21-2015 01:18 PM)fhub Wrote:  

(05-21-2015 11:53 AM)Tugdual Wrote:  I think there are 128 in my list and this is what Haskell returned.
Do you expect more?

Yes, I do expect more.

Your list is missing 8 additional solutions (due to rounding errors), there are 136 solutions in total - here the missing 8:
183745269
183745629
269851473
269851743
783145269
783145629
869251473
869251743

If you rewrite your equation (avoiding the 2 divisions by multiplying with the 2 denominators), then your program will give you all 136 solutions.
Edit: Or change the test to something like abs(expr-66)<1e-3 ...

Franz

Thanks! I'm getting used to the 50g CAS and tend to forget about wandering floats.

Code:

[x | x <- permutations [1..9], abs(x!!0+13*x!!1/x!!2+x!!3+12*x!!4-x!!5-11+x!!6*x!!7/x!!8-10-66) < 1E-6]

and do get the 136 answers (a bit slower by the way... but still pretty quick).

[Gerald H]

Pleased to say we ended up with all (?) the solutions.

Did we gain any insight? As far as I can see, just that there's more than one way to stuff a snake.

[Tugdual]

(05-22-2015 04:42 AM)Gerald H Wrote:  Pleased to say we ended up with all (?) the solutions.

Did we gain any insight? As far as I can see, just that there's more than one way to stuff a snake.

I don't think so.
Having had a look at the equation, I just see a 9 variables ordinary equation and nothing tinkles my brain. Basically you zero this:
\[\frac { 13*b*i+c*g*h }{ ci } +12*e+a+d-f-87\]

Note: I think the guardian agrees with the ordinary aspect: "There are some puzzles that you solve with a flash of insight, and some others – like this one – where there is no alternative but trial and error."

[Gerson W. Barbosa]

An RPL solution, basically what I did by hand, except that I was a bit smarter and didn't go through some impossible alternatives. But the hp 50g is much faster than I am, so no problem: less than four minutes to find four solutions which can be expanded to more by applying commutative properties of multiplication and addition (9 seconds on the emulator). Writing the program took a bit longer, however, no to mention I lost more the more complicated inner structers last night, by accidentally replacing it with something else. No backups, no notes as it had been done right on the calculator only.

Conclusion: better do this by hand :-)

Code:


%%HP: T(3)A(D)F(.);
\<< { 2. 3. 4. 5. 6. 7. 8. 9. } { } 2. 9.
  FOR i 2. 9.
    FOR b b i \=/
      IF
      THEN b 13. * 87. - 2. 9.
        FOR e e b \=/ e i \=/ AND
          IF
          THEN e 12. * OVER + 4. PICK 1.
            \<<
              IF DUP DUPDUP i == SWAP b == OR SWAP e == OR
              THEN DROP
              END
            \>> DOLIST 1. 4.
            FOR j j 1. + 5.
              FOR k DUP j GET OVER k GET DUP2 * i MOD
                IF NOT
                THEN 0. 0. 0. \-> g h a d f
                  \<< g h * i / PICK3 + OVER 1.
                    \<<
                      IF DUPDUP g == SWAP h == OR
                      THEN DROP
                      END
                    \>> DOLIST 1. 3.
                    START DUPDUP HEAD SWAP TAIL SWAP + SWAP PICK3 SWAP OBJ\-> DROP + NEG + ==
                      IF
                      THEN DUP2 NIP OBJ\-> DROP 'f' STO 'd' STO 'a' STO a b 1. d e f g h i { 9. } \->ARRY 7. ROLL + 6. ROLLD
                      END
                    NEXT DROP2
                  \>>
                ELSE DROP2
                END
              NEXT
            NEXT DROP2
          END
        NEXT DROP
      END
    NEXT
  NEXT NIP
\>>

{ [ 9. 4. 1. 5. 2. 7. 3. 8. 6. ] [ 3. 2. 1. 5. 4. 7. 8. 9. 6. ] [ 7. 3. 1. 5. 2. 6. 8. 9. 4. ] [ 6. 3. 1. 9. 2. 5. 7. 8. 4. ] }

This should work on the HP-48G also, only remember to make this changes and others I may have forgotten:

NIP: SWAP DROP
DUPDUP: DUP DUP
PICK3: 3 PICK

Gerson.

Edited to fix the range of the loops. I had found an incredible 50-second runtime but the outer loops were ranging from 2 to 6, 2 to 4 and 2 to 8, respectively, and yet the program returned the same four solutions. Something to be explored and analyzed to improve the program. There is still room for improvement such as better list handling, for instance.

P.S.: Considering our equation is

a + 13*b + d + 12*e - f - 11 + g*h/i = 76

We can write the following table:

b e f| result
-----+-------
9 x 8| > 109
8 x 9| > 95
7 2 9| > 106
6 2 9| > 90 => b < 6

x 9 8| > 100
x 8 9| > 87 => e < 8

5 7 9| > 140
5 6 9| > 120
4 5 9| > 106
3 5 9| > 90 => e < 5

Now we can safely define the ranges of the outer loops and be sure we won't miss any solution:

Code:


\<< { 2. 3. 4. 5. 6. 7. 8. 9. } { } 2. 9.
  FOR i 2. 5.
    FOR b b i \=/
      IF
      THEN b 13. * 87. - 2. 4.
        FOR e e b \=/ e i \=/ AND
  ...

{ [ 9. 4. 1. 5. 2. 7. 3. 8. 6. ] [ 3. 2. 1. 5. 4. 7. 8. 9. 6. ] [ 7. 3. 1. 5. 2. 6. 8. 9. 4. ] [ 6. 3. 1. 9. 2. 5. 7. 8. 4. ] }

33.6 seconds on the physical HP 50g!

This matches Tugdual's results when c=1, considering all valid permutations:

941527386
941527836
541927836
541927386

321547896
321547986
521347986
521347896

731526894
731526984
531726984
531726894

631925874
631925784
931625874
931625784

[Tugdual]

(05-22-2015 08:00 PM)Gerson W. Barbosa Wrote:  An RPL solution, basically what I did by hand, except that I was a bit smarter and didn't go through some impossible alternatives. But the hp 50g is much faster than I am, so no problem: less than four minutes to find four solutions which can be expanded to more by applying commutative properties of multiplication and addition (9 seconds on the emulator). Writing the program took a bit longer, however, no to mention I lost more the more complicated inner structers last night, by accidentally replacing it with something else. No backups, no notes as it had been done right on the calculator only.

Conclusion: better do this by hand :-)

Code:


%%HP: T(3)A(D)F(.);
\<< { 2. 3. 4. 5. 6. 7. 8. 9. } { } 2. 9.
  FOR i 2. 9.
    FOR b b i \=/
      IF
      THEN b 13. * 87. - 2. 9.
        FOR e e b \=/ e i \=/ AND
          IF
          THEN e 12. * OVER + 4. PICK 1.
            \<<
              IF DUP DUPDUP i == SWAP b == OR SWAP e == OR
              THEN DROP
              END
            \>> DOLIST 1. 4.
            FOR j j 1. + 5.
              FOR k DUP j GET OVER k GET DUP2 * i MOD
                IF NOT
                THEN 0. 0. 0. \-> g h a d f
                  \<< g h * i / PICK3 + OVER 1.
                    \<<
                      IF DUPDUP g == SWAP h == OR
                      THEN DROP
                      END
                    \>> DOLIST 1. 3.
                    START DUPDUP HEAD SWAP TAIL SWAP + SWAP PICK3 SWAP OBJ\-> DROP + NEG + ==
                      IF
                      THEN DUP2 NIP OBJ\-> DROP 'f' STO 'd' STO 'a' STO a b 1. d e f g h i { 9. } \->ARRY 7. ROLL + 6. ROLLD
                      END
                    NEXT DROP2
                  \>>
                ELSE DROP2
                END
              NEXT
            NEXT DROP2
          END
        NEXT DROP
      END
    NEXT
  NEXT NIP
\>>

{ [ 9. 4. 1. 5. 2. 7. 3. 8. 6. ] [ 3. 2. 1. 5. 4. 7. 8. 9. 6. ] [ 7. 3. 1. 5. 2. 6. 8. 9. 4. ] [ 6. 3. 1. 9. 2. 5. 7. 8. 4. ] }

This should work on the HP-48G also, only remember to make this changes and others I may have forgotten:

NIP: SWAP DROP
DUPDUP: DUP DUP
PICK3: 3 PICK

Gerson.

Edited to fix the range of the loops. I had found an incredible 50-second runtime but the outer loops were ranging from 2 to 6, 2 to 4 and 2 to 8, respectively, and yet the program returned the same four solutions. Something to be explored and analyzed to improve the program. There is still room for improvement such as better list handling, for instance.

Problem is hat your assumption c==1 is not valid. You really need to consider the 2 fractions as a whole instead of 2 individual fractions that deliver integers.

[Gerson W. Barbosa]

(05-22-2015 10:21 PM)Tugdual Wrote:  Problem is hat your assumption c==1 is not valid. You really need to consider the 2 fractions as a whole instead of 2 individual fractions that deliver integers.

Hi, Tugdual,

It was more a choice rather than an assumption. Since this problem was set up for eight-year old children, or so they say, I thought solutions involving fractional intermediate results might have been avoided. In that case, 'c' has necessarily to be 1. Also, I was only interested in finding at least one solution -- and this can be done by hand. Of course, the more complex problem of finding all possible solutions does require a calculating device, better if the task is accomplished in an elegant and compact fashion like you did.

Years ago, Karl Schneiner posted another interesting problem involving nine digits without repetions and fractions:

http://www.hpmuseum.org/cgi-sys/cgiwrap/...ead=112157

But please ignore my ugly brute force attemps there, except perhaps the Monte-Carlo approach at the end, despite it being extremely inefficient.

Gerson.

[Werner]

Gerson: for the intermediate results to be integer, c must divide b, which is not the same as saying c must be 1 ;-))

I've written an RPL solution as well that, on EMU48 at full pelt, cranks out all 136 solutions in 30 seconds. But I'm not happy with it yet.
I used Heap's algorithm to generate all permutations - then it took 256 seconds.
Including the condition that

Code:

MOD(13*b*i + g*h*c,c*i)=0

after having selected 5 numbers reduced the timing to 30 seconds.

Cheers,
Werner

[Gerson W. Barbosa]

(05-23-2015 09:08 AM)Werner Wrote:  Gerson: for the intermediate results to be integer, c must divide b, which is not the same as saying c must be 1 ;-))

You're right. Anyway, by choosing c = 1 I was able to find 16 solutions in 30 seconds on a physical HP 50g (see my edited post above), better than only one which was my goal in the first place.
But I recognize I shouldn't be lazy and should try to find all 136 solutions in a reasonable time. Perhaps one of these days I will :-)

Cheers,

Gerson.

[Werner]

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

[Gerson W. Barbosa]

(05-23-2015 09:08 AM)Werner Wrote:  I've written an RPL solution as well that, on EMU48 at full pelt, cranks out all 136 solutions in 30 seconds. But I'm not happy with it yet.
I used Heap's algorithm to generate all permutations - then it took 256 seconds.
Including the condition that

Code:

MOD(13*b*i + g*h*c,c*i)=0

after having selected 5 numbers reduced the timing to 30 seconds.

I've decided to change my RPL program to handle c for other values than 1, since it was just a matter of including another loop and do the necessary modifications. Perhaps the most difficult one would be determining the new the MOD condition, but I shamelessly used yours above (Thanks! :-). I've obtained 34 solutions (136/4) as expected, in 49.47 seconds on the emulator (Debug4x, Emu-50g, WinXP, Intel Core Duo CPU @ 1.86 GHz) -- 23 minutes and 31.9 seconds on the physical HP 50g. Ok, each solution should be processed to generate three additional ones, but that would take irrelevant time so I won't mind doing it.

Cheers,

Gerson.

Code:


%%HP: T(3)A(D)F(.);
\<< { 1. 2. 3. 4. 5. 6. 7. 8. 9. } { } 1. 9.
  FOR i 1. 9.
    FOR c c i \=/
      IF
      THEN 1. 9.
        FOR b b c \=/ b i \=/ AND
          IF
          THEN b 13. * c / 87. - 1. 7.
            FOR e e b \=/ e c \=/ AND e i \=/ AND
              IF
              THEN e 12. * OVER + 4. PICK 1.
                \<<
                  IF DUPDUP DUPDUP i == SWAP c == OR SWAP b == OR SWAP e == OR
                  THEN DROP
                  END
                \>> DOLIST 1. 4.
                FOR j j 1. + 5.
                  FOR k DUP j GET OVER k GET DUP2 * c * b 13. * i * + i c * MOD
                    IF NOT
                    THEN 0. 0. 0. \-> g h a d f
                      \<< g h * i / PICK3 + OVER 1.
                        \<<
                          IF DUPDUP g == SWAP h == OR
                          THEN DROP
                          END
                        \>> DOLIST 1. 3.
                        START DUPDUP HEAD SWAP TAIL SWAP + SWAP PICK3 SWAP OBJ\-> DROP + NEG + - ABS .000001 <
                          IF
                          THEN DUP2 NIP OBJ\-> DROP 'f' STO 'd' STO 'a' STO a b c d e f g h i 9. \->LIST 1. \->LIST 7. ROLL SWAP + 6. ROLLD
                          END
                        NEXT DROP2
                      \>>
                    ELSE DROP2
                    END
                  NEXT
                NEXT DROP2
              END
            NEXT DROP
          END
        NEXT
      END
    NEXT
  NEXT NIP
\>>

{ { 7. 6. 4. 8. 5. 9. 1. 3. 2. } { 9. 6. 4. 3. 5. 8. 1. 7. 2. } { 1. 9. 6. 4. 5. 8. 3. 7. 2. } { 9. 4. 8. 5. 6. 7. 1. 3. 2. } { 2. 8. 6. 9. 4. 1. 5. 7. 3. } { 2. 6. 9. 8. 5. 1. 4. 7. 3. } { 6. 3. 1. 9. 2. 5. 7. 8. 4. } { 7. 3. 1. 5. 2. 6. 8. 9. 4. } { 7. 3. 2. 8. 5. 9. 1. 6. 4. } { 5. 7. 2. 8. 3. 9. 1. 6. 4. } { 8. 9. 2. 3. 1. 5. 6. 7. 4. } { 5. 9. 3. 6. 2. 1. 7. 8. 4. } { 3. 2. 8. 6. 5. 1. 7. 9. 4. } { 7. 2. 8. 9. 6. 5. 1. 3. 4. } { 3. 2. 1. 5. 4. 7. 8. 9. 6. } { 9. 4. 1. 5. 2. 7. 3. 8. 6. } { 1. 3. 2. 4. 5. 8. 7. 9. 6. } { 7. 5. 2. 8. 4. 9. 1. 3. 6. } { 8. 5. 2. 1. 4. 7. 3. 9. 6. } { 1. 5. 2. 3. 4. 8. 7. 9. 6. } { 9. 5. 3. 1. 4. 2. 7. 8. 6. } { 3. 2. 4. 8. 5. 1. 7. 9. 6. } { 1. 4. 8. 2. 7. 9. 3. 5. 6. } { 1. 3. 9. 4. 7. 8. 2. 5. 6. } { 9. 1. 2. 5. 6. 7. 3. 4. 8. } { 9. 3. 2. 1. 5. 6. 4. 7. 8. } { 7. 1. 4. 9. 6. 5. 2. 3. 8. } { 2. 1. 4. 3. 7. 9. 5. 6. 8. } { 7. 3. 4. 1. 6. 5. 2. 9. 8. } { 1. 3. 6. 2. 7. 9. 4. 5. 8. } { 7. 9. 6. 1. 5. 2. 3. 4. 8. } { 2. 9. 6. 3. 5. 1. 4. 7. 8. } { 7. 8. 3. 1. 4. 5. 2. 6. 9. } { 1. 2. 6. 4. 7. 8. 3. 5. 9. } }

I think this is correct, but I haven't checked it yet.

[Gerson W. Barbosa]

(05-24-2015 06:40 PM)Werner Wrote:  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.

10 seconds, 34 solutions, 7308 level-1 solutions checked

This means about 20 minutes on a real HP-48G. Mine takes 23m 32s on the HP 50g, but the 50g is about 5 to 7 times faster than the 48G. Also, high quality documentation -- unlike mine (none).

Congratulations!

Gerson.

[Werner]

(05-24-2015 08:20 PM)Gerson W. Barbosa Wrote:  I think this is correct, but I haven't checked it yet.

It passes the test:

Code:

\<<
  1
  \<<
    DUP EVAL \-> 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 DROP END
  \>>
  DOLIST
\>>

Though none of your solutions matches mine ;-) You take a different A/D order.

Cheers, Werner

[Gerald H]

What a can of snakes I opened.

& then I innocently believed it was done when all solutions were found!

[Gerson W. Barbosa]

(05-25-2015 06:33 AM)Werner Wrote:  

(05-24-2015 08:20 PM)Gerson W. Barbosa Wrote:  I think this is correct, but I haven't checked it yet.

It passes the test:

Code:

\<<
  1
  \<<
    DUP EVAL \-> 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 DROP END
  \>>
  DOLIST
\>>

Though none of your solutions matches mine ;-) You take a different A/D order.

I tried to optimize the innermost loop so that one, two or three permutations of the candidates to a, d and f were made as needed, rather than always three, but the DO-UNTIL loop ended up being slower than START-NEXT. Now it takes almost one minute longer: 24 min 53 sec. The output list pass the test also, mainly because it's the same list, only with the elements in reverse order :-).
The two nested FOR-NEXT loops one level higher generate the 10 combinations [ C(5,2)] of the five candidates to g, h, a, d and f. An optimization here might help. The HP 50g has C2P, P2C and CIRC, but I don't know if those can be used for this purpose.

Cheers,

Gerson.

Code:


%%HP: T(3)A(D)F(,);
\<< { 1, 2, 3, 4, 5, 6, 7, 8, 9, } { } 1, 9,
  FOR i 1, 9,
    FOR c c i \=/
      IF
      THEN 1, 9,
        FOR b b c \=/ b i \=/ AND
          IF
          THEN b 13, * c / 87, - 1, 7,
            FOR e e b \=/ e c \=/ AND e i \=/ AND
              IF
              THEN e 12, * OVER + 4, PICK 1,
                \<<
                  IF DUPDUP DUPDUP i == SWAP c == OR SWAP b == OR SWAP e == OR
                  THEN DROP
                  END
                \>> DOLIST 1, 4,
                FOR j j 1, + 5,
                  FOR k DUP j GET OVER k GET DUP2 * c * b 13, * i * + i c * MOD
                    IF NOT
                    THEN 0, 0, 0, \-> g h a d f
                      \<< g h * i / PICK3 + OVER 1,
                        \<<
                          IF DUPDUP g == SWAP h == OR
                          THEN DROP
                          END
                        \>> DOLIST 0, 1, CF
                        DO 1, + UNROT SWAP OVER OBJ\-> DROP + NEG + OVER - ABS ,000001 <
                          IF
                          THEN 1, SF OVER OBJ\-> DROP 'd' STO 'a' STO 'f' STO a b c d e f g h i 9, \->LIST 1, \->LIST 8, ROLL + 7, ROLLD
                          END 1, FS? NOT
                          IF
                          THEN SWAP DUP HEAD SWAP TAIL SWAP + SWAP
                          END UNROT SWAP DUP 3, == 1, FS? OR
                        UNTIL
                        END 3, DROPN
                      \>>
                    ELSE DROP2
                    END
                  NEXT
                NEXT DROP2
              END
            NEXT DROP
          END
        NEXT
      END
    NEXT
  NEXT NIP
\>>

P.S.:

Time on the HP 49G: 1h 09m 32s. 1h 12m 25s on the HP 48GX.

HP 48GX version:

Code:


%%HP: T(3)A(D)F(.);
\<< TIME { 1 2 3 4 5
6 7 8 9 } { } 1 9
  FOR i 1 9
    FOR c c i \=/
      IF
      THEN 1 9
        FOR b b c \=/
b i \=/ AND
          IF
          THEN b 13
* c / 87 - 1 7
            FOR e e
b \=/ e c \=/ AND e i \=/
AND
              IF
              THEN
e 12 * OVER + 4
PICK 1
\<<
  IF DUP DUP DUP2 i
== SWAP c == OR
SWAP b == OR SWAP e
== OR
  THEN DROP
  END
\>> DOLIST 1 4
FOR j j 1 + 5
  FOR k DUP j GET
OVER k GET DUP2 * c
* b 13 * i * + i c
* MOD
    IF NOT
    THEN 0 0 0 \-> g
h a d f
      \<< g h * i / 3
PICK + OVER 1
        \<<
          IF DUP
DUP g == SWAP h ==
OR
          THEN DROP
          END
        \>> DOLIST 0
1 CF
        DO 1 + ROT
ROT SWAP OVER OBJ\->
DROP + NEG + OVER -
ABS .000001 <
          IF
          THEN 1 SF
OVER OBJ\-> DROP 'd'
STO 'a' STO 'f' STO
a b c d e f g h i 9
\->LIST 1 \->LIST 8
ROLL + 7 ROLLD
          END 1 FS?
NOT
          IF
          THEN SWAP
DUP HEAD SWAP TAIL
SWAP + SWAP
          END ROT
ROT SWAP DUP 3 == 1
FS? OR
        UNTIL
        END 3 DROPN
      \>>
    ELSE DROP2
    END
  NEXT
NEXT DROP2
              END
            NEXT
DROP
          END
        NEXT
      END
    NEXT
  NEXT SWAP DROP
TIME ROT HMS-
\>>

[Gilles]

(05-24-2015 06:40 PM)Werner Wrote:  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.
(...)

Thanks a lot Werner for your usefull and efficiant DOPERM program !
Very interesting. It's now in my favorite programs ;D I wonder what could be the gain of a sys-RPL version ? Strangely there is no (as far I know) permutations library for the 50G.

[Werner]

@Gilles: thanks. I have a 'DOCOMB' lying around for years as well, that will let you execute an object for all combinations of m (input) out of n (size of list) objects.

For the arithmetic puzzle:
The G-H equivalence can be implemented in a much easier way: just test G>H (or vice versa) at the appropriate level ( 5 here):

Code:

  { 1 2 3 4 5 6 7 8 9 }
  \<<
    CASE
    DUP 4 SAME THEN DROP
      9 DUPN DROP2
      \-> B C G H 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
                10 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    @ test G > H
      7 PICK 7 PICK >
    END
    DUP 7 SAME THEN DROP
      9 PICK 9 PICK MOD        @ test C divides B
    END
    DROP 0            @ default: continue
    END
  \>>
  DOPERM2

And it's even slightly faster.

Cheers, Werner

[Gerson W. Barbosa]

(05-23-2015 09:08 AM)Werner Wrote:  Including the condition that

Code:

MOD(13*b*i + g*h*c,c*i)=0

after having selected 5 numbers reduced the timing to 30 seconds.

I've changed to the condition FP(13*b/c + g*h/i)=0, which is simpler and uses four multiplication/division operations instead of six. Since I take 13*b/c from the stack, this is reduced to only one multiplication and one division in the inner loop. Also, local variables 'a', 'd' and 'f' are not defined anymore. Running times are now 1h 05m 32.9s on the HP-48GX and 21m 51.9s on the HP 50g. I should revert to my original innermost loop, which apparently is faster, but I prefer to optimize the current one later. I'd be pleased with less than one hour's time on the HP-48GX :-)

Cheers,

Gerson.



HP-48GX:

Code:


%%HP: T(3)A(D)F(.);
\<< TIME { 1 2 3 4 5
6 7 8 9 } { } 1 9
  FOR i 1 9
    FOR c c i \=/
      IF
      THEN 1 9
        FOR b b c \=/
b i \=/ AND
          IF
          THEN b 13
* c / DUP 87 - 1 7
            FOR e e
b \=/ e c \=/ AND e i \=/
AND
              IF
              THEN
e 12 * OVER + 5
PICK 1
\<<
  IF DUP DUP DUP2 i
== SWAP c == OR
SWAP b == OR SWAP e
== OR
  THEN DROP
  END
\>> DOLIST 1 4
FOR j j 1 + 5
  FOR k DUP j GET
OVER k GET DUP2 * i
/ 7 PICK + FP
    IF NOT
    THEN \-> g h
      \<< g h * i / 3
PICK + OVER 1
        \<<
          IF DUP
DUP g == SWAP h ==
OR
          THEN DROP
          END
        \>> DOLIST 0
1 CF
        DO 1 + ROT
ROT SWAP OVER OBJ\->
DROP + NEG + OVER -
ABS .000001 <
          IF
          THEN 1 SF
OVER OBJ\-> DROP SWAP
ROT ROT b c ROT e 5
ROLL g h i 9 \->LIST
1 \->LIST 9 ROLL + 8
ROLLD
          END 1 FS?
NOT
          IF
          THEN SWAP
DUP HEAD SWAP TAIL
SWAP + SWAP
          END ROT
ROT SWAP DUP 3 == 1
FS? OR
        UNTIL
        END 3 DROPN
      \>>
    ELSE DROP2
    END
  NEXT
NEXT DROP2
              END
            NEXT
DROP2
          END
        NEXT
      END
    NEXT
  NEXT SWAP DROP
TIME ROT HMS-
\>>

HP 50g:

Code:


%%HP: T(3)A(D)F(.);
\<< { 1. 2. 3. 4. 5. 6. 7. 8. 9. } { } 1. 9.
  FOR i 1. 9.
    FOR c c i \=/
      IF
      THEN 1. 9.
        FOR b b c \=/ b i \=/ AND
          IF
          THEN b 13. * c / DUP 87. - 1. 7.
            FOR e e b \=/ e c \=/ AND e i \=/ AND
              IF
              THEN e 12. * OVER + 5. PICK 1.
                \<<
                  IF DUPDUP DUPDUP i == SWAP c == OR SWAP b == OR SWAP e == OR
                  THEN DROP
                  END
                \>> DOLIST 1. 4.
                FOR j j 1. + 5.
                  FOR k DUP j GET OVER k GET DUP2 * i / 7. PICK + FP
                    IF NOT
                    THEN \-> g h
                      \<< g h * i / PICK3 + OVER 1.
                        \<<
                          IF DUPDUP g == SWAP h == OR
                          THEN DROP
                          END
                        \>> DOLIST 0. 1. CF
                        DO 1. + UNROT SWAP OVER OBJ\-> DROP + NEG + OVER - ABS .000001 <
                          IF
                          THEN 1. SF OVER OBJ\-> DROP SWAP UNROT b c ROT e 5. ROLL g h i 9. \->LIST 1. \->LIST 9. ROLL + 8. ROLLD
                          END 1. FS? NOT
                          IF
                          THEN SWAP DUP HEAD SWAP TAIL SWAP + SWAP
                          END UNROT SWAP DUP 3. == 1. FS? OR
                        UNTIL
                        END 3. DROPN
                      \>>
                    ELSE DROP2
                    END
                  NEXT
                NEXT DROP2
              END
            NEXT DROP2
          END
        NEXT
      END
    NEXT
  NEXT NIP
\>>

[Werner]

Quote:I've changed to the condition FP(13*b/c + g*h/i)=0

Yes, I changed it to avoid rounding errors, but it turns out in the 48's decimal arithmetic we don't have any - in hindsight ;-)

My latest posted routine to find the 5 'full integer' solutions runs in 375 seconds on the EMU48 at 'authentic speed' setting, which should not be far off.
To find all solutions it needs approx. 1212 seconds or 20 minutes.

Cheers, Werner

[Gerson W. Barbosa]

(05-29-2015 07:14 AM)Werner Wrote:  

Quote:I've changed to the condition FP(13*b/c + g*h/i)=0

Yes, I changed it to avoid rounding errors, but it turns out in the 48's decimal arithmetic we don't have any - in hindsight ;-)

My latest posted routine to find the 5 'full integer' solutions runs in 375 seconds on the EMU48 at 'authentic speed' setting, which should not be far off.
To find all solutions it needs approx. 1212 seconds or 20 minutes.

Cheers, Werner

In addition to the condition e < 8, now I am using -17 < (f - a - d) < 7, which I had done when manually searching for a solution. Now the primary 34 solutions are found in 52m 15.9s on the HP-48GX and in 17m 38.7s on the HP 50g (17m 40.4s in the HP 50g version using DO-UNTIL instead of START-NEXT - definitely not worth in this case since most f, a, d in agreement with the second condition will have to be permutated three times anyway).
I think finding all solutions under one hour's time on the HP-48GX is quite acceptable :-)

Cheers,

Gerson.



HP-48GX:

Code:


%%HP: T(3)A(D)F(.);
\<< TIME { 1 2 3 4 5
6 7 8 9 } { } 1 9
  FOR i 1 9
    FOR c c i \=/
      IF
      THEN 1 9
        FOR b b c \=/
b i \=/ AND
          IF
          THEN b 13
* c / DUP 87 - 1 7
            FOR e e
b \=/ e c \=/ AND e i \=/
AND
              IF
              THEN
e 12 * OVER + 5
PICK 1
\<<
  IF DUP DUP DUP2 i
== SWAP c == OR
SWAP b == OR SWAP e
== OR
  THEN DROP
  END
\>> DOLIST 1 4
FOR j j 1 + 5
  FOR k DUP j GET
OVER k GET DUP2 * i
/ 7 PICK + FP
    IF NOT
    THEN \-> g h
      \<< g h * i / 3
PICK + DUP DUP -16
< SWAP 6 > OR
        IF
        THEN DROP
        ELSE OVER 1
          \<<
            IF DUP
DUP g == SWAP h ==
OR
            THEN
DROP
            END
          \>> DOLIST
1 3
          START DUP
TAIL OVER HEAD + 3
PICK ROT OBJ\-> DROP
+ NEG + - ABS
.000001 <
            IF
            THEN
DUP OBJ\-> DROP ROT
ROT b c ROT e 6
ROLL g h i 9 \->LIST
1 \->LIST 8 ROLL + 7
ROLLD
            END
          NEXT
DROP2
        END
      \>>
    ELSE DROP2
    END
  NEXT
NEXT DROP2
              END
            NEXT
DROP2
          END
        NEXT
      END
    NEXT
  NEXT SWAP DROP
TIME ROT HMS-
\>>

HP 50g:

Code:


%%HP: T(3)A(D)F(.);
\<< { 1. 2. 3. 4. 5. 6. 7. 8. 9. } { } 1. 9.
  FOR i 1. 9.
    FOR c c i \=/
      IF
      THEN 1. 9.
        FOR b b c \=/ b i \=/ AND
          IF
          THEN b 13. * c / DUP 87. - 1. 7.
            FOR e e b \=/ e c \=/ AND e i \=/ AND
              IF
              THEN e 12. * OVER + 5. PICK 1.
                \<<
                  IF DUPDUP DUPDUP i == SWAP c == OR SWAP b == OR SWAP e == OR
                  THEN DROP
                  END
                \>> DOLIST 1. 4.
                FOR j j 1. + 5.
                  FOR k DUP j GET OVER k GET DUP2 * i / 7. PICK + FP
                    IF NOT
                    THEN \-> g h
                      \<< g h * i / PICK3 + DUPDUP -16. < SWAP 6. > OR
                        IF
                        THEN DROP
                        ELSE OVER 1.
                          \<<
                            IF DUPDUP g == SWAP h == OR
                            THEN DROP
                            END
                          \>> DOLIST 1. 3.
                          START DUP TAIL OVER HEAD + PICK3 ROT OBJ\-> DROP + NEG + - ABS .000001 <
                            IF
                            THEN DUP OBJ\-> DROP UNROT b c ROT e 6. ROLL g h i 9. \->LIST 1. \->LIST 8. ROLL + 7. ROLLD
                            END
                          NEXT DROP2
                        END
                      \>>
                    ELSE DROP2
                    END
                  NEXT
                NEXT DROP2
              END
            NEXT DROP2
          END
        NEXT
      END
    NEXT
  NEXT NIP
\>>

Code:


%%HP: T(3)A(D)F(.);
\<< { 1. 2. 3. 4. 5. 6. 7. 8. 9. } { } 1. 9.
  FOR i 1. 9.
    FOR c c i \=/
      IF
      THEN 1. 9.
        FOR b b c \=/ b i \=/ AND
          IF
          THEN b 13. * c / DUP 87. - 1. 7.
            FOR e e b \=/ e c \=/ AND e i \=/ AND
              IF
              THEN e 12. * OVER + 5. PICK 1.
                \<<
                  IF DUPDUP DUPDUP i == SWAP c == OR SWAP b == OR SWAP e == OR
                  THEN DROP
                  END
                \>> DOLIST 1. 4.
                FOR j j 1. + 5.
                  FOR k DUP j GET OVER k GET DUP2 * i / 7. PICK + FP
                    IF NOT
                    THEN \-> g h
                      \<< g h * i / PICK3 + DUPDUP -16. < SWAP 6. > OR
                        IF
                        THEN DROP
                        ELSE OVER 1.
                          \<<
                            IF DUPDUP g == SWAP h == OR
                            THEN DROP
                            END
                          \>> DOLIST 0.
                          DO 1. + UNROT SWAP OVER OBJ\-> DROP + NEG + OVER - ABS .000001 <
                            IF
                            THEN 3. DUP UNPICK OVER OBJ\-> DROP SWAP UNROT b c ROT e 5. ROLL g h i 9. \->LIST 1. \->LIST 9. ROLL + 8. ROLLD
                            END OVER TAIL ROT HEAD + ROT DUP 3. ==
                          UNTIL
                          END 3. DROPN
                        END
                      \>>
                    ELSE DROP2
                    END
                  NEXT
                NEXT DROP2
              END
            NEXT DROP2
          END
        NEXT
      END
    NEXT
  NEXT NIP
\>>