Sieve of Eratosthenes: Filtering Out Values in an Array (VBA)

[kpark91]

Hello, I have managed get myself through the first 9 questions in Project Euler! :D

For my question #10, I am having trouble with Sieve of Eratosthenes
http://en.wikipedia.org/wiki/Sieve_of_Eratosthenes

Because I do not know how to filter out values in an array in VBA.

So, I currently have an array size of 2,000,000 (2 million)
and let's say I have some 1's and some 0's in the array.
How would I filter out 1's so that I only have an array of 0's with 'smaller size'?

Thank you in advance as always
kpark

 

[kpark91]

Okay. I have finally solved it but the runtime was sooo bad..
It took me a whooping 3minutes and 45 seconds to run this on my computer! The answer was 142913828922.
and the website says it shouldn't take more than 2 minutes to do any problems on Project Euler

I am guessing the runtime is so bad because of my algorithm as well as "resizing" the array everytime I find a delVal in "Function deleteArrayElement"

Anyways, here is the code and if there is any optimization function available or any other ideas, please help me
There isn't a single VBA solution to any of Project Euler problem..

Sub Prob10()
    'The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
    'Find the sum of all the primes below two million
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Dim primArr() As Double, sum As Double, prim As Variant
    Dim StartTime, EndTime As Date
    sum = 0
    
    StartTime = Timer
    primArr = prime_sieve(2000000) 'array of prime numbers below two million
    EndTime = Timer
    MsgBox Format(EndTime - StartTime, "0.0") '225.0seconds!!
    For Each prim In primArr
        sum = sum + prim
    Next prim
    
    Range("B10").Value = sum
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

Function prime_sieve(limit As Double) As Double()
    Dim numArr() As Double, count As Double, index As Double, arrCount As Double, i As Double, sReConfig As Boolean
    Dim filArr() As Double
    ReDim numArr(2 To limit)
    ReDim filArr(2 To limit)
    
    'Setting the values
    For i = 2 To limit
        numArr(i) = i
    Next i
    
    filArr = numArr 'filtered array = all numbers array
    
    index = 2
    
ReConfig:
    arrCount = UBound(filArr) 'size of filtered array
    ReDim Preserve numArr(2 To arrCount) 'Resize array
    numArr = filArr
    sReConfig = False 'switch of ReConfig loop
    count = 0
    
    For i = index To arrCount
        If (numArr(i) <> numArr(index) And myMod(numArr(i), numArr(index)) = 0) Then
            numArr(i) = 0
            count = count + 1
            If (sReConfig = False) Then
                sReConfig = True 'If there is any change to values in numArr, set it to True (presence of composite numbers divisble by numArr(index))
            End If
        End If
    Next i
    
    index = index + 1 'onto next prime numbered position
    
    If (sReConfig = True) Then 'If there is any zero <any composite numbers>
        ReDim filArr(2 To arrCount - count) 'Resize array
        filArr = deleteArrayElement(numArr, 0) 'Delete all zeros
        GoTo ReConfig
    End If
    
    prime_sieve = numArr
End Function

Function deleteArrayElement(ByRef arr() As Double, delVal As Double) As Double()
    
    Dim filArr() As Double, n As Double, count As Double, elem As Variant
    count = 1
    
    For Each elem In arr
        If (elem <> delVal) Then 'Filter out elements which have delVal in arr
            count = count + 1
            ReDim Preserve filArr(2 To count)
            filArr(count) = elem
        End If
    Next elem
    
    deleteArrayElement = filArr 'Return filtered array
End Function

Sorry for the massive code but I am learning little by little!
So, if there are any other ideas, I can probably code it and see the difference!

Please and thank you so much as always,
kpark

 

[Ruddles]

So, basically to resize something without deleting the elements is to use

ReDim Preserve

?

Exactly.

 

[mirabeau]

Okay. I have finally solved it but the runtime was sooo bad..
It took me a whooping 3minutes and 45 seconds to run this on my computer! The answer was 142913828922.
and the website says it shouldn't take more than 2 minutes to do any problems on Project Euler

Just to check that I have this right.

You want to find the sum of all prime numbers less than 2million. And this took you 3 mins 45 secs?

Here's a brief and somewhat inefficient code that should do this for you in rather less than 3:45. Perhaps you'd like to try it and post back how long it does take you. (Put the number, 2 million or whatever in cell A1, and then run the code. Sum of the primes less than this should appear in A2)

Sub sumprimes()
t = Timer
Dim a() As Byte, u&, j&, s&, n&, q
n = [a1]: If n < 16 Then Exit Sub
u = Int(n ^ 0.5)
ReDim a(1 To n)
For s = 2 To n
    If a(s) = False Then
    q = q + s
    If s < u Then
        For j = s ^ 2 To n Step s
            a(j) = True
        Next j
    End If
    End If
Next s
[a2] = q
MsgBox "Code took " & Format(Timer - t, "0.0000") & " secs"
End Sub

 

[kpark91]

WTH???
How did you... What/?? Whyyy lol.
I know it's late but... Whattt

It took 0.7852 seconds...
Ohhhh... Is it because of the size of the array?
Please show me the wayyy :D

 

[mirabeau]

WTH???
How did you... What/?? Whyyy lol.
I know it's late but... Whattt

It took 0.7852 seconds...
Ohhhh... Is it because of the size of the array?
Please show me the wayyy :D

Thanx for the feedback kpark91.
Much appreciated.

Surprising to me that it took as long as 0.7852 seconds. On a lowish spec laptop it took 0.25 secs. On the i7 machine I usually use it takes 0.15 secs.

As noted, it's a somewhat inefficient code and when rewritten a bit need take about 60% of that time.

I was just addressing what I understood was the problem you posted. Viz. summing the primes up to 2 million. All that code does is to calculate the primes and add them, using the only the elementary operations of counting, adding and logical true or false (although don't mind the use of byte instead of boolean) at which computers are so good.

You seem to be a more than adequate codewriter, and should have little difficulty in figuring out what that code actually does.

 

[kpark91]

Hello, thanks for the kind reply!
Yes... My computer is very slow haha. I am saving up to get a i7 Extreme edition computer even though I may never need its full potential.

I know how your code works! which is awesome
I am learning and trying to become a better programmer by just researching on the internet with some background of 1 and a half years of programming in university. (and I am in love with it!)

But I can't see that it can be more efficient than your code right now as I am still yet short-sighted.

Moreover, if you don't mind too much, is it possible for you to reference some good basic books for programming? or even exercise books/websites other than Project Euler as I am struggling a bit to solve the problems efficiently.

Thank you very much as always,
Kpark

 

[newtoforum]

Dim a() As Byte, u&, j&, s&, n&, q

Why as byte? And what does the rest of the dim statement do - especially the "&"?