Tripartite Palindromic Partition of Integer (HP 50g) Challenge

[2old2randr]

(03-19-2023 11:34 AM)Gerald H Wrote:  Here a suggestion for a more economical "PALIN" programme in 2old2randr's submission

Thank you, Gerald. I deliberately did not do this kind of optimization because I still don't "think" in RPL. However, I had incorporated your previous suggestions (the elimination of redundant RCL/STO instructions) in NTYPE and ALGO1-ALGO5. I'd done this last week but forgot to post here (it is available in my Github repository).

Sudhir

[BruceH]

Here is the latest revised version from peruna. A bit quicker by dint of using the SREV command so Library 256 needs to be attached.

Code:

DIR
  \->P
  \<< DUP \->STR 1. OVER SIZE 2 IDIV2 DUP 5. ROLLD + SUB DUP SREV ROT :: TAIL IFT + OBJ\-> DUP2 \<= :: P\|v IFT
  \>>
  P\|v
  \<< DUP \->STR 1. OVER SIZE 2 IDIV2 DUP 5. ROLLD + SUB DUP SREV OBJ\-> 1 \=/ { OBJ\-> 1 - \->STR DUP SREV ROT :: TAIL IFT + OBJ\-> NIP } { DROP2 2 - } IFTE
  \>>
  P3
  \<< \->P
    DO DUP2 - P2 DUP TYPE :: + { SWAP P\|v } IFTE
    UNTIL SWAP
    END
  \>>
  P2
  \<< \->P
    DO DUP2 - DUP2 < { DROP2 0. } { DUP \->STR DUP SREV \=/ { NOT SWAP P\|v } { 2. \->LIST } IFTE } IFTE
    UNTIL SWAP
    END
  \>>
END

[Gerald H]

It is not an error, 2old2randr, but for input

110020

the programme returns

110011
0
9

which you may consider inelegant?

[2old2randr]

Yes, indeed it is not pretty.

Fixed.

Sudhir

[3298]

Okay, you've been waiting long enough, here's a pre-release of my SysRPL take. There's a lot going on under the hood - I optimized it to hell and back: starting with a CRLIB replacement which is capable of embedding one command inside another (inspired by hints from the Nosy readme). Then there's a lot of callbacks and other runstream and return stack manipulation, and finally I figured out how to merge Algorithms I to IV into a single piece of code which only branches out into four separate code paths after the main loop is done.
As far as I can tell, everything I've implemented so far is working properly. The 107-digit number from post #72 finishes after 4.7733 seconds on real hardware.

Oh, by the way, you can use any base from 5 to 9999. I figured it wouldn't be much extra work, so I just built arbitrary-base support into it from the beginning. The (non-negative) number to be split goes on level 2, the base on level 1, and out come exactly three numbers which are palindromes in the given base. The three are sorted by magnitude, with the largest on level 3, and in cases where the proof's algorithms say that a less palindromes shall be generated, a 0 is used as placeholder.

But there's something I haven't finished yet: 6-digit numbers with a 1 as first digit. Some small parts of that are not yet implemented at all, the rest is awaiting testing (and some more optimization) - and because buggy SysRPL code can cause crashes or even memory corruption, I have replaced all the code responsible for numbers of that form with a placeholder throwing the error #DE1Bh ("To be implemented"). That should be safe enough, though not satisfying yet. Hence, "pre-release".

I'll go more in-depth in a future post, once I wrap up that 6-digit work. The rest of the code I consider finished, so you can dive in if you are feeling brave - both compiled library (L859) and source (as HPDIR) are attached.

[2old2randr]

Bravo, 3298!

If you ever have the time, an annotated version of your program would be (I think) a great resource for anyone trying to learn SysRPL ...

Sudhir

[Gerald H]

Great stuff, 3298, congrats!

On my 49G, revision 1.19-6, the number in posting 1 is successfully partitioned in 1.45 sec.

Similarly, 2old2randr, your programme takes 8.39 sec.

[Gerald H]

Further to posting # 76, towards the end of ALGO5 there is this segment

IF dn d3 - 10 MOD
THEN p1 1 1 PUT p1 n
1 PUT d2 DUP p1 2 ROT
PUT SWAP p1 n 1 - ROT
PUT ADD ADD ADD 'p1'
STO d3 1 - DUP p2 3
ROT PUT SWAP p2 n ROT
PUT ADD 'p2' STO dn
d3 - 10 MOD DUP p3 4
ROT PUT SWAP p3 n ROT
PUT ADD 'p3' STO
ELSE p1 1 1 PUT
p1 n 1 PUT d2 DUP p1
2 ROT PUT SWAP p1 n 1
- ROT PUT ADD ADD ADD
'p1' STO d3 2 - DUP
p2 3 ROT PUT SWAP p2
n ROT PUT ADD 'p2'
STO p3 4 1 PUT p3 n 1
PUT ADD 'p3' STO
END

the bold part of which is never visited.

Can you, 2old2randr, or anybody else construct a number using this branch?

My own variant of ALGO5 is

Code:

CKSUM # 40685d

SIZE 845.5

« 1 OVER SIZE 2
IQUOT 10 OVER ^ DUP
10 / + 5 PICK OVER
- I→NL REVLIST →
num p1 mult m s d
  «
    IF d m DUP2 GET
UNROT 1 + GET *
    THEN d REVLIST
    ELSE 'mult'
INCR DROP num s 2 *
- I→NL
    END NTYPE →
type special d p1
p2 p3
    «
      CASE p1 SIZE
2 MOD
        THEN d
REVLIST DUP SIZE →
d n
          « d DUP 2
GET OVER 3 GET ROT
n GET n ZEROLST 3
NDUPN DROP → d2 d3
dn p1 p2 p3
            « d2 p1
1 1 PUT n 1 PUT 2
PICK3 PUT n 1 - ROT
PUT 'p1' STO d3
              IF dn
OVER - 10 MOD
              THEN
1 - p2 3 PICK3 PUT
n ROT PUT 'p2' STO
dn d3 - 10 MOD p3 4
PICK3 PUT n ROT
              ELSE
HALT 2 - p2 3 PICK3
PUT n ROT PUT 'p2'
STO p3 4 1 PUT n 1
              END
PUT 'p3' STO d
REVLIST p1 CMPLST
p2 CMPLST p3 CMPLST
ALGO4
            »
          »
        END d p1 p2
p3 type HEAD "A" ==
        THEN ALGO2
        END ALGO4
      END
    » ROT s mult *
+ UNROT
  »
»

[3298]

I haven't looked at the UserRPL code at all, but from the info that it's in Algorithm V I'd hazard a guess that it's either handling the rare case of needing \(k=2\) (which happens when the central digits this algorithm is meant to change were \(20\) or \(01\)), or the even rarer case that the subtraction would make the longest palindrome of \(n'\) shorter than that of \(n\). The latter happens when:
- The top three digits of \(n\) qualify for type B1 or B2, but decrementing the third switches the type to A5 or A6. That is, they are \(103\) if the last digit is \(3\), or \(104\) otherwise.
- The center digits generate a carry on the subtraction. This applies to \(20\), \(10\), and \(0x\) for any digit \(x\).
- The digits between the top end and the center propagate the carry all the way through. The only way for that happening is if they are all \(0\).
With all those conditions in mind, try \(104002067679\). That should satisfy both rare conditions at the same time.

[Gerald H]

No, 3298, does not reach that branch - I imagine it has been dealt with under a different category, providing a correct partition.

[Gerald H]

Partition for

104002067679

is

101113311101
2236666322
652090256

[2old2randr]

I haven't been able to construct such a number.

What is happening here is that numbers of the form 103... with an even number of digits can be handled by either ALGO1 or ALGO4. However, if we classified them as A5/A6 and applied ALGO1, we would have an odd number of digits for p1 which causes a problem when adding back the number subtracted initially. So we pretend that the number is of type B1/B2 and apply ALGO4. The B2 path will be taken only if the last digit is '3' and this doesn't seem to be possible - at least I have not been able to find an example.

[Gerald H]

ALGO5 now smaller:

Code:

CKSUM #12287d

SIZE 769

« 1 OVER SIZE 2
IQUOT 10 OVER ^ DUP
10 / + 5 PICK OVER
- I→NL REVLIST →
num p1 mult m s d
  «
    IF d m DUP2 GET
UNROT 1 + GET *
    THEN d REVLIST
    ELSE 'mult'
INCR DROP num s 2 *
- I→NL
    END NTYPE →
type special d p1
p2 p3
    «
      CASE p1 SIZE
2 MOD
        THEN d
REVLIST DUP SIZE
OVER 2 GET PICK3 3
GET 4 PICK 4 PICK
GET 4 PICK ZEROLST
3 NDUPN DROP → n d2
d3 dn p1 p2 p3
          « REVLIST
d2 p1 1 1 PUT n 1
PUT 2 PICK3 PUT n 1
- ROT PUT CMPLST d3
            IF dn
OVER - 10 MOD
            THEN 1
- p2 3 PICK3 PUT n
ROT PUT CMPLST dn
d3 - 10 MOD p3 4
PICK3 PUT n ROT
            ELSE
HALT 2 - p2 3 PICK3
PUT n ROT PUT
CMPLST p3 4 1 PUT n
1
            END PUT
CMPLST ALGO4
          »
        END d p1 p2
p3 type HEAD "A" ==
        THEN ALGO2
        END ALGO4
      END
    » ROT s mult *
+ UNROT
  »
»

[Gerald H]

Concerning the branch mentioned in postings # 76 & #88, I have exhaustively tested all 8-digit integers beginning 103- & 104-, all of which were successfully partitioned without using the path in question.

Is that sufficient to say that no integer will require that section of the programme ALGO5?

[Gerald H]

A week passes & not much development.

Should you, 3298, lack inspiration you might consider 2old2randr's solution for 6 digit inputs starting with a "1", my adaptation of which is here:

Code:

« DUP
  IF HEAD 1 ‹
  THEN NIP NTYPE 5
ROLL 6 ROLL DROP2
ALGO2
  ELSE OBJ→ ROLL
DROP DUP 6 PICK -
DUP 1 + 10 MOD SWAP
2 + 10 MOD 0 7.
NDUPN DROP → num d4
d3 d2 d1 d0 m1 m2
p1 p2 p3 x y z c
    «
      IF m1 m2 *
      THEN 9 d4 +
DUP 2 / IP DUP 'y'
STO - 10001 * 9090
+ 'p1' STO y 10001
* d3 1010 * + 'p2'
STO m1 101 * 9 d4 +
m1 + 10 / IP 'c'
STO d1 9 - d3 - c -
10 MOD DUP 'z' STO
10 * + 'p3' STO c 9
+ d3 + z + 10 / IP
'c' STO 10 d2 + c -
m1 - DUP
        IF 9 >
        THEN 9 -
100 * 'p2' STO+ 900
        ELSE 100 *
        END 'p1'
STO+
      ELSE
        IF m2 NOT
d2 AND
        THEN 9 d4 +
DUPDUP 2 / IP 'y'
STO y - 10001 *
9090 + 'p1' STO y
10001 * d3 1010 * +
'p2' STO 909 SWAP 9
+ 10 / IP 'c' STO
d1 9 - d3 - c - 10
MOD 'z' STO z 10 *
+ 'p3' STO c 9 + d3
+ z + 10 / IP 'c'
STO 10 d2 + c - 9 -
DUP
          IF 9 >
          THEN 9 -
100 * 'p2' STO+ 900
          ELSE 100
*
          END 'p1'
STO+
        ELSE
          IF m2 d2
+ NOT
          THEN
            CASE d4
1 ‰
              THEN
IF d4
THEN 90009
ELSE 80008
END 'p1' STO 10001
d3 1010 * + 'p2'
STO 9009 d1 d3 - 1
- 10 MOD DUP 'z'
STO 110 * + 'p3'
STO 1 d3 + z + 10 /
IP 'c' STO 10 c - z
- DUP
IF 9 >
THEN 9 - 100 * 'p2'
STO+ 900
ELSE 100 *
END 'p1' STO+
              END
d4 2 ==
              THEN
90009 'p1' STO
20002 d3 1010 * +
'p2' STO 9009 d1 d3
- 2 - 10 MOD DUP
'z' STO 110 * +
'p3' STO 2 d3 + z +
10 / IP 'c' STO
IF c 2 ‹
THEN 10 c - z - DUP
  IF 9 >
  THEN 9 - 100 *
'p2' STO+ 900
  ELSE 100 *
  END 'p1' STO+
ELSE 128821 'p1'
STO 171 'p2' STO 8
'p3' STO
END
              END
100001 1 d3 1 - 10
MOD 1 + d3 - 10 /
IP DUP 'c' STO -
10010 * + 'p1' STO
d3 1 - 10 MOD 'y'
STO d1 d3 - 1 - c +
10 MOD DUP 'z' STO
10 * 808 + 'p3' STO
2 c - y + z + d1 -
10 / IP 'c' STO 2 c
- 100 * d4 1 -
10001 * + y 1010 *
+ 'p2' STO
            END
          ELSE
            IF m1
NOT d3 *
            THEN
              IF d4
9 ‹
              THEN
10 d4 + 2 / IP 'y'
STO 90009 d3 1 -
1010 * + 'p1' STO
d4 1 + 10001 * 'p2'
STO 19 d4 + 10 / IP
'c' STO d1 d3 - 1 +
c - 10 MOD DUP 'z'
STO 10 * 909 + 'p3'
STO c d3 + 1 - z +
10 / IP 'c' STO d2
1 + c - DUP
IF 9 >
THEN 9 - 100 * 'p2'
STO+ 900
ELSE 100 *
END 'p1' STO+
              ELSE
0 0 0 0 → c1 c2 c3
mu
« 0 'y' STO d1 3 -
  DO
  UNTIL DUP 'y'
INCR - 10 MOD 8 <
  END d3 y - 10 MOD
'x' STO 3 y + SWAP
y - 10 MOD + d1 -
10 / IP 'c1' STO d2
x - 1 - c1 - 10 MOD
x + c1 + 1 + d2 -
10 / IP 'c2' STO
  IF c2 1 >
  THEN 1 'mu' STO 1
'c2' STO 9 'x' STO
  END x y + d3 - 10
/ IP 'c3' STO
100001 3 c3 - 10010
* + x mu - 1100 * +
'p1' STO 60006 y c2
- mu + 1010 * + d2
x - 1 - c1 - mu +
10 MOD 100 * + 'p2'
STO d1 3 - y - 10
MOD c2 + mu - c3 +
10 * 101 + 'p3' STO
»
              END
            ELSE
              IF m1
d3 + NOT
              THEN
CASE d4 NOT
  THEN
    CASE d2 DUP NOT
d1 AND d1 9 ‹ AND
OR
      THEN 100001
num OVER - PALIN
DROP
      END d2 d1 +
NOT
      THEN 100001 8
0
      END 90109
9889 101
    END
  END d4 1 ==
  THEN
    CASE d2 1 > d2
1 == d1 AND OR
      THEN 110011
num OVER - PALIN
DROP
      END d2 1 ==
d1 NOT AND
      THEN 109901
191 8
      END d2 1 ==
d1 1 == AND
      THEN 110011
99 0
      END d2 NOT d1
1 > AND
      THEN 110011
d1 DUP 2 - 11 * 11
ROT - OVER NOT ::
SWAP IFT
      END 100001 d2
NOT d1 1 == AND
      THEN 10001 8
      END 9999 0
    END
  END d4 2 ==
  THEN
    CASE d2 1 > d2
1 == d1 1 > AND OR
      THEN 120021
num OVER - PALIN
DROP
      END d2 1 ==
d1 NOT AND
      THEN 119911
181 9
      END d2 d1 * 1
==
      THEN 119911
191 9
      END d2 NOT d1
2 > AND
      THEN 120021
        CASE d1 3 ‹
          THEN d1 3
- 10 * d1 3 - + 13
d1 -
          END 9 1
        END
      END d2 NOT d1
2 == AND
      THEN 119911
101 9
      END d2 NOT d1
1 == AND
      THEN 100001
20002 8
      END 119911 88
2
    END
  END 0 'y' STO d1
1 -
  DO
  UNTIL DUP 'y'
INCR - 10 MOD DUP 9
‹ AND
  END d4 3 ==
  THEN 0 0 → c1 c2
    « 2 y + SWAP y
- 10 MOD + d1 - 10
/ IP 'c1' STO 9 y -
d2 y + 2 + 10 MOD +
9 + d2 - 10 / IP
'c2' STO 100001 9 y
- c1 - 1100 * +
20002 y c2 - 1 + c1
+ 1010 * + d2 y + 2
+ 10 MOD 100 * + d1
1 - y - 10 MOD c2 +
1 - c1 - 10 * 909 +
    »
  END 1 y + SWAP y
- 10 MOD + d1 - 10
/ IP 11 y - d2 y +
1 - 10 MOD + d2 -
10 / IP → c1 c2
  « 120021 10 y -
c1 - 1100 * + d4 3
- 10001 * y c2 - c1
+ 1010 * + d2 y + 1
- 10 MOD 100 * + d1
2 - y - 10 MOD c2 +
c1 - 10 * 101 +
  »
END 'p3' STO 'p2'
STO 'p1' STO
              END
            END
          END
        END
      END p1 R→I p2
R→I p3 R→I
    »
  END
»

Alternatively you could adopt peruna's solution restricted to numbers with a maximum of six digits - this would not give a "canonical" partition as in the proof, but as far as I'm concerned any valid tripartite partition is good, the ones specified in the proof are just as good as any other, eg the partition in posting #1.

[3298]

No need for further inspiration, it's all finished. Most of the work was already done by the time I read your post, only those really hard-to-understand cases iv.b, v.d, and v.e still needed some attention. Bugfixes happened last night, and just now I applied some extra optimization across the rest of the library - mostly minor changes, the most notable ones are a slight restructuring of pickType to use only a single call to pickTypeB1B2 (which got properly inlined in the process, it only was a separate source file before due to a requirement of the unreleased CRLIB replacement I use to generate the 'compile' file), and switching the easy-access subroutine slot known as 2GETEVAL from the (previously unnamed) helper BINTmod over to computeCarryAndRem, which is used in a few more places.

Speaking of subroutine calls, since the library only has a single user-accessible entry point, I could convert it into a plain program with not much effort. I even have two different ideas how to call subroutines when the ROMPTRs of a library are out: shoving them all into LAMs bound at the start and doing xxGETLAM EVAL in every call site; or keeping them inline in one of the call sites (as I already have, thanks to the Nosy readme's library-in-MASD procedure) and doing position-relative calls from the other sites (loosely following the relative GOTO procedure) with the 2GETEVAL slot dedicated to the code object enabling this type of call. Not sure if such a conversion is worth it though, so I would do it on request.

Next job: writing the promised wall of text going into the code's details. I don't think it'll be a suitable resource for people trying to learn SysRPL (sorry 2old2randr), that would be simply overwhelming with all the tricks I used; but an intermediate programmer may pick up something useful. For experts it's probably going to be just entertainment.

[Gerald H]

Quite brilliant, 3298, & your programming is quite beyond me - I've never ventured into the vocabulary you articulate into executable units.

I hope some members will test your programme over the next week, I intend to & will report back.

SysRPL at my level, entry level, is a translation of UserRPL, words dispensing with argument checking (which means you must supply correct arguments), unlike your User programme, 2old2randr, where "+" can add nearly any 2 types of argument together & produce a meaningful result, eg "A" + 2 -> "A2". A simple example of SysRPL is here

https://www.hpmuseum.org/forum/thread-42...t=lagrange

While 3298's pogramme is faster than yours I suspect a direct translation into SysRPL would not be slower than his - however, the first requirement is to make the User programme more efficient. Your programme is very useful didactically, it is much easier to follow the text of the proof when going through the programmes step by step & fortunately your nomenclature for the variables is based on that of the proof.

I am enormously pleased with the three solutions to the challenge & should a fourth emerge....

[2old2randr]

I've gotten reasonably comfortable with simple programs in SysRPL that are pure numerical computations by studying examples in MoHPC and have embarked on translating my user RPL code to SysRPL.

Where I'm having trouble is with more complex data structures e.g., lists. I'm working with the Kalinowski & Dominik book "Programming in System RPL", 2nd ed. However, some of the documentation seems inaccurate and being hampered by not having an emulator (I don't have a Windows PC), I am making slow progress since everything needs to be tested on the calculator.

For example, the following minimal program to extract the first element of a list crashes the calculator.

Code:

:: CK1NOLASTWD
   CK&DISPATCH1
   list ::
       ^CKCARCOMP
   ;
;

Replacing ^CKCARCOMP (supposedly specific to lists, p 73 of the book) by "1 NTHCOMPDROP" (generic function that works on any composite) works. I haven't been able to find example code that handles lists to see what the normal style is so I'm experimenting and learning ...

[Gerald H]

Firstly

CARCOMP

suffices, secondly

FPTR2 ^CKCARCOMP

is the correct form for the command you used.

[Gerald H]

You can do all Sys programming on the calculator using the three libraries

Emacs
SDiag
Nosy

all available at

https://www.hpcalc.org/