(49G, 49g+ & 50g) DE: A Numeric to Symbolic Programme - Printable Version +- 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* ;```