PBWin/PBCC Convert a decimal number to a fraction

[Rod Macia]

Some code to convert a decimal number to a fraction, of course there is no way to convert all decimals, but you can achieve an acceptable approximation, depending on the level of accuracy you need.

Here is an implementation of the continued fractions to get the fractions at an accepted accuracy.



DecNum = the number to convert to fraction
accuracy = how many decimals after point to compare
fractype = zero for only fractions or anything other that zero whole number & fractions ie: 13.25 = 53/4 = 13 1/4

'

#COMPILE EXE     ' PBWIN 10, PBCC 6
#DIM ALL
#UNIQUE VAR ON
%Unicode = 1

 FUNCTION Decimal2Fraction(DecNum AS EXT, Accuracy AS LONG, fractype AS LONG) AS WSTRING
' It uses the concept of continued fractions to calculate an approximated fraction
'  DecNum   = the number to convert to fraction
'  accuracy = how many decimals after point to compare  --- I find 4 good for my needs (like construction)
'  fractype = only fractions or whole number & fractions   ie:  13.25 = 53/4  = 13 1/4
LOCAL z AS EXT
LOCAL fraDen AS EXT
LOCAL fraNum AS EXT
LOCAL preDen AS EXT
LOCAL counter AS LONG
LOCAL temp AS EXT

IF FRAC(DecNum) = 0 THEN FUNCTION = FORMAT$(DecNum) : EXIT FUNCTION   ' it's a whole number, no decimal
  ' Initialize some values
  z      = DecNum
  preDen = 0
  fraDen = 1
  counter = 0   'just to prevent endless loop

  DO
    z = (1 / (z - INT(z)))
    temp = fraDen
    fraDen = INT(z) * fraDen + preDen
    preDen = temp
    fraNum = INT(DecNum * fraDen + 0.5)
    counter = counter + 1
  LOOP UNTIL (ABS((DecNum - (fraNum / fraDen))) < 10^-(Accuracy)) OR (z = INT(z)) OR (counter = 500)

  IF Fractype = 0 OR FIX(fraNum/fraDen) = 0 THEN                 ' 0        --> fraction only  13.25   =  53/4
      FUNCTION  = FORMAT$(fraNum) & "/" & FORMAT$(fraDen)
  ELSE                                                           ' not zero --> whole number & fraction  13.25   =  13 1/4
      IF ABS(fraNum - FIX(fraNum/fraDen)*fraDen) = 0 THEN
         FUNCTION = FORMAT$(FIX(fraNum/fraDen))
      ELSE
         FUNCTION = FORMAT$(FIX(fraNum/fraDen)) + " " + FORMAT$(ABS(fraNum - FIX(fraNum/fraDen)*fraDen))+ "/" + FORMAT$(fraDen)
      END IF
  END IF

END FUNCTION

'----------------------- Demo the function
FUNCTION PBMAIN () AS LONG
 LOCAL sBuffer AS STRING
 LOCAL lCount AS LONG
 LOCAL DecNum() AS EXT
 DIM DecNum(14)

ARRAY ASSIGN DecNum() = 5.015625##, 6.03125##, -13.0625##, 534.75##, 13.4##,   -2.5##,    0.1111111##, 0.125##, 0.1428571##, 0.1667##, 0.200##, 0.25##, 0.33333##, 0.5##, 0.999999##
                                                                    '13 2/5    -2 1/2     1/9          1/8      1/7                  1/6       1/5      1/4     1/3        1/2    1

FOR lCount = 0 TO 14
    sBuffer += FORMAT$(DecNum(lCount)) + $TAB+ $TAB+ Decimal2Fraction(DecNum(lCount), 4, 0) _
             + $TAB+ $TAB + Decimal2Fraction(DecNum(lCount), 4, 1) + $LF
NEXT

    #IF %DEF(%PB_CC32)           ' Deal with PBCC not printing stringvars with $LF and $tab correctly
       LOCAL lLoop AS LONG
       LOCAL sTemp2 AS WSTRING
       lCount = PARSECOUNT(sBuffer, $LF)
       FOR lLoop = 1 TO lCount
          sTemp2 = PARSE$(sBuffer,$LF,lLoop)
            COLOR 7: ? PARSE$(sTemp2, $TAB+$TAB, 1), : COLOR 2: ? PARSE$(sTemp2, $TAB+$TAB, 2), : COLOR 3: ? PARSE$(sTemp2, $TAB+$TAB, 3)
       NEXT lCount
       WAITKEY$
    #ELSE                        ' PBWin
       ? sBuffer
    #ENDIF
END FUNCTION
'