Source code in the freebasic programming language

#Include "crt.bi"
const iterations=20000000

sub bisect( f1 as function(as double) as double,min as double,max as double,byref O as double,a() as double)
    dim as double last,st=(max-min)/iterations,v
    for n as double=min to max step st
        v=f1(n)
        if sgn(v)<>sgn(last) then
            redim preserve a(1 to ubound(a)+1)
            a(ubound(a))=n
            O=n+st:exit sub
        end if
        last=v
    next
end sub

function roots(f1 as function(as double) as double,min as double,max as double, a() as double) as long
    redim a(0)
    dim as double last,O,st=(max-min)/iterations,v
    for n as double=min to max step st
        v=f1(n)
        if sgn(v)<>sgn(last) and n>min then bisect(f1,n-st,n,O,a()):n=O
        last=v
    next
    return ubound(a)
end function

Function CRound(Byval x As Double,Byval precision As Integer=30) As String
    If precision>30 Then precision=30
    Dim As zstring * 40 z:Var s="%." &str(Abs(precision)) &"f"
    sprintf(z,s,x)
    If Val(z) Then Return Rtrim(Rtrim(z,"0"),".")Else Return "0"
End Function

function defn(x as double) as double
    return x^3-3*x^2+2*x
end function

redim as double r()

print
if roots(@defn,-20,20,r()) then
    print "in range -20 to 20"
    print "All roots approximate"
    print "number","root to 6 dec places","function value at root"
    for n as long=1 to ubound(r)
        print n,CRound(r(n),6),,defn(r(n))
    next n
end if
sleep