Results 1 to 7 of 7

Thread: nth Composite Number UDF
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Nov 2014
    Location
    Mumbai, Maharashtra, INDIA
    Posts
    146
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default nth Composite Number UDF

    I am looking for a UDF to compute the nth composite number (nth non-prime number) similar to the nth prime.

    for e.g.,
    1st prime number is 2. 1st composite is 4.
    10th prime number is 29. 10th composite is 18.
    100th prime number is 541. 100th composite is 133.

  2. #2
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,659
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: nth Composite Number UDF

    Here's a UDF that calculates either:

    Code:
    Public Primality As String
    
    
    Public Function NumType(ByVal ntype As String, ByVal loc As Long)
    Dim i As Long, j As Long, a As Long, n As Long, x As Long
    
    
        If Len(Primality) = 0 Then Primality = "XP"
        
        ntype = UCase(ntype)
        If ntype <> "P" And ntype <> "C" Then
            NumType = "Invalid code"
            Exit Function
        End If
        
    ChkAgain:
        a = 0
        For i = 2 To Len(Primality)
            If Mid(Primality, i, 1) = ntype Then
                a = a + 1
            End If
            If a = loc Then
                NumType = i
                Exit Function
            End If
        Next i
            
        n = Len(Primality) + 1
        If n > 1000000 Then
            NumType = "The requested value is over 1000000"
            Exit Function
        End If
        
        Primality = Primality & String(1000, "P")
        For i = 2 To Len(Primality)
            If Mid(Primality, i, 1) = "P" Then
                x = Int(n / i) * i
                x = IIf(x = 0, i, x)
                x = IIf(x <= i, i * 2, x)
                For j = x To Len(Primality) Step i
                    Mid(Primality, j, 1) = "C"
                Next j
            End If
        Next i
        GoTo ChkAgain:
        
    End Function
    You call it like so:

    AB
    224
    336
    458
    579
    61110
    71312
    81714
    91915
    102316
    112918

    Sheet3



    Worksheet Formulas
    CellFormula
    A2=numtype("P",ROWS($B$2:$B2))
    B2=numtype("C",ROWS($C$2:$C2))



    It uses memoization to store previously computed results so it doesn't have to recompute every time. I put an upper limit of 1000000 on it, but you can change that if you like. It uses a version of the Sieve of Eratosthenes to calculate the primes. If the next requested function exceeds the number of primes/composites already calculated, it adds another 1000 numbers and tries again (up to 1000000).

    Let us know if this works for you.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  3. #3
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,659
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: nth Composite Number UDF

    A few tweaks to it to improve performance:

    Code:
    Public Primality As String
    
    Public Function NumType(ByVal ntype As String, ByVal loc As Long)
    Dim i As Long, j As Long, n As Long, x As Long, p2 As String
    
        If Primality = "" Then Primality = "XP"
        
        ntype = UCase(ntype)
        If ntype <> "P" And ntype <> "C" Then
            NumType = "Invalid code"
            Exit Function
        End If
        
    ChkAgain:
        p2 = WorksheetFunction.Substitute(Primality, ntype, "~", loc)
        x = InStr(p2, "~")
        If x > 0 Then
            NumType = x
            Exit Function
        End If
            
        n = Len(Primality) + 1
        If n > 1000000 Then
            NumType = "The requested value is over 1000000"
            Exit Function
        End If
        
        Primality = Primality & String(1000, "P")
        For i = 2 To Len(Primality)
            If Mid(Primality, i, 1) = "P" Then
                x = Int(n / i) * i
                x = IIf(x <= i, i * 2, x)
                For j = x To Len(Primality) Step i
                    Mid(Primality, j, 1) = "C"
                Next j
            End If
        Next i
        GoTo ChkAgain:
        
    End Function
    Last edited by Eric W; Sep 9th, 2019 at 01:40 PM.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  4. #4
    Board Regular
    Join Date
    Nov 2014
    Location
    Mumbai, Maharashtra, INDIA
    Posts
    146
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: nth Composite Number UDF

    This meets the first part as it does output both primes and composites. What i also need is the nth value. Say if I input n=4, then it should output 4th prime = 7 and 4th composite = 9.

  5. #5
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,659
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: nth Composite Number UDF

    It does that. Enter:

    =NumType("P",4)

    and it will return 7.

    =NumType("C",4)

    returns 9. Perhaps the fact that I used ROWS() to generate 1,2,3,4, etc. was confusing.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  6. #6
    Board Regular
    Join Date
    Nov 2014
    Location
    Mumbai, Maharashtra, INDIA
    Posts
    146
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: nth Composite Number UDF

    @Eric W;

    This does give the output, but is failing at a higher LOC value. It gives output for C at 10000 but is failing for P at 10000. It starts to fail for C at 30000.

  7. #7
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,659
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: nth Composite Number UDF

    The problem is that the Worksheet function Substitute, which I used in the macro, only allows up to 32767 characters. I replaced it with the VBA Replace function, which is too bad, since it's slower. But here's the updated version. I changed the lines in red:

    Code:
    Public Primality As String
    
    Public Function NumType(ByVal ntype As String, ByVal loc As Long)
    Dim i As Long, j As Long, n As Long, x As Long, p2 As String
    
        If Primality = "" Then Primality = "XP"
    
        ntype = UCase(ntype)
        If ntype <> "P" And ntype <> "C" Then
            NumType = "Invalid code"
            Exit Function
        End If
        
    ChkAgain:
        p2 = Replace(Primality, ntype, "~", , loc - 1)
        x = InStr(p2, ntype)
        If x > 0 Then
            NumType = x
            Exit Function
        End If
            
        n = Len(Primality) + 1
        If n > 1000000 Then
            NumType = "The requested value is over 1000000"
            Exit Function
        End If
        
        Primality = Primality & String(10000, "P")
        For i = 2 To Len(Primality)
            If Mid(Primality, i, 1) = "P" Then
                x = Int(n / i) * i
                x = IIf(x <= i, i * 2, x)
                For j = x To Len(Primality) Step i
                    Mid(Primality, j, 1) = "C"
                Next j
            End If
        Next i
        GoTo ChkAgain:
    
    End Function
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •