+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: General Software Library (/forum-13.html)
+--- Thread: (49G, 49g+ & 50g) DE: A Numeric to Symbolic Programme (/thread-9618.html)
(49G, 49g+ & 50g) DE: A Numeric to Symbolic Programme - Gerald H - 12-03-2017 11:35 AM
This thread
http://www.hpmuseum.org/forum/thread-9610.html
concerning accuracy prompted this posting.
The programme DE & 9 associated sub-programmes are updates for the 49G, 49g+ & 50g of the programme DE from
Ralf Thoma's
book
HP-Taschenrechner
Programmieren mit RPL
ISBN 3-88229-052-8
from 1995 & originally for the 48G.
DE takes real or complex numerical input & seeks a simple symbolic representation of the number, returning the input in the variable DE.OR, error in the symbolic representation in variable DE.ER & the symbolic representation to the stack. The programme also accepts a list of numbers.
Examples:
for input
(.701560760018,.129436325678)
the programme returns
'3*√7/(8*√2)+i*(62/479)'
& similarly
(1.60943791243,.261799387799)
'LN(5)+i*(1/12*π)'
&
(.629960524948,25.2477084857)
'(1/4)^(1/3)+i*(7*√13+1/113)'
The programme warns of a poor approximation & prefers symbolics containing small value integers.
I welcome improvements & am most pleased to hear of bugs.
DE
Code:
::
CK1
FPTR2 ^PUSHFLAGS_
BINT22
SetSysFlag
BINT103
SetSysFlag
BINT105
SetSysFlag
ID x001
FPTR2 ^POPFLAGS_
;x001
Code:
::
DUP'
ID DE.OR
?STO_HERE
ID x003
DUP
ID DE.OR
ID x002
'
ID DE.ER
?STO_HERE
FPTR2 ^QPI
;x002
Code:
::
DUPTYPELIST?
case
::
'
ID x002
BINT2
FALSE
ROMPTR E8 10
;
x-
xABS
CRUNCH
DUP
% .00000000001
%<
?SEMI
" DE DANGER: RESULT NOT ACCURATE!"
DispCoord1
SetDA3Temp
;x003
Code:
::
DUPTYPELIST?
case
::
'
ID x003
BINT1
FALSE
ROMPTR E8 10
;
DUPTYPEREAL?
case
ID x006
DUPTYPECMP?
NOT?SEMI
C%>%
ID x006
SWAP
ID x006
SWAP'
xi
SWAP'
x*
BINT3
SYMBN
x+
;x004
Code:
::
DUP
%SGN
SWAP
%ABS
ID x008
ROT
%*
SWAPDUP
%1
%=
caseDROP
'
x/
BINT3
SYMBN
;x005
Code:
::
SWAP
CRUNCH
%SQ_
ID x008
%EXPONENT
SWAP
%EXPONENT
%+
%ABS
%5
%<
IT
::
BINT6
TestUserFlag
?SEMI
EVAL
SWAPROT
BINT6
SetUserFlag
;
DROP
;x006
Code:
::
CRUNCH
DUP%0=
?SEMI
DUP
ID x004
editdecomp$w
LEN$
BINT14
#>
NOTcase
ID x004
DUP
xSQ
ID x004
editdecomp$w
LEN$
BINT14
#>
NOTcase
ID x009
BINT6
ClrUserFlag
DUP
%SGN
SWAP
%ABS
DUP
%LN
'
::
%LN
'
xEXP
ID x007
;
ID x005
DUP
%EXP
'
::
%EXP
'
xLN
ID x007
;
ID x005
DUP
%PI
%*
'
::
%PI
%*
ID x006
xPI
x/
OVER
;
ID x005
DUP
%PI
%/
'
::
%PI
%/
ID x006
xPI
x*
OVER
;
ID x005
DUP
%PI
xSQ
%/
'
::
%PI
xSQ
%/
ID x006
xPI
xSQ
x*
OVER
;
ID x005
DUP
%ALOG
'
::
%ALOG
'
xLOG
ID x007
;
ID x005
x*
%0
BEGIN
% .25
%+
2DUP
%1/
%-
'
::
%1/
2DUP
%-
ID x006
OVER
ID x006
x+
;
ID x005
2DUP
%1/
%+
'
::
%1/
2DUP
%+
ID x006
OVER
ID x006
x-
;
ID x005
2DUP
%SQRT
%-
'
::
%SQRT
2DUP
%-
ID x006
OVER
ID x006
x+
;
ID x005
2DUP
%SQRT
%+
'
::
%SQRT
2DUP
%+
ID x006
OVER
ID x006
x-
;
ID x005
DUP
%10
%>=
BINT6
TestUserFlag
OR
UNTIL
DROP
%1
BEGIN
%1+
2DUP
%SQRT
%MOD
'
::
%SQRT
2DUP
%MOD
ROTOVER
%-
ID x006
OVER
ID x006
x+
;
ID x005
2DUP
%SQRT
DUPUNROT
%MOD
%-
'
::
%SQRT
2DUP
%MOD
%MOD
2DUP
%+
ID x006
OVER
ID x006
x-
;
ID x005
DUP
%16
%=
BINT6
TestUserFlag
OR
UNTIL
DROP
%0
BEGIN
DUP
%10
%<=
BINT6
TestUserFlag
NOTAND
WHILE
::
% .25
%+
2DUP
%-
'
::
2DUP
%-
ID x006
OVER
ID x006
x+
;
ID x005
2DUP
%+
'
::
2DUP
%+
ID x006
OVER
ID x006
x-
;
ID x005
2DUP
%1/
%SQRT
%-
'
::
%1/
%SQRT
2DUP
%-
ID x006
OVER
ID x006
x+
;
ID x005
2DUP
%1/
%SQRT
%+
'
::
%1/
%SQRT
2DUP
%+
ID x006
OVER
ID x006
x-
;
ID x005
;
REPEAT
DROPDUP
%ABS
BINT6
BINT2
DO
DUPINDEX@
FPTR2 ^PPow#
'
::
OVER
%SGN
OVER
INDEX@
FPTR2 ^PPow#
ID x006
INDEX@
UNCOERCE
%1/
ID x006
x^
x*
;
ID x005
LOOP
DROP
;x007
Code:
::
SWAP
ID x006
SWAP
BINT2
SYMBN
OVER
;x008
Code:
::
%9
OVER
%EXPONENT
%1
%MAX
%-
%ALOG
DUPUNROT
%*
2DUP
BEGIN
OVER
%MOD
DUPUNROT
% 50.
%<
UNTIL
SWAPDROP
ROTOVER
%/
%IP
3UNROLL
%/
%IP
;x009
Code:
::
DUP
%SGN
SWAP
%SQ_
ID x008
BINT2
ZERO_DO
% 49.
OVER
%SQRT
%IP
%MIN
%1
%MAX
BEGIN
2DUP
%SQ_
%MOD
%0<>
OVER
%2
%>=
AND
WHILE
%1-
REPEAT
DUPUNROT
%SQ_
%/
DUP
%1
%=
ITE
DROP
::
'
xSQRT
BINT2
SYMBN
x*
;
SWAPLOOP
SWAP
x/
x*
;