Task: Convert decimal number to rational








VB: Function Real2Rational(r As Double, bound As Long) As String

If r = 0 Then
    Real2Rational = "0/1"
ElseIf r < 0 Then
    Result = Real2Rational(-r, bound)
    Real2Rational = "-" & Result
Else
    best = 1
    bestError = 1E+99
    For i = 1 To bound + 1
        currentError = Abs(i * r - Round(i * r))
        If currentError < bestError Then
            best = i
            bestError = currentError
            If bestError < 1 / bound Then GoTo SkipLoop
        End If
    Next i
SkipLoop:
    Real2Rational = Round(best * r) & "/" & best
End If
End Function

Sub TestReal2Rational()
Debug.Print "0.75" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.75, CLng(Order));
Next i
Debug.Print

Debug.Print "0.518518" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.518518, CLng(Order));
Next i
Debug.Print

Debug.Print "0.9054054" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.9054054, CLng(Order));
Next i
Debug.Print

Debug.Print "0.142857143" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(0.142857143, CLng(Order));
Next i
Debug.Print

Debug.Print "3.141592654" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(3.141592654, CLng(Order));
Next i
Debug.Print

Debug.Print "2.718281828" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(2.718281828, CLng(Order));
Next i
Debug.Print

Debug.Print "-0.423310825" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(-0.423310825, CLng(Order));
Next i
Debug.Print

Debug.Print "31.415926536" & ":";
For i = 0 To 5
    Order = CDbl(10) ^ CDbl(i)
    Debug.Print " " & Real2Rational(31.415926536, CLng(Order));
Next i
End Sub



Fortran:       MODULE PQ	
       INTEGER MSG	
       CONTAINS		
        INTEGER FUNCTION GCD(I,J)	
         INTEGER I,J	
         INTEGER N,M,R	
          N = MAX(I,J)	
          M = MIN(I,J)	
    1     R = MOD(N,M)		
          IF (R.GT.0) THEN	
            N = M			
            M = R			
            IF (R .GT. 1) GO TO 1	
          END IF			
          GCD = M			
        END FUNCTION GCD	

        SUBROUTINE RATIONAL10(X)
         DOUBLE PRECISION X	
         DOUBLE PRECISION R	
         INTEGER P,Q		
         INTEGER F,WHACK	
         PARAMETER (WHACK = 10**8)	
          P = X*WHACK + 0.5	
          Q = WHACK		
          F = GCD(P,Q)		
          P = P/F		
          Q = Q/F		
          R = DBLE(P)/DBLE(Q)	
          WRITE (MSG,1) P,Q,X - R,WHACK	
    1     FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14,
     1     " via multiplication by ",I0)
        END SUBROUTINE RATIONAL10	

        SUBROUTINE RATIONAL(X)	
         DOUBLE PRECISION X	
         DOUBLE PRECISION R,E,BEST	
         INTEGER P,Q		
         INTEGER TRY,F		
          P = 1 + X	
          Q = 1		
          BEST = X*6	
          DO TRY = 1,10000000	
            R = DBLE(P)/DBLE(Q)		
            E = X - R			
            IF (ABS(E) .LE. BEST) THEN	
              BEST = ABS(E)*0.125		
              F = GCD(P,Q)			
              IF (BEST.LT.0.1D0) WRITE (MSG,1) P/F,Q/F,E	
    1         FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14)	
              IF (F.NE.1) WRITE (MSG,*) "Common factor
              IF (E.EQ.0) EXIT			
            END IF			
            IF (E.GT.0) THEN	
              P = P + CEILING(E*Q)	
            ELSE IF (E .LT. 0) THEN	
              Q = Q + 1			
            END IF		
          END DO		
        END SUBROUTINE RATIONAL	

        SUBROUTINE RATIONALISE(X,WOT)	
         DOUBLE PRECISION X	
         CHARACTER*(*) WOT	
          WRITE (MSG,*) X,WOT	
          CALL RATIONAL10(X)	
          CALL RATIONAL(X)	
          WRITE (MSG,*)		
        END SUBROUTINE RATIONALISE	
      END MODULE PQ	

      PROGRAM APPROX
      USE PQ
      DOUBLE PRECISION PI,E
      MSG = 6
      WRITE (MSG,*) "Rational numbers near to decimal values."
      WRITE (MSG,*)
      PI = 1		
      PI = 4*ATAN(PI)	
      E = DEXP(1.0D0)	
      CALL RATIONALISE(0.1D0,"1/10 Repeating in binary..")
      CALL RATIONALISE(3.14159D0,"Pi approx.")
      CALL RATIONALISE(PI,"Pi approximated better.")
      CALL RATIONALISE(E,"e: rational approximations aren't much use.")
      CALL RATIONALISE(10.15D0,"Exact in decimal, recurring in binary.")
      WRITE (MSG,*)
      WRITE (MSG,*) "Variations on 67/74"
      CALL RATIONALISE(0.9054D0,"67/74 = 0·9(054) repeating in base 10")
      CALL RATIONALISE(0.9054054D0,"Two repeats.")
      CALL RATIONALISE(0.9054054054D0,"Three repeats.")
      WRITE (MSG,*)
      WRITE (MSG,*) "Variations on 14/27"
      CALL RATIONALISE(0.518D0,"14/27 = 0·(518) repeating in decimal.")
      CALL RATIONALISE(0.519D0,"Rounded.")
      CALL RATIONALISE(0.518518D0,"Two repeats, truncated.")
      CALL RATIONALISE(0.518519D0,"Two repeats, rounded.")
      END