Kirjautuminen

Haku

Tehtävät

Kilpailu

Ohjelmoi tekoäly!
Aikaa on 14.6. saakka.

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

Sivu 1 / 1

tnb [22.09.2004 18:03:22]

#

Tässä luokka pitkillä kokonaisluvuilla laskemiseksi. Lukujen esittämiseen on käytetty vb.net:n BitArray tyyppiä, jossa bitit ovat taulukkomuuttujassa boolean tyyppisenä. Luvut voivat olla tosi pitkiä. Vähiten merkitsevä bitti on nolla paikassa. Luokka on shared tyyppiä eli sitä voi käyttää suoraan, ei tarvitse tehdä omaa objektia erikseen.

Projektissa button1 ja button2 sekä textbox1 jossa multiline ja vertical scroll päällä.

Esimerkkinä on laskettu PI:n likiarvo 150 desimaalilla (joista kolme viimeistä pyöristyy väärin). Hidas mutta OK.

3.14159265358979323846264338327950
2884197169399375105820974944592307
8164062862089986280348253421170679
8214808651328230664709384460955058
2231725359408067

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

Esimerkki, sijoita esim buttoniin

' **************************************************
' *  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

Persulaskutoimitukset

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)

esakom [09.09.2005 09:01:24]

#

varsin mielenkiintoinen...

ErroR++ [21.10.2011 12:05:08]

#

' ByVal ei toimi kuten pitäisi, siis kopioitava
       For i = 0 To K
           D.Item(i) = C.Item(i)
       Next

Eikö tuo voisi olla:

D = C.Clone() 'Tehdään kopio

Metabolix [02.11.2017 17:11:32]

#

Tätä koodia on aika vaikea lukea, ja sitä paitsi kielessä in BigInteger-luokka pitkiä lukuja varten.

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta