Keskustelu: Koodit: VB.NET: Suurten lukujen käsittely

Public Class BitArr
    '***************************************************************
    '*  Class BitArr, version 1.0                                  *
    '*  Luokka pitkien lukujen aritmeettiseen laskemiseeen:        *
    '*  kerto-, jako-, yhteen- ja vähennyslasku, jakojäännös       *
    '*  muunnos BitArray to Decimal                                 *
    '*  muunnos Decimal to BitArray                                *
    '*  Lukujen oltava alustettu yhtä pitkiksi                     *
    '*  Luvut esitetään BitArray muodossa LSB = 0                  *
    '*                                                             *
    '*  Author: TNB 9/2004 , vb.net 2003                           *
    '***************************************************************
    Public Shared MAXBITS As Integer ' maksimi määrä bittejä luvuissa
    Public Shared Function Add(ByVal B As System.Collections.BitArray, ByVal C As System.Collections.BitArray) As System.Collections.BitArray
        'Add = B + C
        Dim m As Boolean = False
        Dim K As Integer = B.Length - 1
        Dim A As New System.Collections.BitArray(B.Length)
        Dim i As Integer
        For i = 0 To K
            A.Item(i) = B.Item(i) Xor C.Item(i) Xor m
            m = (B.Item(i) And C.Item(i)) Or ((B.Item(i) And m)) Or ((C.Item(i) And m))
        Next
        Return A
    End Function
    Public Shared Function Subtr(ByVal B As System.Collections.BitArray, ByVal C As System.Collections.BitArray) As System.Collections.BitArray
        'Subtr= B-C, B>C
        Dim m As Boolean = False
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer
        For i = 0 To K
            A.Item(i) = (Not B.Item(i) And Not C.Item(i) And m) Or (B.Item(i) And Not C.Item(i) And Not m) Or (Not B.Item(i) And C.Item(i) And Not m) Or (B.Item(i) And C.Item(i) And m)
            m = (Not B.Item(i) And Not C.Item(i) And m) Or (Not B.Item(i) And C.Item(i) And Not m) Or (Not B.Item(i) And C.Item(i) And m) Or (B.Item(i) And C.Item(i) And m)
        Next
        Return A
    End Function
    Private Shared Function MulBy2(ByVal B As System.Collections.BitArray) As System.Collections.BitArray
        'MulBy2= B *2
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer
        For i = K To 1 Step -1
            A.Item(i) = B.Item(i - 1)
        Next
        A.Item(0) = False
        Return A
    End Function
    Public Shared Function Mul(ByVal B As System.Collections.BitArray, ByVal C As System.Collections.BitArray) As System.Collections.BitArray
        'MulBitArr = B*C
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim D As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer
        ' ByVal ei toimi kuten pitäisi, siis kopioitava
        For i = 0 To K
            D.Item(i) = C.Item(i)
        Next
        'summataan kakkosen monikertoina, jos bitti tosi
        For i = 0 To K
            If B.Item(i) Then A = Add(A, D)
            If i <> K Then D = MulBy2(D)
        Next
        Return A
    End Function
    Private Shared Function DivBy2(ByVal B As System.Collections.BitArray) As System.Collections.BitArray
        'DivBy2 = B/2
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer
        For i = 0 To K - 1
            A.Item(i) = B.Item(i + 1)
        Next
        A.Item(K) = False
        Return A
    End Function
    Public Shared Function Comp(ByVal B As System.Collections.BitArray, ByVal C As System.Collections.BitArray) As Integer
        'vertailu:
        'B>C  1
        'B=C  2
        'B<C  3
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer
        For i = K To 0 Step -1
            If B.Item(i) And Not C.Item(i) Then
                Return 1 ' b suurempi
                Exit Function
            End If
            If Not B.Item(i) And C.Item(i) Then
                Return 3 ' b pienempi
                Exit Function
            End If
        Next
        Return 2 'yhtäsuuret
    End Function

    Public Shared Function Div(ByVal B As System.Collections.BitArray, ByVal C As System.Collections.BitArray, ByRef R As System.Collections.BitArray) As System.Collections.BitArray
        'A = B / C,  B >= C, R on jakojäännös
        'B ja C samanpituisia
        Dim K As Integer = MAXBITS - 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim B2 As New System.Collections.BitArray(MAXBITS)
        Dim i As Integer

        For i = K To 0 Step -1
            B2 = MulBy2(B2) ' lisätään jaettavan pituutta
            B2.Item(0) = B.Item(i) ' uusi bitti jaettavaan
            Select Case Comp(B2, C) ' meneekö jakaja jaettavaan
                Case 1, 2 ' meni
                    B2 = Subtr(B2, C) ' vähennetään jaettavasta jakaja
                    A.Item(i) = True ' koska meni, niin bitti on tosi
                Case 3
                    A.Item(i) = False ' ei mene, bitti on epätosi
            End Select
        Next
        R = B2 'jakojäännös
        Return A
    End Function
    Public Shared Function DecToBit(ByVal Bytes() As Byte) As System.Collections.BitArray
        Dim N As Integer = Bytes.GetUpperBound(0) + 1
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim C As New System.Collections.BitArray(MAXBITS)
        Dim Kerroin As New System.Collections.BitArray(MAXBITS)
        Dim B10 As New System.Collections.BitArray(MAXBITS)
        Dim I, J, K, L As Integer

        'B10=10
        B10.Item(3) = True
        B10.Item(1) = True
        'Kerroin=1
        Kerroin.Item(0) = True
        For I = 0 To N - 1
            L = CInt(Bytes(I))
            C.SetAll(False)
            For J = 0 To 3
                K = L Mod (CInt(2 ^ (J + 1)))
                If K = 0 Then C.Item(J) = False Else C.Item(J) = True
                L = L - K
            Next
            C = Mul(C, Kerroin)
            A = Add(A, C)
            Kerroin = Mul(Kerroin, B10)
        Next
        Return A
    End Function
    Public Shared Function BitToDec(ByVal BA As System.Collections.BitArray) As Byte()
        'BitArray muodosta  desimaali taulukkoon
        ' hidas !
        Dim N As Integer = MAXBITS
        Dim A(N \ 3 + 4) As Byte 'tulos
        Dim C As New System.Collections.BitArray(BA)
        Dim R As New System.Collections.BitArray(N)
        Dim iR(N \ 3 + 4) As Byte
        Dim S As New System.Collections.BitArray(N)
        Dim kesken As Boolean
        Dim B10 As New System.Collections.BitArray(N)
        Dim I, J, L As Integer
        Dim K As Integer
        'B10=10
        B10.Item(3) = True
        B10.Item(1) = True

        kesken = True
        K = 0
        'jaetaan 10:llä , jakojäännös taulukkoon
        'kunnes ei enää jaettavaa
        Do While kesken
            C = Div(C, B10, R) ' R = C mod 10
            R.CopyTo(iR, 0) : A(K) = iR(0) 'R talteen A:han
            K = K + 1
            Application.DoEvents()
            'onko vielä bittejä jäljellä
            kesken = False
            For J = 0 To N - 1
                If C.Item(J) Then
                    kesken = True
                    Exit For
                End If
            Next
        Loop
        Return A

    End Function
    Public Shared Function ShiftLeft(ByVal B As System.Collections.BitArray, ByVal Count As Integer) As System.Collections.BitArray
        'ShiftLeft by Count times
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim ai(100) As Integer
        Dim I As Integer
        For I = MAXBITS - 1 To Count Step -1
            A(I) = B(I - Count)
        Next
        For I = Count - 1 To 0 Step -1
            A(I) = False
        Next
        A.CopyTo(ai, 0)
        Return A
    End Function
    Public Shared Function ShiftRight(ByVal B As System.Collections.BitArray, ByVal Count As Integer) As System.Collections.BitArray
        'ShiftRight by Count times
        Dim A As New System.Collections.BitArray(MAXBITS)
        Dim I As Integer
        For I = 0 To MAXBITS - 1 - Count
            A(I) = B(I + Count)
        Next
        For I = MAXBITS - 1 - Count To MAXBITS - 1
            A(I) = False
        Next
        Return A
    End Function
End Class

' **************************************************
' *  PI:n likiarvon laskenta noin 150 desimaalilla *
' *  TNB, 2004, vb.net 2003                        *
'***************************************************
TextBox1.Multiline = True
Dim M As Integer = 24 * 64 ' bittiä laskentaluvuissa
BitArr.MAXBITS = M
Dim SK As New System.Collections.BitArray(M) : SK.Item(0) = True
Dim SK10 As New System.Collections.BitArray(M) : SK10.Item(3) = True : SK10.Item(1) = True
Dim SK4 As New System.Collections.BitArray(M)
Dim SK2 As New System.Collections.BitArray(M)
Dim SK1 As New System.Collections.BitArray(M)
Dim V1 As New System.Collections.BitArray(M) : V1.Item(0) = True
Dim V2 As New System.Collections.BitArray(M) : V2.Item(1) = True
Dim V4 As New System.Collections.BitArray(M) : V4.Item(2) = True
Dim V5 As New System.Collections.BitArray(M) : V5.Item(2) = True : V5.Item(0) = True
Dim V6 As New System.Collections.BitArray(M) : V6.Item(2) = True : V6.Item(1) = True
Dim A As New System.Collections.BitArray(M)
Dim B As New System.Collections.BitArray(M)
Dim C As New System.Collections.BitArray(M)
Dim R As New System.Collections.BitArray(M)
Dim k As Integer
Dim ki(2 * 24 - 1) As Integer ' yhtä pitkä kuin laskentaluvut
Dim tulos() As Byte ' desimaalit 10-järjestelmä taulukossa

For k = 1 To 150 ' 150 desimaalia noin
    TextBox1.Text = "Tehdään isoja lukuja: " & k.ToString
    Application.DoEvents()
    ' skaalauskerroin
    SK = BitArr.Mul(SK10, SK) 'SK=SK *10
Next

'skaalataan jaettavat luvut isoiksi kokonaisluvuiksi
SK4 = BitArr.Mul(SK, V4) ' 4
SK2 = BitArr.Mul(SK, V2) ' 2
SK1 = BitArr.Mul(SK, V1) ' 1

'Piin laskenta kaavat : Bailey, 1996
For k = 0 To 150 ' 150*4 bittiä iteroinnin tarkkuus noin
    TextBox1.Text = "Piin lakenta, iteraatio: " & k.ToString & " / 150"
    Application.DoEvents()
    ki(0) = k
    Dim K8 As New System.Collections.BitArray(ki)
    K8 = BitArr.ShiftLeft(K8, 3) ' K8=K8 *8
    A = BitArr.Div(SK4, BitArr.Add(K8, V1), R)                  ' + 4 / (8*k+1)
    A = BitArr.Subtr(A, BitArr.Div(SK2, BitArr.Add(K8, V4), R)) ' - 2 / (8*k+4)
    A = BitArr.Subtr(A, BitArr.Div(SK1, BitArr.Add(K8, V5), R)) ' - 1 / (8*k+5)
    A = BitArr.Subtr(A, BitArr.Div(SK1, BitArr.Add(K8, V6), R)) ' - 1 / (8*k+6)
    A = BitArr.ShiftRight(A, 4 * k) ' 1 / (16^k)
    B = BitArr.Add(B, A) ' tulokset summataan B:hen
Next
TextBox1.Text = "Muutetaan desimaaleiksi ... kestää ..."
tulos = BitArr.BitToDec(B) ' muunnos 10-järjestelmän taulukoksi
For k = tulos.GetUpperBound(0) To 0 Step -1
    TextBox1.Text = TextBox1.Text & tulos(k).ToString
Next

BitArr.MAXBITS = 1000 ' annetaan laskennan koko
Dim M As Integer = BitArr.MAXBITS
Dim ba1 As New System.Collections.BitArray(M) : ba1.Item(10) = True '1024
Dim ba2 As New System.Collections.BitArray(M) : ba2.Item(5) = True ' 32
Dim ba3 As New System.Collections.BitArray(M)
Dim ba4 As New System.Collections.BitArray(M)
Dim Bytes(2) As Byte : Bytes(2) = 1 : Bytes(1) = 8 : Bytes(0) = 4 '184

'muunnos bitarray-muotoon
ba3 = BitArr.DecToBit(Bytes)

'x^2
ba4 = BitArr.Mul(ba3, ba3)

' muunnos takaisin desimaali taulukoksi
Bytes = BitArr.BitToDec(ba4)

'vähennyslasku
ba3 = BitArr.Subtr(ba1, ba2)

'yhteenlasku
ba3 = BitArr.Add(ba1, ba2)

' kertolasku
ba3 = BitArr.Mul(ba1, ba2)


'jakolasku
ba3 = BitArr.Div(ba1, ba2, ba4) ' ba3=ba1\ba2,  ba4 = jakojäännös
Bytes = BitArr.BitToDec(ba3)
'siirto vasemmalle
ba3 = BitArr.ShiftLeft(ba2, 2)
Bytes = BitArr.BitToDec(ba3)
'siirto oikealle
ba3 = BitArr.ShiftRight(ba2, 2)
Bytes = BitArr.BitToDec(ba3)