Task: Pathological floating point problems








VB: Imports System.Globalization
Imports System.Numerics
Imports Numerics

#Const USE_BIGRATIONAL = True
#Const BANDED_ROWS = True
#Const INCREASED_LIMITS = True

#If Not USE_BIGRATIONAL Then

Structure BigRational
    Overrides Function ToString() As String
        Return "NOT USING BIGRATIONAL"
    End Function
    Shared Narrowing Operator CType(value As BigRational) As Decimal
        Return -1
    End Operator
End Structure
#End If

Module Common
    Public Const FMT_STR = "{0,4}   {1,-15:G9}   {2,-24:G17}   {3,-32}   {4,-32}"
    Public ReadOnly Property Headings As String =
        String.Format(CultureInfo.InvariantCulture,
                      FMT_STR,
                      {"N", "Single", "Double", "Decimal", "BigRational (rounded as decimal)"})

    <Conditional("BANDED_ROWS")>
    Sub SetConsoleFormat(n As Integer)
        If n Mod 2 = 0 Then
            Console.BackgroundColor = ConsoleColor.Black
            Console.ForegroundColor = ConsoleColor.White
        Else
            Console.BackgroundColor = ConsoleColor.White
            Console.ForegroundColor = ConsoleColor.Black
        End If
    End Sub

    Function FormatOutput(n As Integer, x As (sn As Single, db As Double, dm As Decimal, br As BigRational)) As String
        SetConsoleFormat(n)
        Return String.Format(CultureInfo.CurrentCulture, FMT_STR, n, x.sn, x.db, x.dm, CDec(x.br))
    End Function

    Sub Main()
        WrongConvergence()
        Console.WriteLine()
        ChaoticBankSociety()

        Console.WriteLine()
        SiegfriedRump()

        SetConsoleFormat(0)
    End Sub
End Module



Fortran:       SUBROUTINE MULLER
       REAL*4 VN,VNL1,VNL2	
       REAL*8 WN,WNL1,WNL2	
       INTEGER I		
        WRITE (6,1)		
    1   FORMAT ("Muller's sequence should converge to six...",/
     1   "  N     Single      Double")
        VNL1 = 2; VN = -4	
        WNL1 = 2; WN = -4	
        DO I = 3,36			
          VNL2 = VNL1; VNL1 = VN		
          WNL2 = WNL1; WNL1 = WN		
          VN = 111 - 1130/VNL1 + 3000/(VNL1*VNL2)	
          WN = 111 - 1130/WNL1 + 3000/(WNL1*WNL2)	
          WRITE (6,2) I,VN,WN			
    2     FORMAT (I3,F12.7,F21.16)		
        END DO				
      END SUBROUTINE MULLER	

      SUBROUTINE CBS		
       INTEGER YEAR	
       REAL*4 V		
       REAL*8 W		
        V = 1; W = 1		
        V = EXP(V) - 1		
        W = EXP(W) - 1		
        WRITE (6,1)		
    1   FORMAT (///"The Chaotic Bank Society in action..."/"Year")
        WRITE (6,2) 0,V,W	
    2   FORMAT (I3,F16.7,F28.16)
        DO YEAR = 1,25		
          V = V*YEAR - 1	
          W = W*YEAR - 1	
          WRITE (6,2) YEAR,V,W	
        END DO			
      END SUBROUTINE CBS	

      REAL*4 FUNCTION SR4(A,B)	
       REAL*4 A,B
        SR4 = 333.75*B**6
     1      + A**2*(11*A**2*B**2 - B**6 - 121*B**4 - 2)
     2      + 5.5*B**8 + A/(2*B)
      END FUNCTION SR4
      REAL*8 FUNCTION SR8(A,B)	
       REAL*8 A,B
        SR8 = 333.75*B**6	
     1      + A**2*(11*A**2*B**2 - B**6 - 121*B**4 - 2)
     2      + 5.5*B**8 + A/(2*B)
      END FUNCTION SR8

      PROGRAM POKE
      REAL*4 V	
      REAL*8 W	
      WRITE (6,1) RADIX(V),DIGITS(V),"single",DIGITS(W),"double"
    1   FORMAT ("Floating-point arithmetic is conducted in base ",I0,/
     1   2(I3," digits for ",A," precision",/))
      WRITE (6,*) "Single precision limit",HUGE(V)
      WRITE (6,*) "Double precision limit",HUGE(W)
      WRITE (6,*)

      CALL MULLER

      CALL CBS

      WRITE (6,10)
   10 FORMAT (///"Evaluation of Siegfried Rump's function of 1988",
     1 " where F(77617,33096) = -0.827396059946821")
      WRITE (6,*) "Single precision:",SR4(77617.0,33096.0)
      WRITE (6,*) "Double precision:",SR8(77617.0D0,33096.0D0)	
      END