Output Prime Numbers and Prime Factors

Category:

Dates and Math

Type:

Snippets

Difficulty:

Intermediate

Author: Richard Deeming

Version Compatibility: Visual Basic 6

More information:

This code outputs all prime numbers up to the limit of the VB double type to the debug window, a text file, and a text box. In addition, it has the ability to optionally include non-prime numbers, and demonstrates factorizing these into a sequence of prime factors. You can also specify the number to start at, allowing you to stop processing and get on with some work, and resume processing at a later time, starting where you left off.

To use the code, create a form with one button (cmdCancel) with a caption of "Start", one check-box (chkNonPrime) with a caption of "Include non-primes", and one text-box (txtPrime). Paste the code into the form's module, and run. Click the "Start" button to start listing primes, tick the checkbox to include non-primes, or enter a number in the textbox to specify a starting point.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Type Factor Base As Double Power As Double End Type Private Cancel As Boolean, Listing As Boolean

Code:

Private Sub OutputPrime(iPrime As Double, iNumber As Double, _
                        FileNum As Integer)
                        
'Output the prime number to the debug window, the file, and the textbox

On Error Resume Next
    Debug.Print iPrime & " is prime #" & iNumber
    Print #FileNum, iPrime & " is prime #" & iNumber
    
    txtPrime.Text = iPrime
End Sub

Private Sub OutputNonPrime(iNonPrime As Double, _
  arrFactors() As Factor,  FileNum As Integer)

'Output the non-prime to the debug window and the file

Dim i As Long       'Current factor
Dim sText As String 'Temp. string to hold text to output

sText = iNonPrime & " = "
    For i = LBound(arrFactors()) To UBound(arrFactors())
    
        If arrFactors(i).Power = 1 Then
            sText = sText & arrFactors(i).Base
            
        Else
           sText = sText & arrFactors(i).Base & "^" & _
              arrFactors(i).Power
            
        End If '(-> If arrFactors(i).Power = 1
        
        sText = sText & " * "
        
    Next i
    
    sText = Left$(sText, Len(sText) - 3)
    
    Debug.Print sText
    Print #FileNum, sText
End Sub

Private Function IsPrime(iNumber As Double) As Boolean

'Check for a prime number
'
'First, check for even number.
'Since an even number will have a 0 in the
'first binary bit, a simple way to test for
'an even number is to do a bitwise And with
'1, and check for a 0 result.
'
'If the number is odd, we only need to check
'up to Sqr(iNumber) - if iNumber is divisble
'by X, and X > Sqr(iNumber), since
'   X * Sqr(iNumber) > iNumber
'   iNumber / X < Sqr(iNumber)
'Therefore, iNumber = X * Y, Y < Sqr(iNumber),
'so we will already have found Y by the time
'we reach Sqr(iNumber)!
'
'Also, we don't need to check even numbers,
'since if iNumber is not divisible by 2, it will
'not be divisible by any multiple of 2.

Dim iD As Double        'Number to check
Dim iSqr As Double      'Square-root of iNumber
Dim iND As Double       'iNumber / iD
Dim found As Boolean    'iD is a factor?

On Error GoTo ErrHandler
    If (iNumber And 1) = 0 Then
        IsPrime = False
        
    Else
        iSqr = Int(Sqr(iNumber))
        iD = 3
        Do Until iD > iSqr Or found
            iND = iNumber / iD
            If iND = Int(iND) Then
                found = True
                
            Else
                iD = iD + 2
                
            End If '(-> If iND = Int(iND)
            
        Loop '(-> Do Until iD > Sqr Or found
        
        IsPrime = Not (found)
        
    End If '(-> If (iNumber And 1) = 0
    Exit Function
ErrHandler:
    'Stop the program
    Cancel = True
End Function

Private Function Factorize(iNumber As Double) As Factor()

'Factorize iNumber into an array of Factor UDTs
'Note: This will only work in VB6, since it returns an
'array of UDTs. For VB5, modify the code to return the
'array as a parameter:
'
'Private Sub Factorize(iNumber As Double, arrFactors() As Factor)

Dim iCount As Double    'Count of unique factors
Dim iTemp As Double     'iNumber / all factors
Dim iD As Double        'Number to check
Dim iND As Double       'iTemp / iD
Dim arrRes() As Factor  'Temp. array of Factors
Dim iLastFac As Double  'Last factor

'Allocate space for all factors
    ReDim arrRes(1 To iNumber) As Factor
    
    iTemp = iNumber
    iD = 2
    
    'When iTemp is prime, there are no more factors
    Do Until IsPrime(iTemp)
    
        Do '(-> Loop Until iND = Int(iND)
            iND = iTemp / iD
            If iND = Int(iND) Then
            'iTemp is divisble by iD
                If iD = iLastFac Then
                'Repeated factor - just increase the power
                  arrRes(iCount).Power = arrRes(iCount).Power + 1
                    
                Else
                'New factor
                    iLastFac = iD
                    iCount = iCount + 1
                    arrRes(iCount).Base = iD
                    arrRes(iCount).Power = 1
                    
                End If '(-> If iD = iLastFac
                
                iTemp = iTemp / iD
                
                'NB - Don't increase iD, since it could be a
                'multiple factor of iNumber
                
            Else
                'Increment iD - note that, other than 2, we
                'don't need to check any even factors
                If iD = 2 Then
                    iD = iD + 1
                Else
                    iD = iD + 2
                End If
                
            End If '(-> If iND = Int(iND)
            
        Loop Until iND = Int(iND)
        
    'NB - No need to reset iD, since as iNumber is not divisible
        'by anything less than iD, iTemp won't be divisible by
        'anything less than iD either.
        
    Loop '(-> Do Until IsPrime(iTemp)
    
    If iTemp > 1 Then
    'One last prime factor
        If iTemp = iLastFac Then
            arrRes(iCount).Power = arrRes(iCount).Power + 1
            
        Else
            iCount = iCount + 1
            arrRes(iCount).Base = iTemp
            arrRes(iCount).Power = 1
            
        End If '(-> If iTemp = iLastFac
        
    End If '(-> If iTemp > 1
    
    'Resize array to only include valid factors
    ReDim Preserve arrRes(1 To iCount) As Factor
    
    Factorize = arrRes()
End Function

Private Sub FindPrimes(Optional ShowNonPrimes As Boolean = _
   False,  Optional StartAt As Double = 2)

'Find all primes, starting at StartAt. If ShowNonPrimes is True,
'will include a factorization of all non-primes.

Dim theNumber As Double         'The number to check
Dim NumberofPrimes As Double    'The count of primes
Dim FileNum As Integer

On Error GoTo ErrHandler
    Listing = True
    
    FileNum = FreeFile
    Open "Primes.txt" For Append As FileNum
    
    Cancel = False
    
    If StartAt <= 2 Then
        '2 is a prime number
        NumberofPrimes = 1
        OutputPrime 2, 1, FileNum
        
        theNumber = 3
        
    ElseIf Int(StartAt) >= 3 Then
        theNumber = Int(StartAt)
        
    Else
        theNumber = 3
        
    End If '(-> If StartAt <= 2
    
    
    Do Until Cancel
        If IsPrime(theNumber) Then
            NumberofPrimes = NumberofPrimes + 1
            OutputPrime theNumber, NumberofPrimes, FileNum
            
        ElseIf ShowNonPrimes Then
            OutputNonPrime theNumber, Factorize(theNumber), _
              FileNum
            
        End If '(-> If IsPrime(theNumber)
        
        If ShowNonPrimes Then
            theNumber = theNumber + 1
            
        Else
            'Only need to check odd numbers
            theNumber = theNumber + 2
            
        End If '(-> If ShowNonPrimes
        
        'Call DoEvents to allow the user to
        'click the cance button
        DoEvents
        
    Loop '(-> Do Until Cancel
    
ErrHandler:
    'Clean up
    Close #FileNum
    
    Listing = False
    
    cmdCancel.Caption = "Start"
End Sub

Private Sub cmdCancel_Click()

'Start or stop the listing

Dim iTemp As Double 'Check for starting value

On Error Resume Next
    If Listing Then
        Cancel = True
        
    Else
        cmdCancel.Caption = "Cancel"
        iTemp = CDbl(txtPrime.Text)
        
        If iTemp < 2 Then
            FindPrimes (chkNonPrime.Value = vbChecked)
            
        Else
            FindPrimes (chkNonPrime.Value = vbChecked), iTemp
        
        End If '(-> If iTemp < 2
        
    End If '(-> If Listing
End Sub