(49G) OEIS A046034 : Numbers Composed Exclusively of Digits 2, 3, 5, 7

[Gerald H]

For integer input N the programme returns the Nth element of the series

https://oeis.org/A046034

NB The description below uses the expression

eg Z3_

for ZINT 3.

The two are however NOT the same, Z3_ at PTR 273CE having 2.5 Bytes & ZINT 3 having 6 Bytes.

The size & check sum below are for the version as printed.

Code:

::
  CK1&Dispatch
  # FF
  ::
    Z3_
    FPTR2 ^RMULText
    Z1_
    FPTR2 ^RADDext
    DUP
    FPTR2 ^Z>R
    %LN
    %4
    %LN
    %/
    %FLOOR
    COERCESWAP
    Z4_
    3PICK
    FPTR2 ^RP#
    FPTR2 ^RSUBext
    NULL$
    ROT
    ZERO_DO
    OVER
    Z3_
    Z4_
    INDEX@
    FPTR2 ^RP#
    FPTR2 ^RMULText
    FPTR2 ^ZQUOText
    DUPDUP
    FPTR2 ^RADDext
    Z1_
    FPTR2 ^RADDext
    Z8_
    FPTR2 ^ZMod
    OVER
    Z4_
    FPTR2 ^ZQUOText
    FPTR2 ^RADDext
    SWAP
    Z1_
    FPTR2 ^RSUBext
    Z4_
    FPTR2 ^IDIV2
    DROP
    FPTR2 ^RSUBext
    FPTR2 ^Z>S
    SWAP&$
    LOOP
    SWAPDROP
    FPTR2 ^S>Z
  ;
;

SIZE 200.5

CKSUM # 118Bh

[Gerald H]

A faster version of the programme:

Code:

::
  CK1&Dispatch
  # FF
  ::
    Z1_
    SWAP
    Z3_
    FPTR2 ^RMULText
    Z1_
    FPTR2 ^RADDext
    DUP
    FPTR2 ^Z>R
    %LN
    %4
    %LN
    %/
    %FLOOR
    COERCESWAP
    Z4_
    3PICK
    FPTR2 ^RP#
    FPTR2 ^RSUBext
    NULL$
    ROT
    ZERO_DO
    OVER
    4ROLL
    DUP
    Z4_
    FPTR2 ^RMULText
    5UNROLL
    Z3_
    FPTR2 ^RMULText
    FPTR2 ^ZQUOText
    DUPDUP
    FPTR2 ^RADDext
    Z1_
    FPTR2 ^RADDext
    Z8_
    FPTR2 ^ZMod
    OVER
    Z4_
    FPTR2 ^ZQUOText
    FPTR2 ^RADDext
    SWAP
    Z1_
    FPTR2 ^RSUBext
    Z4_
    FPTR2 ^IDIV2
    DROP
    FPTR2 ^RSUBext
    FPTR2 ^Z>S
    SWAP&$
    LOOP
    ROTROT2DROP
    FPTR2 ^S>Z
  ;
;

[Joe Horn]

If you use the standard HP extable library and 50g's built-in assembler, you can use Gerald's source code if you add the following lines to the very beginning:

Code:

EQU Z1_ 273B6
EQU Z3_ 273CE
EQU Z4_ 273DA
EQU Z8_ 2740A

[Gerald H]

But this programme is much faster & shorter:

Size: 146.

CkSum: # 71CDh

Code:

::
  CK1&Dispatch
  # FF
  ::
    DUP
    ZINT 1
    Z<
    caseSIZEERR
    NULL$SWAP
    BEGIN
    ZINT 4
    FPTR2 ^ZDIVext
    ::
      ZINT 1
      EQUALcasedrop
      "2"
      ZINT 2
      EQUALcasedrop
      "3"
      ZINT 3
      EQUALcase
      "5"
      "7"
      SWAP
      ZINT 1
      FPTR2 ^RSUBext
      SWAP
    ;
    ROT
    &$SWAP
    DUP
    ZINT 0
    EQUAL
    UNTIL
    DROP
    FPTR2 ^S>Z
  ;
;

[Eric Rechlin]

With that last version, I get 146.5 bytes and #FA74h, and it just hangs when I run it.

[Gerald H]

I just copied the published source code & compiled on my 50g.

Result is that programme works correctly,

size 146

Cksum 71CD.

Has anyone besides Eric had problems?

[Gerald H]

A slightly shorter version:

Size: 132

CkSum: # 7092h

Code:

::
  CK1&Dispatch
  # FF
  ::
    DUP
    ZINT 1
    Z<
    caseSIZEERR
    NULL$SWAP
    BEGIN
    ZINT 4
    FPTR2 ^ZDIVext
    ::
      ZINT 1
      EQUALcasedrop
      CHR_2
      ZINT 2
      EQUALcasedrop
      CHR_3
      ZINT 3
      EQUALcase
      CHR_5
      CHR_7
      SWAP
      ZINT 1
      FPTR2 ^RSUBext
      SWAP
    ;
    ROTSWAP
    >H$
    SWAPDUP
    ZINT 0
    EQUAL
    UNTIL
    DROP
    FPTR2 ^S>Z
  ;
;

[Joe Horn]

(09-04-2017 08:02 PM)Gerald H Wrote:  Has anyone besides Eric had problems?

Both of the versions above this reply run fine on my 50g, and have the sizes and checksums that you cited above.

[Eric Rechlin]

Hmmm...interesting. I am thinking this is a bug in Jazz.

Using the same extable library, Jazz (which I have been using for all of Gerald's posts because I'm too lazy to add the !RPL !NO_CODE to the beginning and @ to the end) compiles it incorrectly, giving the incorrect bytes/checksum that I listed. The built in assembler (ASM) works fine.

What makes it even more interesting is when I do a ->S2 on it, both the Jazz compiled code and the ASM compiled code decompile to the same source.

Inspecting the hexadecimal representations of both shows the difference. They are almost identical. The only difference is that Jazz compiles the ZINT 0 to the following, which is a positive signed zero:

41620 (DOINT)
7000000

And ASM compiles ZINT 0 to the following, which is an unsigned zero (which is correct -- zero should not be signed):

41620 (DOINT)
600000

The former does not work; the latter works fine. But calling ->S2 on either yields the same thing:

!NO CODE
!RPL
ZINT 0
@

Sorry for the false alarm, Gerald. Looks like Jazz is incorrectly putting a sign on zero!

[Gerald H]

Pleased to hear it works OK, Eric.

It is pleasant to know that someone goes to the trouble of compiling & using my programmes.

Indeed, some positive feedback would be nice as informing that there is some degree of interest in such programmes.

I guess comments like "Best programme I've ever seen" or "This programme has changed my life" or "Before I used this programme I was a bum, now I'm a multi-millionaire" would be appropriate.

However, most members of the forum don't always write what they believe but moderate their expressions to something like "Well done".

Suggestions for improvements most welcome.

[Gerald H]

Having once again carried out my weekly review checking for improvements & none having been published I guess the programme above is perfectly perfect.

Accordingly it may now be considered the final form.

The programme below carries out the inverse transformation.

I have attempted some error checking to ensure only compatible input is processed but it's better only to input correctly conformed integers.

Not yet a multi-millionaire & time's running out.

Code:

Size: 157.5

CkSum: # 1016d

::
  CK1&Dispatch
  # FF
  ::
    FPTR2 ^Z>S
    DUP
    BINT2
    BINT3
    BINT5
    BINT7
    5ROLL
    BINT4
    ZERO_DO
    SWAP
    #>$
    NULL$
    FPTR F 1A
    DROPLOOP
    LEN$
    #0<>
    case
    FPTR2 ^DROPZ0
    ZINT 0
    SWAPDUP
    LEN$
    ZERO_DO
    DUP
    CDR$
    SWAP
    CAR$
    CHR>#
    BINT49
    #-DUP
    BINT2
    #>
    IT
    ::
      #1-DUP
      #5=
      NOT?SEMI
      #1-
    ;
    FPTR2 ^#>Z
    ROT
    ZINT 4
    FPTR2 ^RMULText
    FPTR2 ^RADDext
    SWAPLOOP
    DROP
  ;
;