Source code in the basic programming language

1000 REM Brazilian numbers
1010 DECLARE EXTERNAL FUNCTION IsBrazilian
1020 DECLARE EXTERNAL FUNCTION SameDigits
1030 DECLARE EXTERNAL FUNCTION IsPrime
1040 PRINT "First 20 Brazilian numbers:"
1050 LET C = 0
1060 LET N = 7
1070 DO WHILE C < 20
1080    IF IsBrazilian(N) <> 0 THEN
1090       PRINT N;
1100       LET C = C + 1
1110    END IF
1120    LET N = N + 1
1130 LOOP
1140 PRINT
1150 PRINT
1160 PRINT "First 20 odd Brazilian numbers:"
1170 LET C = 0
1180 LET N = 7
1190 DO WHILE C < 20
1200    IF IsBrazilian(N) <> 0 THEN
1210       PRINT N;
1220       LET C = C + 1
1230    END IF
1240    LET N = N + 2
1250 LOOP
1260 PRINT
1270 PRINT
1280 PRINT "First 20 prime Brazilian numbers:"
1290 LET C = 0
1300 LET N = 7
1310 DO WHILE C < 20
1320    IF IsBrazilian(N) <> 0 THEN
1330       PRINT N;
1340       LET C = C + 1
1350    END IF
1360    DO
1370       LET N = N + 2
1380    LOOP WHILE IsPrime(N) = 0
1390 LOOP
1400 PRINT
1410 END
1420 REM
1430 EXTERNAL FUNCTION IsBrazilian(N)
1440 REM Result: 1 if N is Brazilian, 0 otherwise
1450 IF N < 7 THEN
1460    LET IsBrazilian = 0
1470 ELSEIF (MOD(N, 2) = 0) AND (N >= 8) THEN
1480    LET IsBrazilian = 1
1490 ELSE
1500    FOR B = 2 TO N - 2
1510       IF SameDigits(N, B) <> 0 THEN 
1520          LET IsBrazilian = 1
1530          EXIT FUNCTION
1540       END IF
1550    NEXT B
1560    LET IsBrazilian = 0
1570 END IF
1580 END FUNCTION
1590 REM
1600 EXTERNAL FUNCTION SameDigits(N, B)
1610 REM Result: 1 if N has same digits in the base B, 0 otherwise
1620 LET NL = N ! Local N
1630 LET F = MOD(NL, B)
1640 LET NL = INT(NL / B)
1650 DO WHILE NL > 0
1660    IF MOD(NL, B) <> F THEN 
1670       LET SameDigits = 0
1680       EXIT FUNCTION
1690    END IF
1700    LET NL = INT(NL / B)
1710 LOOP
1720 LET SameDigits = 1
1730 END FUNCTION
1740 REM
1750 EXTERNAL FUNCTION IsPrime(N)
1760 REM Result: non-zero if N is prime, 0 otherwise
1770 IF N < 2 THEN
1780    LET IsPrime = 0
1790 ELSEIF MOD(N, 2) = 0 THEN 
1800    REM IsPrime = (N = 2)
1810    IF N = 2 THEN
1820       LET IsPrime = 1
1830    ELSE 
1840       LET IsPrime = 0
1850    END IF
1860 ELSEIF MOD(N, 3) = 0 THEN 
1870    REM IsPrime = (N = 3)
1880    IF N = 3 THEN
1890       LET IsPrime = 1
1900    ELSE 
1910       LET IsPrime = 0
1920    END IF
1930 ELSE
1940    LET D = 5
1950    DO WHILE D * D <= N
1960       IF MOD(N, D) = 0 THEN
1970          LET IsPrime = 0
1980          EXIT FUNCTION
1990       ELSE
2000          LET D = D + 2
2010          IF MOD(N, D) = 0 THEN
2020             LET IsPrime = 0
2030             EXIT FUNCTION
2040          ELSE
2050             LET D = D + 4
2060          END IF
2070       END IF
2080    LOOP
2090    LET IsPrime = 1
2100 END IF
2110 END FUNCTION


Function sameDigits(Byval n As Integer, Byval b As Integer) As Boolean
    Dim f As Integer = n Mod b : n \= b 
    While n > 0
        If n Mod b <> f Then Return False Else n \= b
    Wend 
    Return True
End Function

Function isBrazilian(Byval n As Integer) As Boolean
    If n < 7 Then Return False
    If n Mod 2 = 0 Then Return True
    For b As Integer = 2 To n - 2
        If sameDigits(n, b) Then Return True
    Next b
    Return False
End Function

Function isPrime(Byval n As Integer) As Boolean
    If n < 2 Then Return False
    If n Mod 2 = 0 Then Return n = 2
    If n Mod 3 = 0 Then Return n = 3
    Dim d As Integer = 5
    While d * d <= n
        If n Mod d = 0 Then Return False Else d += 2
        If n Mod d = 0 Then Return False Else d += 4
    Wend 
    Return True
End Function

Dim kind(2) As String ={"", "odd", "prime"}
For i As Integer = 0 To 2
    Print Using "First 20 & Brazilian numbers: "; kind(i)
    Dim Limit As Integer = 20, n As Integer = 7
    Do
        If isBrazilian(n) Then Print Using "& "; n; : Limit -= 1
        Select Case kind(i)
        Case "" : n += 1
        Case "odd" : n += 2
        Case "prime" : Do : n += 2 : Loop Until isPrime(n)
        End Select
    Loop While Limit > 0
Next i
Sleep

10 REM Brazilian numbers
20 PRINT "First 20 Brazilian numbers:"
30 C=0:N=7
40 IF C>=20 THEN 90
50 GOSUB 320
60 IF BR THEN PRINT N;:C=C+1
70 N=N+1
80 GOTO 40
90 PRINT:PRINT
100 PRINT "First 20 odd Brazilian numbers:"
110 C=0:N=7
120 IF C>=20 THEN 170
130 GOSUB 320
140 IF BR THEN PRINT N;:C=C+1
150 N=N+2
160 GOTO 120
170 PRINT:PRINT
180 PRINT "First 12 prime Brazilian numbers:"
190 C=0:N=7
200 IF C>=12 THEN 270
210 GOSUB 320
220 IF BR THEN PRINT N;:C=C+1
230 N=N+2
240 GOSUB 530
250 IF NOT PRM THEN 230
260 GOTO 200
270 PRINT
280 END
290 REM ** Is Brazilian?
300 REM Result: BR=-1 if N is Brazilian
310 REM 0 otherwise
320 IF N<7 THEN BR=0:RETURN
330 IF INT(N/2)*2=N AND N>=8 THEN BR=-1:RETURN
340 FOR B=2 TO N-2
350 GOSUB 430
360 IF SMD THEN BR=-1:RETURN
370 NEXT B
380 BR=0
390 RETURN
400 REM ** Same digits?
410 REM Result: SMD=-1 if N has same digits in B,
420 REM 0 otherwise
430 NL=N:REM "Local" N
440 NDB=INT(NL/B)
450 F=NL-NDB*B
460 NL=NDB:NDB=INT(NL/B)
470 IF NL<=0 THEN SMD=-1:RETURN
480 IF NL-NDB*B<>F THEN SMD=0:RETURN
490 NL=INT(NL/B):NDB=INT(NL/B)
500 GOTO 470
510 REM ** Is prime?
520 REM Result: PRM=-1 if N prime, 0 otherwise 
530 IF N<2 THEN PRM=0:RETURN
540 IF INT(N/2)*2=N THEN PRM=N=2:RETURN
550 IF INT(N/3)*3=N THEN PRM=N=3:RETURN
560 D=5
570 IF D*D>N THEN PRM=-1:RETURN
580 IF INT(N/D)*D=N THEN PRM=0:RETURN
590 D=D+2
600 IF INT(N/D)*D=N THEN PRM=0:RETURN
610 D=D+4
620 GOTO 570


Module Module1

    Function sameDigits(ByVal n As Integer, ByVal b As Integer) As Boolean
        Dim f As Integer = n Mod b : n \= b : While n > 0
            If n Mod b <> f Then Return False Else n \= b
        End While : Return True
    End Function

    Function isBrazilian(ByVal n As Integer) As Boolean
        If n < 7 Then Return False
        If n Mod 2 = 0 Then Return True
        For b As Integer = 2 To n - 2
            If sameDigits(n, b) Then Return True
        Next : Return False
    End Function

    Function isPrime(ByVal n As Integer) As Boolean
        If n < 2 Then Return False
        If n Mod 2 = 0 Then Return n = 2
        If n Mod 3 = 0 Then Return n = 3
        Dim d As Integer = 5
        While d * d <= n
            If n Mod d = 0 Then Return False Else d += 2
            If n Mod d = 0 Then Return False Else d += 4
        End While : Return True
    End Function

    Sub Main(args As String())
        For Each kind As String In {" ", " odd ", " prime "}
            Console.WriteLine("First 20{0}Brazilian numbers:", kind)
            Dim Limit As Integer = 20, n As Integer = 7
            Do
                If isBrazilian(n) Then Console.Write("{0} ", n) : Limit -= 1
                Select Case kind
                    Case " " : n += 1
                    Case " odd " : n += 2
                    Case " prime " : Do : n += 2 : Loop Until isPrime(n)
                End Select
            Loop While Limit > 0
            Console.Write(vbLf & vbLf)
        Next
    End Sub

End Module


Imports System

Module Module1
    ' flags:
    Const _
        PrMk As Integer = 0,  ' a number that is prime
        SqMk As Integer = 1,  ' a number that is the square of a prime number
        UpMk As Integer = 2,  ' a number that can be factored (aka un-prime)
        BrMk As Integer = -2, ' a prime number that is also a Brazilian number
        Excp As Integer = 121 ' exception square - the only square prime that is a Brazilian

    Dim pow As Integer = 9,
        max As Integer '  maximum sieve array length
    '     An upper limit of the required array length can be calculated Like this:
    ' power of 10  fraction              limit        actual result
    '   1          2 / 1 * 10          = 20           20
    '   2          4 / 3 * 100         = 133          132
    '   3          6 / 5 * 1000        = 1200         1191
    '   4          8 / 7 * 10000       = 11428        11364
    '   5          10/ 9 * 100000      = 111111       110468
    '   6          12/11 * 1000000     = 1090909      1084566
    '   7          14/13 * 10000000    = 10769230     10708453
    '   8          16/15 * 100000000   = 106666666    106091516
    '   9          18/17 * 1000000000  = 1058823529   1053421821
    ' powers above 9 are impractical because of the maximum array length in VB.NET,
    ' which is around the UInt32.MaxValue, Or 4294967295

    Dim PS As SByte() ' the prime/Brazilian number sieve
    ' once the sieve is populated, primes are <= 0, non-primes are > 0, 
    ' Brazilian numbers are (< 0) or (> 1)
    ' 121 is a special case, in the sieve it is marked with the BrMk (-2) 

    ' typical sieve of Eratosthenes algorithm
    Sub PrimeSieve(ByVal top As Integer)
        PS = New SByte(top) {} : Dim i, ii, j As Integer
        i = 2 : j = 4 : PS(j) = SqMk : While j < top - 2 : j += 2 : PS(j) = UpMk : End While
        i = 3 : j = 9 : PS(j) = SqMk : While j < top - 6 : j += 6 : PS(j) = UpMk : End While
        i = 5 : ii = 25 : While ii < top
            If PS(i) = PrMk Then
                j = (top - i) / i : If (j And 1) = 0 Then j -= 1
                Do : If PS(j) = PrMk Then PS(i * j) = UpMk
                    j -= 2 : Loop While j > i : PS(ii) = SqMk
            End If
            Do : i += 2 : Loop While PS(i) <> PrMk : ii = i * i
        End While
    End Sub

    ' consults the sieve and returns whether a number is Brazilian
    Function IsBr(ByVal number As Integer) As Boolean
        Return Math.Abs(PS(number)) > SqMk
    End Function

    ' shows the first few Brazilian numbers of several kinds
    Sub FirstFew(ByVal kind As String, ByVal amt As Integer)
        Console.WriteLine(vbLf & "The first {0} {1}Brazilian Numbers are:", amt, kind)
        Dim i As Integer = 7 : While amt > 0
            If IsBr(i) Then amt -= 1 : Console.Write("{0} ", i)
            Select Case kind : Case "odd " : i += 2
                Case "prime " : Do : i += 2 : Loop While PS(i) <> BrMk OrElse i = Excp
                Case Else : i += 1 : End Select : End While : Console.WriteLine()
    End Sub

    ' expands a 111_X number into an integer
    Function Expand(ByVal NumberOfOnes As Integer, ByVal Base As Integer) As Integer
        Dim res As Integer = 1
        While NumberOfOnes > 1 AndAlso res < Integer.MaxValue \ Base
            res = res * Base + 1 : NumberOfOnes -= 1 : End While
        If res > max OrElse res < 0 Then res = 0
        Return res
    End Function

    ' returns an elapsed time string
    Function TS(ByVal fmt As String, ByRef st As DateTime, ByVal Optional reset As Boolean = False) As String
        Dim n As DateTime = DateTime.Now,
            res As String = String.Format(fmt, (n - st).TotalMilliseconds)
        If reset Then st = n
        Return res
    End Function

    Sub Main(args As String())
        Dim p2 As Integer = pow << 1, primes(6) As Integer, n As Integer,
            st As DateTime = DateTime.Now, st0 As DateTime = st,
            p10 As Integer = CInt(Math.Pow(10, pow)), p As Integer = 10, cnt As Integer = 0
        max = CInt(((CLng((p10)) * p2) / (p2 - 1))) : PrimeSieve(max)
        Console.WriteLine(TS("Sieving took {0} ms", st, True))
        ' make short list of primes before Brazilians are added
        n = 3 : For i As Integer = 0 To primes.Length - 1
            primes(i) = n : Do : n += 2 : Loop While PS(n) <> 0 : Next
        Console.WriteLine(vbLf & "Checking first few prime numbers of sequential ones:" &
                          vbLf & "ones checked found")
        ' now check the '111_X' style numbers. many are factorable, but some are prime,
        ' then re-mark the primes found in the sieve as Brazilian.
        ' curiously, only the numbers with a prime number of ones will turn out, so
        ' restricting the search to those saves time. no need to wast time on even numbers of ones, 
        ' or 9 ones, 15 ones, etc...
        For Each i As Integer In primes
            Console.Write("{0,4}", i) : cnt = 0 : n = 2 : Do
                If (n - 1) Mod i <> 0 Then
                    Dim br As Long = Expand(i, n)
                    If br > 0 Then
                        If PS(br) < UpMk Then PS(br) = BrMk : cnt += 1
                    Else
                        Console.WriteLine("{0,8}{1,6}", n, cnt) : Exit Do
                    End If
                End If : n += 1 : Loop While True
        Next
        Console.WriteLine(TS("Adding Brazilian primes to the sieve took {0} ms", st, True))
        For Each s As String In ",odd ,prime ".Split(",") : FirstFew(s, 20) : Next
        Console.WriteLine(TS(vbLf & "Required output took {0} ms", st, True))
        Console.WriteLine(vbLf & "Decade count of Brazilian numbers:")
        n = 6 : cnt = 0 : Do : While cnt < p : n += 1 : If IsBr(n) Then cnt += 1
            End While
            Console.WriteLine("{0,15:n0}th is {1,-15:n0}  {2}", cnt, n, TS("time: {0} ms", st))
            If p < p10 Then p *= 10 Else Exit Do
        Loop While (True) : PS = New SByte(-1) {}
        Console.WriteLine(vbLf & "Total elapsed was {0} ms", (DateTime.Now - st0).TotalMilliseconds)
        If System.Diagnostics.Debugger.IsAttached Then Console.ReadKey()
    End Sub

End Module