HP Forums

Full Version: (49G, 49g+ & 50g) DE: A Numeric to Symbolic Programme
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
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*
;
Reference URL's