Here's a head scratcher for you math fans...

Code: (Select All)

Dim As Double x, ip, fp, eps

Dim As _Integer64 n, n0, n1, d, d0, d1

Dim As Long sign



x = .33333333333333333333

x = 3.1415926535897932

eps = 1E-13

n0 = 0

n1 = 1

d0 = 1

d1 = 0



sign = Sgn(x)

x = Abs(x)

ip = Fix(x)

fp = x - ip 'fp=frac(x)



n = ip * n1 + n0

d = ip * d1 + d0

n0 = n1: n1 = n

d0 = d1: d1 = d

While (fp > eps) And n < 1000000000 And d < 1000000000

    'Print n; "/"; d

    x = 1 / fp

    ip = Fix(x)

    fp = x - ip 'fp=frac(x)



    n = ip * n1 + n0

    d = ip * d1 + d0

    n0 = n1: n1 = n

    d0 = d1: d1 = d

Wend

If sign < 0 Then n = -n

Print n; "/"; d

Code: (Select All)

For i## = 1 To 3

    Print Round2$(i## / 3, -4)

Next



Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)

    'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989

    'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)

    ReDim t$, sign$, l$, r$, r&&

    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long

    t$ = LTrim$(RTrim$(EXP$))

    If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)

    dp = InStr(t$, "D+"): dm = InStr(t$, "D-")

    ep = InStr(t$, "E+"): em = InStr(t$, "E-")

    check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)

    If check1 < 1 Or check1 > 1 Then N2S = _Trim$(EXP$): Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!

    Select Case l 'l now tells us where the SN starts at.

        Case Is < dp: l = dp

        Case Is < dm: l = dm

        Case Is < ep: l = ep

        Case Is < em: l = em

    End Select

    l$ = Left$(t$, l - 1) 'The left of the SN

    r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long

    If InStr(l$, ".") Then 'Location of the decimal, if any

        If r&& > 0 Then

            r&& = r&& - Len(l$) + 2

        Else

            r&& = r&& + 1

        End If

        l$ = Left$(l$, 1) + Mid$(l$, 3)

    End If

    Select Case r&&

        Case 0 'what the heck? We solved it already?

            'l$ = l$

        Case Is < 0

            For i = 1 To -r&&

                l$ = "0" + l$

            Next

            l$ = "." + l$

        Case Else

            For i = 1 To r&&

                l$ = l$ + "0"

            Next

            l$ = l$

    End Select

    N2S$ = sign$ + l$

End Function



Function Round2$ (anyNumber As _Float, dp As Long) ' uses N2S$

    ' 5 and up at decimal place dp+1 > +1 at decimal place   4 and down  > +0 at dp



    '2 1 0.-1 -2 -3 -4 ...  pick dp like this for this Round$ Function

    Dim sn$, dot, predot, postdot, rtn$



    sn$ = N2S$(Str$(anyNumber + .5 * 10 ^ dp)) 'get rid of sci notation, steve trims it so next find dot

    dot = InStr(sn$, ".")

    If dot Then

        predot = dot - 1

        postdot = Len(sn$) - (dot + 1)

    Else

        predot = Len(sn$)

        postdot = 0

    End If

    ' xxx.yyyyyy  dp = -2

    '      ^ dp

    If dp >= 0 Then

        rtn$ = Mid$(sn$, 1, predot - dp) + String$(dp, "0")

    Else

        rtn$ = Mid$(sn$, 1, predot) + "." + Mid$(sn$, dot + 1, -dp)

    End If

    If rtn$ = "" Then Round2$ = "0" Else Round2$ = rtn$

End Function