VBで遊んでました。No15。多倍長計算。自然対数の底。

Module Module1

    Public LSIZ As Integer = 253
    Dim ee(LSIZ) As Integer
    Dim ww(LSIZ) As Integer

    Sub Main()
        Dim n As Integer
        Dim k As Integer = 1

        ee(0) = 1
        ww(0) = 1
        n = 1
        Do While k > 0
            l_divh(ww, ww, n)
            If l_is0(ww) Then
                Exit Do
            End If
            l_add(ee, ee, ww)
            n = n + 1
        Loop
        l_print10(ee, LSIZ - 2)

    End Sub

End Module

 

Module Module2

    'Dim LSIZ As Integer = 25

    Function l_add(ByRef ans() As Integer, ByRef a() As Integer, ByRef b() As Integer) As Integer

        Dim i As Integer
        Dim carry As Integer = 0

        i = LSIZ - 1
        Do While i >= 0
            ans(i) = a(i) + b(i) + carry
            carry = Int(ans(i) / 10000)
            ans(i) = ans(i) Mod 10000
            i = i - 1
        Loop

        If carry > 0 Then
            Console.WriteLine("オーバーフローしました。")
            Return 1
        End If

        Return 0

    End Function

    Sub l_addi(ByRef ans() As Integer, ByRef a() As Integer, n As Integer)
        Dim temp(LSIZ) As Integer

        l_seti(temp, n)
        l_add(ans, a, temp)

    End Sub

    Function l_sub(ByRef ans() As Integer, ByRef a() As Integer, ByRef b() As Integer) As Integer
        Dim i As Integer
        Dim borrow As Integer = 0

        i = LSIZ - 1
        Do While i >= 0
            ans(i) = a(i) - b(i) - borrow
            borrow = 0
            If ans(i) < 0 Then
                borrow = 1
                ans(i) = ans(i) + 10000
            End If
            i = i - 1
        Loop

        If borrow > 0 Then
            Console.WriteLine("l_sub:左辺が小さい")
            Return 1
        End If

        Return 0

    End Function

    Sub l_subi(ByRef ans() As Integer, ByRef a() As Integer, n As Integer)
        Dim tmp(LSIZ) As Integer

        l_seti(tmp, n)
        l_sub(ans, a, tmp)

    End Sub

    Sub l_mul(ByRef ans() As Integer, ByRef a() As Integer, ByRef b() As Integer)
        Dim i As Integer, top As Integer
        Dim aa(LSIZ) As Integer, mul_ans(LSIZ) As Integer, w(LSIZ) As Integer

        l_cpy(aa, a)
        l_seti(mul_ans, 0)
        l_seti(w, 0)

        i = 0
        Do While i < LSIZ
            If b(i) <> 0 Then
                Exit Do
            End If
            i = i + 1
        Loop

        top = i
        If top >= LSIZ Then
            l_seti(ans, 0)
            Return
        End If

        Dim j As Integer = 1
        i = LSIZ - 1
        Do While j > 0
            l_mulh(mul_ans, aa, b(i))
            l_add(w, w, mul_ans)
            If i                 Exit Do
            End If

            l_Lshift(aa)
            i = i - 1
        Loop

        l_cpy(ans, w)


    End Sub

    Sub l_muli(ByRef ans() As Integer, ByRef a() As Integer, ByVal n As Integer)
        Dim tmp(LSIZ) As Integer

        l_seti(tmp, n)
        l_mul(ans, a, tmp)

    End Sub

    Function l_mulh(ByRef ans() As Integer, ByRef a() As Integer, ByVal n As Integer) As Integer
        Dim i As Integer, wk As Integer
        Dim carry As Integer = 0

        i = LSIZ - 1
        Do While i >= 0
            wk = a(i) * n + carry
            carry = Int(wk / 10000)
            ans(i) = wk Mod 10000
            i = i - 1
        Loop

        If carry > 0 Then
            Console.WriteLine("l_mulh:数値オーバーフロー")
            Return 1
        End If

        Return 0

    End Function

    Function l_div(ByRef ans() As Integer, ByRef a() As Integer, ByRef b() As Integer) As Integer
        Dim i As Integer, top1 As Integer, top2 As Integer, top2wk As Integer
        Dim tmp_ans As Integer = 0, aa_top_val As Integer, div_val As Integer
        Dim aa(LSIZ) As Integer, bb(LSIZ) As Integer, bbwk(LSIZ) As Integer

        If l_cmp(a, b) < 0 Then
            l_seti(ans, 0)
            Return 0
        End If

        If l_cmpi(b, 0) = 0 Then
            Console.WriteLine("l_div: 0除算エラー")
            Return 1
        End If

        top1 = 0
        Do While top1 < LSIZ
            If a(top1) <> 0 Then
                Exit Do
            End If
            top1 = top1 + 1
        Loop

        top2 = 0
        Do While top2 < LSIZ
            If b(top2) <> 0 Then
                Exit Do
            End If
            top2 = top2 + 1
        Loop

        l_cpy(aa, a)
        l_cpy(bb, b)
        l_seti(ans, 0)

        i = top1
        Do While i < top2
            l_Lshift(bb)
            i = i + 1
        Loop

        Dim j As Integer = 1
        top2wk = top1
        Do While j > 0
            tmp_ans = 0
            aa_top_val = 0

            i = top1
            Do While i （ここの条件がおかしくなります。どうしてでしょうかね。全角で書いておきます。＜＝top2wk

            aa_top_val = aa_top_val * 10000 + aa(i)
             i = i + 1
            Loop
            div_val = Int(aa_top_val / bb(top2wk))
            If div_val > 9999 Then
                div_val = 9999
            End If

            Do While div_val > 0
                l_mulh(bbwk, bb, div_val)
                Do While l_cmp(aa, bbwk) >= 0
                    l_sub(aa, aa, bbwk)
                    tmp_ans = tmp_ans + div_val
                Loop
                div_val = Int(div_val / 2)
            Loop

            l_addi(ans, ans, tmp_ans)
            If top2wk >= top2 Then
                Return 0
            End If

            If aa(top1) = 0 Then
                top1 = top1 + 1
            End If

            l_Rshift(bb)
            l_Lshift(ans)

            top2wk = top2wk + 1
        Loop

        Return 0

    End Function

    Sub l_divi(ByRef ans() As Integer, ByRef a() As Integer, ByVal n As Integer)
        Dim tmp() As Integer

        l_seti(tmp, n)
        l_div(ans, a, tmp)

    End Sub

    Sub l_divh(ByRef ans() As Integer, ByRef a() As Integer, ByVal n As Integer)
        Dim i As Integer, wk As Integer, nokori As Integer = 0

        i = 0
        Do While i < LSIZ
            If a(i) = 0 Then
                ans(i) = 0
            Else
                Exit Do
            End If
            i = i + 1
        Loop

        Do While i < LSIZ
            wk = a(i) + nokori
            ans(i) = Int(wk / n)
            nokori = (wk Mod n) * 10000
            i = i + 1
        Loop

    End Sub

    Function l_sets(ByRef a() As Integer, ByRef ss As String) As Integer
        Dim i As Integer, len As Integer
        Dim wkss As String

        If LSIZ < 3 Then
            Console.WriteLine("l_sets:LSIZを3以上にして下さい。")
            Return 1
        End If

        len = ss.Length
        i = LSIZ - 1
        Do While i >= 0
            If len > 0 Then
                If len >= 4 Then
                    wkss = ss.Substring(len - 4, 4)
                    a(i) = CInt(CStr(wkss))
                Else
                    wkss = ss.Substring(len, len)
                    a(i) = CInt(CStr(wkss))
                End If
                len = len - 4
            Else
                a(i) = 0
            End If
            i = i - 1
        Loop

        Return 0
    End Function

    Function strncpy(ByRef wkss() As Char, ByRef ss() As Char, ByVal len As Integer) As Char()
        Dim i As Integer
        For i = 0 To len
            wkss(i) = ss(i)
        Next
        strncpy = wkss

    End Function

    Function l_seti(ByRef a() As Integer, ByVal n As Integer)
        Dim i As Integer

        If LSIZ < 3 Then
            Console.WriteLine("l_seti: LSIZを3以上にして下さい。")
            Return 1
        End If

        If n < 0 Then
            Console.WriteLine("l_seti:引数2が負になっている。")
            Return 1
        End If

        i = 0
        Do While i < LSIZ
            a(i) = 0
            a(LSIZ - 3) = Int(n / 100000000)
            n = n Mod 100000000
            a(LSIZ - 2) = Int(n / 10000)
            n = n Mod 10000
            a(LSIZ - 1) = n
            i = i + 1
        Loop

        Return 0
    End Function

    Function l_cmp(ByRef a() As Integer, ByRef b() As Integer)
        Dim i As Integer

        i = 0
        Do While i < LSIZ
            If a(i) > b(i) Then
                Return 1
            End If
            If a(i) < b(i) Then
                Return -1
            End If
            i = i + 1
        Loop
        Return 0
    End Function

    Sub l_cpy(ByRef ikisaki() As Integer, ByRef kara() As Integer)
        Dim i As Integer
        i = kara.Length - 1
        Do While i >= 0
            ikisaki(i) = kara(i)
            i = i - 1
        Loop

    End Sub

    Function l_Lshift(ByRef a() As Integer) As Integer

        If a(0) <> 0 Then
            Console.WriteLine("l_Lshift:数値オーバーフロー")
            Return 1
        End If

        Dim i As Integer = 0
        Do While i < LSIZ - 1

            a(i) = a(i + 1)
            i = i + 1
        Loop
        a(LSIZ - 1) = 0
        Return 0
    End Function

    Sub l_Rshift(ByRef a() As Integer)

        Dim i As Integer = 0
        Dim w As Integer

        Do While i < LSIZ - 1
            w = LSIZ - 1 - i
            a(w) = a(w - 1)
            i = i + 1
        Loop
        a(0) = 0

    End Sub

    Function l_cmpi(ByRef a() As Integer, ByVal n As Integer) As Integer
        Dim tmp(LSIZ) As Integer

        l_seti(tmp, n)
        Return l_cmp(a, tmp)

    End Function
    Sub l_print(ByRef str As String, ByRef a() As Integer, ByVal size As Integer)
        Dim i As Integer

        Console.Write(str)
        i = 0
        Do While i < size
            Console.Write(a(i).ToString("D4"))
            i = i + 1
        Loop
        Console.WriteLine("")
    End Sub

    Function l_toa(ByRef a() As Integer)
        Dim i As Integer
        Static ss As String = ""

        i = 0
        Do While i < LSIZ
            ss = ss & a(i).ToString("0000")
            i = i + 1
        Loop
        Return ss

    End Function

    Function l_is0(ByRef a() As Integer) As Integer
        Dim i As Integer

        If a(0) <> 0 Then
            Return 0
        End If

        i = LSIZ - 1
        Do While i > 0
            If a(i) <> 0 Then
                Return 0
            End If
            i = i - 1
        Loop
        Return 1

    End Function

    Sub l_print10(ByRef d() As Integer, ByVal size As Integer)
        Dim i As Integer
        Dim ct As Integer = 0
        Dim wk As Integer

        If size > 0 Then
            Console.Write(d(0).ToString("#0"))
            Console.WriteLine(".")
        End If

        i = 1
        Do While i < size
            Console.Write(Int(d(i) / 100).ToString("00"))
            ct = ct + 1
            If (ct Mod 5) = 0 Then
                Console.Write(" ")
            End If
            If (ct Mod 25) = 0 Then
                Console.WriteLine()
            End If
            wk = d(i) Mod 100
            Console.Write(wk.ToString("00"))

            ct = ct + 1
            If (ct Mod 5) = 0 Then
                Console.Write(" ")
            End If

            If (ct Mod 25) = 0 Then
                Console.WriteLine()
            End If

            If (ct Mod 500) = 0 Then
                Console.WriteLine()
            End If

            i = i + 1
        Loop

    End Sub
End Module

最初が実行画面のスクリーンショット。Module1がMainでModule2が

ネタ本では多倍長計算のヘッダーファイルとしてあるものです。全てがチェックされて

か少しだけ疑問ですが、かなりの部分はチェックされてると思います。eの計算も

一応出来てましたし。

eの計算のMainは何故こうなるか?は省略です。Module2の最後のl_print10は

今回追加したものです。10桁ずつ出力するとなると、データ1個は4桁ですので

2桁ずつ上の桁と下の桁に分けて、1個のデータをprintします。5個出力で10桁の

データが印刷出来ます。後はスペース1個を出力して、25回繰り返すと50桁出力した

最初の画面が出力されます。

1000桁で1行改行で、スペース行が入るはずです。