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
»
(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.
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.
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
»
{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
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
;
;
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
»
& 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
;
;
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
;
;
What do you mean with "improved", what is the metric? Only the size?