Task: Brazilian numbers








VB: 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



Fortran: 

      PROGRAM BRAZILIAN
      IMPLICIT NONE



      INTEGER , PARAMETER  ::  MAX_NUMBER = 2000000 , NUMVARS = 20



      LOGICAL , DIMENSION(1:MAX_NUMBER)  ::  b
      INTEGER  ::  bcount
      INTEGER  ::  bpos
      CHARACTER(15)  ::  holder
      CHARACTER(100)  ::  outline
      LOGICAL , DIMENSION(1:MAX_NUMBER)  ::  p






      CALL BRAZILIANSIEVE(b , MAX_NUMBER)
      WRITE(6 , 34)"The first 20 Brazilian numbers:"
      bcount = 0
      outline = ''
      holder = ''
      bpos = 1
      DO WHILE ( bcount<NUMVARS )
         IF( b(bpos) )THEN
            bcount = bcount + 1
            WRITE(holder , *)bpos
            outline = TRIM(outline) // " " // ADJUSTL(holder)
         END IF
         bpos = bpos + 1
      END DO
 
      WRITE(6 , 34)outline
      WRITE(6 , 34)"The first 20 odd Brazilian numbers:"
      outline = ''
      holder = ''
      bcount = 0
      bpos = 1
      DO WHILE ( bcount<NUMVARS )
         IF( b(bpos) )THEN
            bcount = bcount + 1
            WRITE(holder , *)bpos
            outline = TRIM(outline) // " " // ADJUSTL(holder)
         END IF
         bpos = bpos + 2
      END DO
      WRITE(6 , 34)outline
      WRITE(6 , 34)"The first 20 prime Brazilian numbers:"
      CALL ERATOSTHENES(p , MAX_NUMBER)
      bcount = 0
      outline = ''
      holder = ''
      bpos = 1
      DO WHILE ( bcount<NUMVARS )
         IF( b(bpos) .AND. p(bpos) )THEN
            bcount = bcount + 1
            WRITE(holder , *)bpos
            outline = TRIM(outline) // " " // ADJUSTL(holder)
         END IF
         bpos = bpos + 1
      END DO
      WRITE(6 , 34)outline
      WRITE(6 , 34)"Various Brazilian numbers:"
      bcount = 0
      bpos = 1
      DO WHILE ( bcount<1000000 )
         IF( b(bpos) )THEN
            bcount = bcount + 1
            IF( (bcount==100) .OR. (bcount==1000) .OR. (bcount==10000) .OR.               &
              & (bcount==100000) .OR. (bcount==1000000) )WRITE(* , *)bcount ,             &
               &"th Brazilian number: " , bpos
         END IF
         bpos = bpos + 1
      END DO
      STOP
 34   FORMAT(/ , a)
      END PROGRAM BRAZILIAN

      SUBROUTINE BRAZILIANSIEVE(B , N)
      IMPLICIT NONE



      INTEGER  ::  N
      LOGICAL , DIMENSION(*)  ::  B
      INTENT (IN) N
      INTENT (OUT) B



      INTEGER  ::  b11
      INTEGER  ::  base
      INTEGER  ::  bn
      INTEGER  ::  bnn
      INTEGER  ::  bpower
      INTEGER  ::  digit
      INTEGER  ::  i
      LOGICAL  ::  iseven
      INTEGER  ::  powermax

      iseven = .FALSE.
      B(1:6) = .FALSE.                 
      DO i = 7 , N
         B(i) = iseven
         iseven = .NOT.iseven
      END DO
      DO base = 2 , (N/2)
         b11 = base + 1
         bnn = b11
         DO digit = 3 , base - 1 , 2
            bnn = bnn + b11 + b11
            IF( bnn>N )EXIT
            B(bnn) = .TRUE.
         END DO
      END DO
      DO base = 2 , INT(SQRT(FLOAT(N)))
         powermax = HUGE(powermax)/base             
         IF( powermax>N )powermax = N               
         DO digit = 1 , base - 1 , 2
            bpower = base*base
            bn = digit*(bpower + base + 1)
            DO WHILE ( (bn<=N) .AND. (bpower<=powermax) )
               IF( bn<=N )B(bn) = .TRUE.
               bpower = bpower*base
               bn = bn + (digit*bpower)
            END DO
         END DO
      END DO
      RETURN
      END SUBROUTINE BRAZILIANSIEVE

      SUBROUTINE ERATOSTHENES(P , N)
      IMPLICIT NONE



      INTEGER  ::  N
      LOGICAL , DIMENSION(*)  ::  P
      INTENT (IN) N
      INTENT (INOUT) P



      INTEGER  ::  i
      INTEGER  ::  ii
      LOGICAL  ::  oddeven
      INTEGER  ::  pr

      P(1) = .FALSE.
      P(2) = .TRUE.
      oddeven = .TRUE.
      DO i = 3 , N
         P(i) = oddeven
         oddeven = .NOT.oddeven
      END DO
      DO i = 2 , INT(SQRT(FLOAT(N)))
         ii = i + i
         IF( P(i) )THEN
            DO pr = i*i , N , ii
               P(pr) = .FALSE.
            END DO
         END IF
      END DO
      RETURN
      END SUBROUTINE ERATOSTHENES