(50g) Convert Approximate to Exact for given argument

[DavidM]

Except for those rare occasions that I actually need to do something symbolic on my 50g, I usually have it in approximate mode. As a result, I am occasionally frustrated that I've inadvertently changed a program, list, algebraic or other object into something containing approximate numbers (reals), when it was originally intended to have contained integers. It's usually not a huge deal to change the mode and repeat whatever action is needed to obtain the desired result, but I recently decided to put together a program to do the honors instead.

The System RPL program below attempts to seek out approximate numbers contained in the object in stack level 1, and converts those which have no fractional part to an exact integer. The program contains a main procedure that is called recursively on the object whenever a composite is encountered. Most objects that it encounters along the way aren't approximate numbers, so those are simply ignored and left alone. The program considers the following objects as composites that may contain nested items, and thus "explodes" these for further processing when encountered:

- Lists
- Secondaries (programs)
- Symbolics (algebraics)
- Arrays (real and matrix, but not complex or linked arrays)
- Tagged objects

As an example, if you enter '(3*X^2+1)/19.2' on the command line while in approximate mode on a 50g, it treats all of the numbers as approximate numbers and compiles the entry as '(3.*X^2.+1.)/19.2'. Executing this program with that input will result in all of the approximate numbers that represent integers being converted to exact integers: '(3*X^2+1)/19.2'.

While I recognize that this is essentially an aid to fix my own screwups, I'm hoping that others might find a use for it as well.

The following is compilable on a 50g with the standard extable installed:

Code:

!NO CODE
!RPL
DEFINE   ExecR2I              LAM 'r2i EVAL
DEFINE   proREAL              # 02933
DEFINE   proLIST              # 02A74
DEFINE   proSECONDARY         # 02D9D
DEFINE   proSYMBOLIC          # 02AB8
DEFINE   proARRAY             # 029E8
DEFINE   proMATRIX            # 02686
DEFINE   proTAGGED            # 02AFC
::
   CK1NoBlame                          ( check for 1 argument )

   ( main routine [LAM 'r2i] )
   ' ::
      CODE
         SAVE                          % get object type as BINT, leaving
         A=DAT1 A                      % original object on the stack
         D1=A
         A=DAT1 A
         GOVLNG =PUSH#ALOOP
      ENDCODE

      proREAL #=casedrop ::            ( real: convert to zint if integer )
         DUP %FP                       ( obtain fractional part )
         %0= IT FPTR2 ^R>Z             ( if fractional part is 0, convert to zint )
      ;

      SWAP INHARDROM? case SWAPDROP    ( if object resides in ROM, just leave )
      SWAP                             ( on stack and exit )

      proLIST OVER #=                  ( list|secondary|symbolic: )
      OVER proSECONDARY #= OR          ( explode/process/implode )
      OVER proSYMBOLIC #=
      ORcase ::                        ( object is one of identified types )
         SWAP                          ( leave type on stack )
         INNERDUP 1LAMBIND             ( explode and save size in LAM 1 )
         ZERO_DO                       ( do for each element )
            ExecR2I                    ( process object )
            1GETLAM ROLL               ( roll object elements )
         LOOP                          ( next object )
         1GETABND {}N                  ( implode stack objects to list )
         SWAP CHANGETYPE               ( convert to appropriate object type )
      ;

      proARRAY #=casedrop ::           ( array: process contents )
         DUP TYPERARRY? IT ::          ( real array? )
            DUP FPTR2 ^ARSIZE 1LAMBIND ( get element count, store as LAM 1 )
            FPTR2 ^XEQARRY> OBJ>R_     ( explode array )
            1GETLAM ZERO_DO (DO)       ( do for each element )
               ExecR2I                 ( process object )
               1GETLAM ROLL            ( roll object elements )
            LOOP                       ( next object )
            ABND                       ( abandon LAM )
            R>OBJ_ FPTR2 ^XEQ>ARRY     ( implode stack elements into array )
         ;                             ( note: complex array is left unaltered )
      ;                                ( by default )

      proMATRIX #=casedrop ::          ( matrix: process contents )
         FPTR2 ^MATRIX2LIST            ( convert matrix to list )
         ExecR2I                       ( process list of lists )
         FPTR2 ^LIST2MATRIX            ( convert list of lists to matrix )
      ;

      proTAGGED #=casedrop ::          ( tagged item: detag/process/tag )
         TAG>_ SWAP                    ( extract tag, place above object )
         ExecR2I                       ( process object )
         SWAP >TAG                     ( re-attach tag )
      ;

      DROP                             ( anything else: drop type and leave )
   ;                                   ( object intact )

   { LAM 'r2i } BIND                   ( bind above routine to named LAM )
   ExecR2I                             ( execute main routine )
   ABND                                ( abandon named LAM )
;
@