Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 53316 Skopiuj do schowka Liczby pierwsze
Autor Wiadomość
Artik 



Wersja: Win Office 365
Pomógł: 2890 razy
Posty: 9579
Wysłany: 03-08-2016, 17:22   

To oczywiście przerobiony kod Marka. Nie dbałem o wydajność, a raczej o zwiększenie ilości znalezionych liczb. Powyżej 130 mln mój komp już wyciągał kopyta - brak pamięci.

Artik
ID posta: 299740 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 03-08-2016, 21:58   

To może jeszcze trochę szybciej.
Przy liczbie 130000000 na przerobionym kodzie Artik-a uzyskałem czas 112 sek, a podstawiając kod poniższy uzyskałem czas 78 sek.
Kod:
Sub Lp_ver2()
    Dim czas#, m&, c&, Max_do&, i&, t&, k&, h&, x&, q&, j&, OstW&
    czas = Timer

    Max_do = 130000000
    m = Val(Max_do / 3)
    If m Mod 2 = 0 Then m = m + 1

    ReDim tbl(1 To m) As Long
    For i = 1 To m
        tbl(i) = 1
    Next i
    c = 0
    k = 1
    t = 2
    q = Val(Sqr(Max_do) / 3)
    For i = 1 To q
        k = 3 - k
        c = k * 4 * i + c
        j = c
        h = i * 2 * (3 - k) + 1
        t = k * 4 + t
        While j <= m
            tbl(j) = 0
            j = h + j
            h = t - h
        Wend
    Next i

    ReDim Tbl_Out(1 To m, 1 To 1) As Long
    Tbl_Out(1, 1) = 2
    Tbl_Out(2, 1) = 3
    x = 2

    For i = 1 To m
        If tbl(i) = 1 Then
            x = x + 1
            If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1
        End If
    Next i

    Range("A1").Resize(x).Value = Tbl_Out
    MsgBox Timer - czas
End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299771 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1295 razy
Posty: 4482
Wysłany: 03-08-2016, 22:28   

Na moim kompie (słaby bo kilkunastoletni: 2 GHz, dysk 28 GB, RAM 1 GB) już dla 60 000 000 jest"Out of memory" (linia 170)
----------------
Podaję funkcję, do której max_number powinna być przekazana jako parametr, i która powinna zwrócić tylko wyniki. A czy ładować wyniki do arkusza czy zapisać w pliku DAT na dysku czy przekazane dalej do obliczeń to już zależy od użytkownika.

Mam słaby komp więc testowałem tylko dla max_number = 820 000 000. Funkcja zwróciła 42 121 502 liczb pierwszych.

Ciekaw jestem, ile liczb pierwszych jest dla max_number = 1 000 000 000

Kod:

Private tabl(1 To 10000000) As Long

Function zapisz_pierwsze(ByVal max_number As Long) As Long()
Dim findArr() As Byte, primes() As Long, size As Long, start As Long, index As Double, firstOdd As Long
Dim nr As Long, k As Long, count As Long, Multiple As Double, prime As Long, rest As Long, n As Double
    If max_number < 2 Then Exit Function
    rest = max_number Mod UBound(tabl)
    If rest = 0 Then
        count = max_number \ UBound(tabl)
    Else
        count = max_number \ UBound(tabl) + 1
    End If
    ReDim primes(1 To 1)
    primes(1) = 2
    start = 3
    For nr = 1 To count
        If rest And nr = count Then
            size = rest
        Else
            size = UBound(tabl)
        End If
        ReDim findArr((nr - 1) * UBound(tabl) + 1 To (nr - 1) * UBound(tabl) + size)
        firstOdd = start
        For k = 2 To UBound(primes)
            prime = primes(k)
            Multiple = LBound(findArr) + (prime - (LBound(findArr) Mod prime)) Mod prime
            If Multiple Mod 2 = 0 Then Multiple = Multiple + prime
            If Multiple < CDbl(prime) * prime Then Multiple = CDbl(prime) * prime
            n = 2 * CDbl(prime)
            Do While Multiple <= UBound(findArr)
                findArr(Multiple) = 1
                Multiple = Multiple + n
            Loop
        Next k
        Do While start <= UBound(findArr)
            Do While start <= UBound(findArr)
                If findArr(start) <> 1 Then Exit Do
                start = start + 2
            Loop
            If start <= UBound(findArr) Then
                n = 2 * CDbl(start)
                index = CDbl(start) * start
                Do While index <= UBound(findArr)
                    findArr(index) = 1
                    index = index + n
                Loop
                start = start + 2
            End If
        Loop
        n = UBound(primes)
        ReDim Preserve primes(1 To n + UBound(tabl))
        For k = firstOdd To UBound(findArr) Step 2
            If findArr(k) <> 1 Then
                n = n + 1
                primes(n) = k
            End If
        Next k
        ReDim Preserve primes(1 To n)
    Next nr
    zapisz_pierwsze = primes
End Function

' przykład ładuje wyniki do arkusza
Kod:

Sub test()
Dim primes() As Long, result() As Long, k As Long, r As Long, count As Long, rest As Long, size As Long, t
Const number_in_column = 1000000
    t = Timer
   
    primes = zapisz_pierwsze(820 000 000)
   
    On Error GoTo end_
    rest = UBound(primes) Mod number_in_column
    If rest = 0 Then
        count = UBound(primes) \ number_in_column
    Else
        count = UBound(primes) \ number_in_column + 1
    End If
    Application.ScreenUpdating = False
    For k = 1 To count
        If rest And k = count Then
            size = rest
        Else
            size = number_in_column
        End If
        ReDim result(1 To size, 1 To 1)
        For r = 1 To size
            result(r, 1) = primes((k - 1) * number_in_column + r)
        Next r
        Cells(1, k).Resize(size).Value = result
    Next k
    Application.ScreenUpdating = True
   
    MsgBox Timer - t
end_:
End Sub
ID posta: 299773 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2890 razy
Posty: 9579
Wysłany: 03-08-2016, 23:44   

Marecki napisał/a:
Range("A1").Resize(x).Value = Tbl_Out
Panie Marku, coś pan ściemniasz. :-)
Jeżeli Max_do=130 000 000 to x=7 378 188. Co Ty masz za Excela? ;-)

Marecki napisał/a:
q = Val(Sqr(Max_do) / 3)
A nie można tak:
Kod:
q = Sqr(Max_do) \ 3
:?:

Artik
ID posta: 299778 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 04-08-2016, 00:52   

Artik napisał/a:
Co Ty masz za Excela?
Nowego :mrgreen:
To pozostałość po testach na Twoim kodzie.
Oczywiście Max_do nie może być większa od Rows.Count + 2 , bo zmiana tablicy powinna być taka:
Cytat:
ReDim Tbl_Out(1 To m + 2, 1 To 1) As Long

Poniżej poprawiony kod:
Kod:
Sub Lp_ver2()
    Dim czas#, m&, c&, Max_do&, i&, t&, k&, h&, x&, q&, j&, OstW&
    czas = Timer

    Max_do = 10000
    m = Val(Max_do / 3)
    If m Mod 2 = 0 Then m = m + 1

    ReDim tbl(1 To m) As Long
    For i = 1 To m
        tbl(i) = 1
    Next i
    c = 0
    k = 1
    t = 2
    q = Sqr(Max_do) / 3
    For i = 1 To q
        k = 3 - k
        c = k * 4 * i + c
        j = c
        h = i * 2 * (3 - k) + 1
        t = k * 4 + t
        While j <= m
            tbl(j) = 0
            j = h + j
            h = t - h
        Wend
    Next i

    ReDim Tbl_Out(1 To m + 2, 1 To 1) As Long
    Tbl_Out(1, 1) = 2
    Tbl_Out(2, 1) = 3
    x = 2

    For i = 1 To m
        If tbl(i) = 1 Then
            x = x + 1
            If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1
        End If
    Next i

    Range("A1").Resize(x).Value = Tbl_Out
    MsgBox Timer - czas
End Sub

Nie robiłem obsługi błędu Max_do ,bo może ktoś będzie chciał zaadoptować Twoje rozwiązanie z moim kodem.

Pytanie czy można przyspieszyć to
Kod:
If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1

zastąpić operator Mod jaki innym wyliczeniem?
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299783 Skopiuj do schowka
 
 
kulasart
[Usunięty]

Wysłany: 04-08-2016, 01:40   

Mod można zastąpić poprzez And:

Kod:
i mod 2

na
Kod:
i and 1
ID posta: 299785 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2890 razy
Posty: 9579
Wysłany: 04-08-2016, 02:45   

Marecki napisał/a:
q = Sqr(Max_do) / 3
Czy to to samo co:
Artik napisał/a:
q = Sqr(Max_do) \ 3
:?:

Właśnie w tym ukośniku cały bajer. :-)

Artik
ID posta: 299788 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 04-08-2016, 09:26   

kulasart napisał/a:
poprzez And
Można , ale czasowo nic to nie zmienia. :-(

Artik, jest pewna różnica.
"\" Zwraca wartość ilorazu liczbą całkowitą z dzielenia, ale w kodzie obawiałem się że będzie to miało wpływ na wynik.
Zobacz na rozkład:
Kod:
Sub aa()
    For i = 1 To 100
        Cells(i, 2).Value = Val(Sqr(i) / 3)
        Cells(i, 3).Value = Sqr(i) \ 3
    Next i
End Sub
i tu akurat to nie ma wpływu na wynik, ale już zastosowanie "\" w tym miejscu ma wpływ (tak przynajmniej mi się wydaje - gdzieś właśnie miałem pomniejszoną tablicę wyników)
Kod:
m = Val(Max_do \ 3)

Odnośnie skrócenia czasu zmieniłem tablicę Tbl typu long na Boolean.
Pozwoliło to zaoszczędzić trochę czasu.
Kod:
Sub bb()
    Dim czas#, i&
    Const Max_do As Long = 130000000

    czas = Timer
    ReDim Tbl(1 To Max_do) As Boolean
    MsgBox Timer - czas

    czas = Timer
    ReDim Tbl(1 To Max_do) As Boolean
    For i = 1 To Max_do
        Tbl(i) = False
    Next i
    MsgBox Timer - czas

End Sub


czyli teraz kod wygląda tak:
Kod:
Sub Lp_ver2()
    Dim czas#, m&, c&, Max_do&, i&, t&, k&, h&, x&, q&, j&, OstW&

    czas = Timer

    Max_do = 300000
    m = Val(Max_do \ 3)
    If m Mod 2 = 0 Then m = m + 1

    ReDim Tbl(1 To m) As Boolean
    c = 0
    k = 1
    t = 2
    q = Sqr(Max_do) / 3
    For i = 1 To q
        k = 3 - k
        c = k * 4 * i + c
        j = c
        h = i * 2 * (3 - k) + 1
        t = k * 4 + t
        While j <= m
            Tbl(j) = True
            j = h + j
            h = t - h
        Wend
    Next i

    ReDim Tbl_Out(1 To m + 2, 1 To 1) As Long
    Tbl_Out(1, 1) = 2
    Tbl_Out(2, 1) = 3
    x = 2

    For i = 1 To m
        If Tbl(i) = False Then
            x = x + 1
            If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1
        End If
    Next i

    Range("A1").Resize(x).Value = Tbl_Out
    OstW = Cells(Rows.Count, 2).End(xlUp).Row + 1
    Range("B" & OstW).Value = Timer - czas
End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299799 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 04-08-2016, 10:45   

@apollo, coś chyba jest nie tak z Twoją funkcją, albo znowu walnąłem gafę :-)
Spójrz na foto co mi wygenerowało dla
Kod:
number_in_column = 1048576
i
Kod:
primes = zapisz_pierwsze(82000000)

Ostatnie liczby pierwsze w kolumnie E są mniejsze od tych w kolumnie D.
Ponadto liczby te są dublowane.

LP.jpg
Plik ściągnięto 21 raz(y) 377.7 KB

_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299813 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1295 razy
Posty: 4482
Wysłany: 04-08-2016, 12:23   

Marecki napisał/a:
@apollo, coś chyba jest nie tak z Twoją funkcją, albo znowu walnąłem gafę :-)

Nie z funkcją.

Tym razem to Ty czuwałeś a ja zasnąłem ;-)
Dziękuję za wykrycie problemu.
Popełniłem błąd podczas ładowania wyników do arkusza.
W sub test zmień
Kod:

result(r, 1) = primes((k - 1) * size + r)

na
Kod:

result(r, 1) = primes((k - 1) * number_in_column + r)


Czyli zmień size na number_in_column
ID posta: 299824 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 04-08-2016, 13:47   

Poprawione. W Twoim poście z procedurą też.
Teraz jest git :-)
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299839 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2890 razy
Posty: 9579
Wysłany: 05-08-2016, 00:08   

Marecki napisał/a:
Pytanie czy można przyspieszyć to
Kod:
 If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1

zastąpić operator Mod jaki innym wyliczeniem?

Myślę, że w tym algorytmie już niewiele wyciągniesz więcej.
Teoretycznie, ten fragment
Kod:
     x = 2

     For i = 1 To m
         If Tbl(i) = False Then
             x = x + 1
             If i Mod 2 <> 0 Then Tbl_Out(x, 1) = 3 * i + 2 Else Tbl_Out(x, 1) = 3 * i + 1
         End If
     Next i
możesz zastąpić:
Kod:
    x = 2

    For i = 1 To m Step 2
        If Tbl(i) = False Then
            x = x + 1
                Tbl_Out(x, 1) = 3 * i + 2
        End If
    Next i

    For i = 2 To m Step 2
        If Tbl(i) = False Then
            x = x + 1
                Tbl_Out(x, 1) = 3 * i + 1
        End If
    Next i
co daje jakieś tam korzyści czasowe (u mnie, na 300 mln przeszukiwanych liczbach, średnia oszczędność rzędu 0,1 sek [bez prezentacji wyników - tylko w tablicy]). Ale otrzymujesz wyniki nieuporządkowane. Zaoszczędzony czas zostanie potem zmarnotrawiony, pewnie z jeszcze większą stratą, by posortować dane.

BTW
Val(Sqr(i) / 3) vs. Sqr(i) \ 3
Muszę to przetrawić, bo wyniki są dla mnie zaskakujące. Niewykluczone, że będę musiał w ogóle zapomnieć o dzieleniu całkowitym. Zawsze myślałem, że dzielenie to obcina resztę. A tu jeszcze jakieś dziwne zaokrąglenia. :shock:

Artik
ID posta: 299895 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1596 razy
Posty: 5257
Wysłany: 05-08-2016, 11:41   

Odnośnie BTW. Nie trzeba zapominać o dzieleniu całkowitym. Wystarczy uwzględnić co o tym piszą twórcy:
Cytat:
Before division is performed, the numeric expressions are rounded to Byte, Integer, or Long expressions.

Zatem, przekładając na język Excela raz mamy odpowiednik:
Kod:
=ZAOKR.DO.CAŁK(PIERWIASTEK(WIERSZ())/3)
a w przypadku dzielenia całkowitego:
Kod:
=ZAOKR.DO.CAŁK(ZAOKR(PIERWIASTEK(WIERSZ());0)/3)
ID posta: 299911 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2368 razy
Posty: 7756
Wysłany: 05-08-2016, 12:39   

Do wypowiedzi Maciej Gonet, dodam tylko tyle że przy dzieleniu całkowitym dzielna i dzielnik powinny być liczbami całkowitymi, bo w niektórych przypadkach otrzymamy różne wyniki.
Przykład:
Kod:
Sub Test()
Debug.Print "Dzielna całkowita a dzielnik ułamkiem"
Debug.Print Val(3 / 1.4)
Debug.Print 3 \ 1.4
Debug.Print "Dzielna ułamkiem a dzielnik całkowity"
Debug.Print Val(2.6 / 3)
Debug.Print 2.6 \ 3
End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 299925 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1596 razy
Posty: 5257
Wysłany: 05-08-2016, 13:26   

Tu nie ma sprzeczności, nie tyle użycie dzielenia całkowitego wymaga argumentów całkowitych, o ile trzeba pamiętać, że przed wykonaniem dzielenia całkowitego oba operandy zostaną zaokrąglone do liczb całkowitych z zachowaniem zasady cyfry parzystej.
To raczej użycie funkcji Val wymaga komentarza. Nie służy ona przecież do obcinania części ułamkowej, tylko do odrzucania z ciągu tekstowego tego, co nie jest liczbą. Takie działanie funkcji Val, jakie tu zostało zaprezentowane, wykorzystuje specyfikę tej funkcji w powiązaniu z polskimi ustawieniami systemowymi. Funkcja Val rozpoznaje jako element liczby kropkę dziesiętną, a przecinek nie jest już elementem liczby (nie uwzględnia ustawień regionalnych). Dzięki temu, że w naszych ustawieniach jest przecinek dziesiętny, funkcja Val działa tak jak działa. Jeśli w VBA obliczymy 3 / 1.4, to wynik otrzymamy z przecinkiem dziesiętnym, którego funkcja Val nie rozpoznaje i dlatego obcina nam liczbę w tym miejscu. Gdybyśmy jednak zmienili ustawienia regionalne (w systemie operacyjnym) i użyli kropki dziesiętnej, to funkcja Val nie obetnie części wyniku po kropce.
ID posta: 299932 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe