(50G) PDQ Algorithm in SRPL and URPL

[Joe Horn]

(02-23-2019 09:09 PM)cdmackay Wrote:  Is there a SysRPL version for HP48 anywhere? I can't seem to find one…

or should I just use the UserRPL version above?

thanks very much.

Unfortunately, the User RPL program above cannot be used on the HP 48, because it uses long integers, which is an object type which was introduced into RPL with the HP 49G (after the HP 48). However, you might enjoy a less powerful version (limited to the HP 48's range of 12-digit mantissas) which was posted by Bill Wickes to the comp.sys.handhelds newsgroup on 2 April 1991, and included on Goodies Disk #3. Its commented source code follows. Don't worry about the SYSEVAL; it should work in any HP 48.

Code:

%%HP:T(3)F(.);
@ by the HP 48 Design Team
@
@ NEW2Q: Version of ->Q based on J.K.Horn's Algorithm,
@ but uses exit conditions like those of ->Q.
@
@ Input:
@
@ 2: Decimal Number to be converted to a fraction
@ 1: Number of decimal places of zeros required in the error.
@
@ Output:
@
@ 1: 'Numerator/Denominator'
@
@ Example:
@
@ What's the simplest fraction which agrees with sqrt(3) to 4 decimal places?
@   3 û 4 NEQ2Q returns '97/56'
@   '97/56-û3' EVAL returns .00009294957
@                                 ^^^^  note 4 zeros.
@
@

\<< -3 CF DUP2
  IF 1 > SWAP FP AND
  THEN OVER XPON 1 -                        @ calculate the input exponent.
    \<< \-> X 'IFTE(X==0,-500,XPON(X))' \>> @ define a 0-tolerant XPON.
  \-> f c x expo
    \<< 0 1 1 f DUP IP SWAP FP              @ set recursion initial cond.s.
      WHILE
       OVER 5 PICK / f - ABS expo EVAL      @ calculate expon. of error
       x SWAP - c <                         @ and compare with input.
       OVER AND                             @ if not close enough and
                                            @ the remainder's non-zero
      REPEAT
       INV DUP FP SWAP IP                   @ then calculate next iterate.
       \-> B0 B1 A0 A1 R B
        \<< B1 'B*B1+B0' EVAL
            A1 'B*A1+A0' EVAL
            R
        \>>
      END
      DROP SWAP DROP SWAP
      DUP 4 ROLL - DUP f * 0 RND            @ calc. "missing" den. and num.
      \-> N D D0 N0
      \<<
        IF 'x-expo(ABS(f-N0/D0))<c'         @ if "missing" frac. is not
        THEN N D                            @ good enough, use original.
        ELSE N0 D0
          IF 'N0\=/N'                       @ If it is really new,
          THEN 200 .2 BEEP                  @ then beep.
          END
        END
      \>>
    \>>                                     @ We're done, now clean up.
    IF DUP ABS 1 >
    THEN # 352318d SYSEVAL
    ELSE DROP
    END
  ELSE DROP
  END
\>>