Threaded Mode | Linear Mode

Gerald H · (This post was last modified: 09-10-2017 11:34 AM by Gerald H.)

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

https://oeis.org/A028842

where the elements are all numbers in naturally ascending order whose product of digits is a prime.

I am particularly unhappy with this

4. OVER
WHILE DUP2 <
REPEAT OVER -
SWAP 4. + SWAP
END

section of code & would welcome a speedier method of calculating the 2 numbers deposited on the stack.

SIZE 173.

CKSUM # 502Fh

Code:

« 4. OVER

  WHILE DUP2 <

  REPEAT OVER -

SWAP 4. + SWAP

  END "" 1. 4. ROLL

4. /

  START "1" +

  NEXT OBJ→ SWAP 4.

IDIV2 DUP

  IF

  THEN DUP 3. ==

    IF

    THEN DROP 4

    END

  ELSE DROP 1. - 6

  END 10 ROT R→I ^

* + SWAP DROP

»

Joe Horn · (This post was last modified: 09-06-2017 04:50 AM by Joe Horn.)

(09-05-2017 02:43 PM)Gerald H Wrote: I am particularly unhappy with this

4. OVER
WHILE DUP2 <
REPEAT OVER -
SWAP 4. + SWAP
END

section of code & would welcome a speedier method of calculating the 2 numbers deposited on the stack.

For input X, it returns two numbers A and B. An algorithm that generates A from X is this:

2. / √ 0 RND 4 *

Its accuracy is limited by its use of real square roots. Rewriting it for integer accuracy, and generating B from X and A, are left as exercises for the student. Wink

EDIT: I wrote that because I was having a devil of a time figuring out how to do it! It finally dawned on me after staring at the numbers long enough. Here's a routine that inputs X and outputs X, A, B:

Code:

DUP 2. / √ DUP 0. RND 4. * SWAP .5 + FP OVER * CEIL

The bigger the input, the larger the speed difference. For an input of 1E7, the loop takes 11 seconds, and the direct approach takes 0.022 seconds, 500 times faster.

EDIT 2: Due to roundoff errors, this routine gets incorrect results for large inputs. Don't trust the output for inputs > 1E11. It seems to be ok for anything smaller than that.

Gerald H · 09-06-2017, 05:43 AM

Brilliant, Joe! Thank you.

Resulting in the programme below.

The round off error will not be relevant in this programme as 50g has too little memory to find 20,000 digit numbers.

Code:

« DUP 2. / √ DUP 0.

RND 4. * SWAP .5 +

FP OVER * CEIL 10

ROT 4 / R→I ^ 1 - 9

/ SWAP 4. IDIV2 DUP

{ DUP 3. == { DROP

4 } IFT } { DROP 1.

- 6 } IFTE 10 ROT

R→I ^ * + SWAP DROP

»

Joe Horn · 09-06-2017, 06:27 AM

{I totally understand how this program works!} COERCEFLAG {Best programme I've ever seen! This programme has changed my life! Before I used this programme I was a bum, now I'm a multi-millionaire!} {Well done!} IFTE

Gerald H · 09-06-2017, 11:57 AM

Very nice, problem solved up to limit of 50g's memory.

But is it?

For input

35918081

the programme returns

11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111112111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111

which is correct, but where's the 2? Aha! There it is. OK, so where is it? Position please.

Standard decimal number system is unsuited to large numbers.

Accordingly the programme below for the same input returns

:# Digits: 4238 (total number of digits in answer)

:Pos: 1318 (position of the non-1 digit, counting from right)

:Digit: 2 (the embedded prime digit)

which I think displays the answer more clearly.

So we can now represent the answer for much larger input given some way of getting Joe's programme to work exactly.

Suggestions welcome.

Size: 185.5

CkSum: # 9CBBh

Code:

::

  CK1&Dispatch

  BINT1

  ::

    %ABS

    %2

    %/

    %SQRT

    DUP

    %0

    RNDXY

    %4

    %*

    SWAP

    %.5

    %+

    %FP

    OVER

    %*

    %CEIL

    SWAP

    %4

    %/

    FPTR2 ^R>Z

    "# Digits"

    >TAG

    SWAP

    FPTR2 ^R>Z

    ZINT 4

    FPTR2 ^IDIV2

    FPTR2 ^Z>R

    SWAP

    FPTR2 ^Z>R

    %1+

    SWAP

    ::

      %3

      EQUALcasedrop

      %4

      DUP%0=

      NOT?SEMI

      DROP

      %1-

      %6

    ;

    %1+

    FPTR2 ^CK2Z

    "Digit"

    >TAG

    SWAP

    "Pos"

    >TAG

    SWAP

  ;

;

Gerald H · 09-06-2017, 03:44 PM

Joe's programme snippet can be replaced by

Code:

::

  CK1&Dispatch

  BINT1

  ::

    %ABS

    DUP

    %2

    %/

    %SQRT

    %0

    RNDXY

    DUP

    %4

    %*

    3UNROLL

    DUP

    %1-

    %*

    DUP

    %+

    %-

  ;

;

Putting that in the initial user programme gives

Code:

« DUPDUP 2. / √ 0.

RND DUP 4. * 3

ROLLD DUP 1. - *

DUP + - 10 ROT 4 /

R→I ^ 1 - 9 / SWAP

4. IDIV2 DUP { DUP

3. == { DROP 4 }

IFT } { DROP 1. - 6

} IFTE 10 ROT R→I ^

* + SWAP DROP

»

Gerald H · 09-06-2017, 06:43 PM

& here a version which for input

35918081

returns

:# Digits: 4238 (total number of digits in answer)

:Pos: 1318 (position of the non-1 digit, counting from right)

:Digit: 2 (the embedded prime digit)

& is free from approximate arithmetic.

ID SQR0 is an integer square root programme you can find here:

http://www.hpmuseum.org/forum/thread-8992.html

Size: 273.5

CkSum: # 3973h

Code:

::

  CK1&Dispatch

  # FF

  ::

    FPTR2 ^ZAbs

    DUPDUP

    ZINT 2

    FPTR2 ^ZMod

    FPTR2 ^RADDext

    ZINT 2

    FPTR2 ^ZQUOText

    '

    ID SQRT0

    EvalNoCK

    DUP

    ZINT 4

    FPTR2 ^RMULText

    UNROTDUP

    ZINT 1

    FPTR2 ^RSUBext

    FPTR2 ^RMULText

    DUP

    FPTR2 ^RADDext

    FPTR2 ^RSUBext

    SWAP

    ZINT 4

    FPTR2 ^ZQUOText

    "# Digits"

    >TAG

    SWAP

    ZINT 4

    FPTR2 ^IDIV2

    SWAP

    ZINT 1

    FPTR2 ^RADDext

    SWAP

    ::

      ZINT 3

      EQUALcasedrop

      ZINT 4

      DUP

      ZINT 0

      EQUAL

      NOT?SEMI

      DROP

      ZINT 1

      FPTR2 ^RSUBext

      ZINT 6

    ;

    ZINT 1

    FPTR2 ^RADDext

    "Digit"

    >TAG

    SWAP

    "Pos"

    >TAG

    SWAP

  ;

;

Gerald H · 09-07-2017, 10:00 AM

A slightly improved version of the programme:

Size: 267.5

CkSum: # DCE9h

Code:

::

  CK1&Dispatch

  # FF

  ::

    FPTR2 ^ZAbs

    DUP

    ZINT 1

    FPTR2 ^RADDext

    ZINT 2

    FPTR2 ^ZQUOText

    '

    ID SQRT0

    EvalNoCK

    DUP

    ZINT 4

    FPTR2 ^RMULText

    UNROTDUP

    ZINT 1

    FPTR2 ^RSUBext

    FPTR2 ^RMULText

    DUP

    FPTR2 ^RADDext

    FPTR2 ^RSUBext

    SWAP

    ZINT 4

    FPTR2 ^ZQUOText

    "# Digits"

    >TAG

    SWAP

    ZINT 4

    FPTR2 ^IDIV2

    SWAP

    ZINT 1

    FPTR2 ^RADDext

    SWAP

    ::

      ZINT 3

      EQUALcasedrop

      ZINT 4

      DUP

      ZINT 0

      EQUAL

      NOT?SEMI

      DROP

      ZINT 1

      FPTR2 ^RSUBext

      ZINT 6

    ;

    ZINT 1

    FPTR2 ^RADDext

    "Digit"

    >TAG

    SWAP

    "Pos"

    >TAG

    SWAP

  ;

;

pier4r · 09-07-2017, 12:08 PM

What do you mean with "improved", what is the metric? Only the size?

Gerald H · 09-07-2017, 12:14 PM

Size, elegance & speed.