Task: Chowla numbers








VB: Option Explicit

Private Declare Function AllocConsole Lib "kernel32.dll" () As Long
Private Declare Function FreeConsole Lib "kernel32.dll" () As Long
Dim mStdOut As Scripting.TextStream

Function chowla(ByVal n As Long) As Long
Dim j As Long, i As Long
  i = 2
  Do While i * i <= n
    j = n \ i
    If n Mod i = 0 Then
    chowla = chowla + i
      If i <> j Then
      chowla = chowla + j
      End If
    End If
    i = i + 1
  Loop
End Function
 
Function sieve(ByVal limit As Long) As Boolean()
Dim c() As Boolean
Dim i As Long
Dim j As Long
  i = 3
  ReDim c(limit - 1)
    Do While i * 3 < limit
      If Not c(i) Then
        If (chowla(i) = 0) Then
          j = 3 * i
          Do While j < limit
            c(j) = True
            j = j + 2 * i
          Loop
        End If
    End If
    i = i + 2
    Loop
  sieve = c()
End Function

Sub Display(ByVal s As String)
  Debug.Print s
  mStdOut.Write s & vbNewLine
End Sub
 
Sub Main()
Dim i As Long
Dim count As Long
Dim limit As Long
Dim power As Long
Dim c() As Boolean
Dim p As Long
Dim k As Long
Dim kk As Long
Dim s As String * 30
Dim mFSO As Scripting.FileSystemObject
Dim mStdIn As Scripting.TextStream
    
  AllocConsole
  Set mFSO = New Scripting.FileSystemObject
  Set mStdIn = mFSO.GetStandardStream(StdIn)
  Set mStdOut = mFSO.GetStandardStream(StdOut)
  
  For i = 1 To 37
    Display "chowla(" & i & ")=" & chowla(i)
  Next i
  
  count = 1
  limit = 10000000
  power = 100
  c = sieve(limit)
  
  For i = 3 To limit - 1 Step 2
    If Not c(i) Then
      count = count + 1
    End If
    If i = power - 1 Then
      RSet s = FormatNumber(power, 0, vbUseDefault, vbUseDefault, True)
      Display "Count of primes up to " & s & " = " & FormatNumber(count, 0, vbUseDefault, vbUseDefault, True)
      power = power * 10
    End If
  Next i

  count = 0: limit = 35000000
  k = 2:     kk = 3

  Do
    p = k * kk
    If p > limit Then
      Exit Do
    End If

    If chowla(p) = p - 1 Then
      RSet s = FormatNumber(p, 0, vbUseDefault, vbUseDefault, True)
      Display s & " is a number that is perfect"
      count = count + 1
    End If
    k = kk + 1
    kk = kk + k
  Loop
        
  Display "There are " & CStr(count) & " perfect numbers <= 35.000.000"

  mStdOut.Write "press enter to quit program."
  mStdIn.Read 1

  FreeConsole

End Sub




Ada: with Ada.Text_IO;

procedure Chowla_Numbers is

   function Chowla (N : Positive) return Natural is
      Sum : Natural  := 0;
      I   : Positive := 2;
      J   : Positive;
   begin
      while I * I <= N loop
         if N mod I = 0 then
            J   := N / I;
            Sum := Sum + I + (if I = J then 0 else J);
            end if;
            I := I + 1;
      end loop;
      return Sum;
   end Chowla;

   procedure Put_37_First is
      use Ada.Text_IO;
   begin
      for A in Positive range 1 .. 37 loop
         Put_Line ("chowla(" & A'Image & ") = " & Chowla (A)'Image);
      end loop;
   end Put_37_First;

   procedure Put_Prime is
      use Ada.Text_IO;
      Count : Natural  := 0;
      Power : Positive := 100;
   begin
      for N in Positive range 2 .. 10_000_000 loop
         if Chowla (N) = 0 then
            Count := Count + 1;
         end if;
         if N mod Power = 0 then
            Put_Line ("There is " & Count'Image & " primes < " & Power'Image);
            Power := Power * 10;
         end if;
      end loop;
   end Put_Prime;

   procedure Put_Perfect is
      use Ada.Text_IO;
      Count : Natural  := 0;
      Limit : constant := 350_000_000;
      K     : Natural := 2;
      Kk    : Natural := 3;
      P     : Natural;
   begin
      loop
         P := K * Kk;
         exit when P > Limit;

         if Chowla (P) = P - 1 then
            Put_Line (P'Image & " is a perfect number");
            Count := Count + 1;
         end if;
         K  := Kk + 1;
         Kk := Kk + K;
      end loop;
      Put_Line ("There are " & Count'Image & " perfect numbers < " & Limit'Image);
   end Put_Perfect;

begin
   Put_37_First;
   Put_Prime;
   Put_Perfect;
end Chowla_Numbers;