Task: Hamming numbers








VB: 



Public a As Double, b As Double, c As Double, d As Double
Public p As Double, q As Double, r As Double
Public cnt() As Integer 
Public hn(2) As Integer 
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Function log10(x As Double) As Double
    log10 = WorksheetFunction.log10(x)
End Function
Private Function pow(x As Variant, y As Variant) As Double
    pow = WorksheetFunction.Power(x, y)
End Function
Private Sub init(N As Long)
    
    
    
    
    Dim k As Double
    k = log10(2) * log10(3) * log10(5) * 6 * N
    k = pow(k, 1 / 3)
    a = k / log10(2)
    b = k / log10(3)
    c = k / log10(5)
    p = -b * c
    q = -a * c
    r = -a * b
End Sub
Private Function x_given_y_z(y As Integer, z As Integer) As Double
    x_given_y_z = -(q * y + r * z + a * b * c) / p
End Function
Private Function cmp(i As Integer, j As Integer, k As Integer, gn() As Integer) As Boolean
    cmp = (i * log10(2) + j * log10(3) + k * log10(5)) > (gn(0) * log10(2) + gn(1) * log10(3) + gn(2) * log10(5))
End Function
Private Function count(N As Long, step As Integer) As Long
    
    
    
    
    
    Dim M As Long, j As Integer, k As Integer
    If step = 2 Then ReDim cnt(0 To Int(b) + 1, 0 To Int(c) + 1)
    M = 0: j = 0: k = 0
    Do While -c * j - b * k + b * c > 0
        Do While -c * j - b * k + b * c > 0
            Select Case step
                Case 1: M = M + Int(x_given_y_z(j, k))
                Case 2
                    cnt(j, k) = Int(x_given_y_z(j, k))
                Case 3
                    If Int(x_given_y_z(j, k)) < cnt(j, k) Then
                        
                        If cmp(cnt(j, k), j, k, hn) Then
                            
                            hn(0) = cnt(j, k)
                            hn(1) = j
                            hn(2) = k
                        End If
                    End If
            End Select
            k = k + 1
        Loop
        k = 0
        j = j + 1
    Loop
    count = M
End Function
Private Sub list_upto(ByVal N As Integer)
    Dim count As Integer
    count = 1
    Dim hn As Integer
    hn = 1
    Do While count < N
        k = hn
        Do While k Mod 2 = 0
            k = k / 2
        Loop
        Do While k Mod 3 = 0
            k = k / 3
        Loop
        Do While k Mod 5 = 0
            k = k / 5
        Loop
        If k = 1 Then
            Debug.Print hn; " ";
            count = count + 1
        End If
        hn = hn + 1
    Loop
    Debug.Print
End Sub
Private Function find_seed(N As Long, step As Integer) As Long
    Dim initial As Long, total As Long
    initial = N
    Do 
        init initial
        total = count(initial, step)
        initial = initial + N - total
    Loop Until total = N
    find_seed = initial
End Function
Private Sub find_hn(N As Long)
    Dim fs As Long, err As Long
    
    fs = find_seed(N, 1)
    
    init fs
    err = count(fs, 2)
    
    
    init fs - 1
    err = count(fs - 1, 3)
    Debug.Print "2^" & hn(0) - 1; " * 3^" & hn(1); " * 5^" & hn(2); "=";
    If N < 1692 Then
        
        Debug.Print pow(2, hn(0) - 1) * pow(3, hn(1)) * pow(5, hn(2))
    Else
        Debug.Print
        If N <= 1000000 Then
            
            
            If hn(0) - 1 < hn(2) Then
                
                Debug.Print CDec(pow(3, hn(1))) * CDec(pow(5, hn(2) - hn(0) + 1)) & String$(hn(0) - 1, "0")
            Else
                Debug.Print CDec(pow(2, hn(0) - 1 - hn(2))) * CDec(pow(3, hn(1))) & String$(hn(2), "0")
            End If
        End If
    End If
End Sub
Public Sub main()
    Dim start_time As Long, finis_time As Long
    start_time = GetTickCount
    Debug.Print "The first twenty Hamming numbers are:"
    list_upto 20
    Debug.Print "Hamming number 1691 is: ";
    find_hn 1691
    Debug.Print "Hamming number 1000000 is: ";
    find_hn 1000000
    finis_time = GetTickCount
    Debug.Print "Execution time"; (finis_time - start_time); " milliseconds"
End Sub




Ada: with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.GMP.Integers;
with GNATCOLL.GMP.Lib;

procedure Hamming is

   type Log_Type is new Long_Long_Float;
   package Funcs is new Ada.Numerics.Generic_Elementary_Functions (Log_Type);

   type Factors_Array is array (Positive range <>) of Positive;

   generic
      Factors : Factors_Array := (2, 3, 5);
      
   package Smooth_Numbers is
      type Number is private;
      function Compute (Nth : Positive) return Number;
      function Image (N : Number) return String;

   private
      type Exponent_Type is new Natural;
      type Exponents_Array is array (Factors'Range) of Exponent_Type;
      

      type Number is record
         Exponents : Exponents_Array;
         Log       : Log_Type;
         
      end record;

      function "=" (N1, N2 : Number) return Boolean
        is (for all F in Factors'Range => N1.Exponents (F) = N2.Exponents (F));
   end Smooth_Numbers;

   package body Smooth_Numbers is
      One : constant Number := (Exponents => (others => 0), Log => 0.0);
      Factors_Log : array (Factors'Range) of Log_Type;

      function Image (N : Number) return String is
         use GNATCOLL.GMP.Integers, GNATCOLL.GMP.Lib;
         R, Tmp : Big_Integer;
      begin
         Set (R, "1");
         for F in Factors'Range loop
            Set (Tmp, Factors (F)'Image);
            Raise_To_N (Tmp, GNATCOLL.GMP.Unsigned_Long (N.Exponents (F)));
            Multiply (R, Tmp);
         end loop;
         return Image (R);
      end Image;

      function Compute (Nth : Positive) return Number is
         Candidates : array (Factors'Range) of Number;

         Values     : array (1 .. Nth) of Number;
         

         Indices    : array (Factors'Range) of Natural :=
            (others => Values'First);
         Current    : Number;
         Tmp        : Number;
      begin
         for F in Factors'Range loop
            Factors_Log (F) := Funcs.Log (Log_Type (Factors (F)));
            Candidates (F) := One;
            Candidates (F).Exponents (F) := 1;
            Candidates (F).Log := Factors_Log (F);
         end loop;

         Values (1) := One;

         for Count in 2 .. Nth loop
            
            Current := Candidates (Factors'First);
            for F in Factors'First + 1 .. Factors'Last loop
               if Candidates (F).Log < Current.Log then
                  Current := Candidates (F);
               end if;
            end loop;

            Values (Count) := Current;

            
            
            for F in Factors'Range loop
               if Candidates (F) = Current then
                  Indices (F) := Indices (F) + 1;

                  Tmp := Values (Indices (F));
                  Tmp.Exponents (F) := Tmp.Exponents (F) + 1;
                  Tmp.Log := Tmp.Log + Factors_Log (F);

                  Candidates (F) := Tmp;
               end if;
            end loop;
         end loop;

         return Values (Nth);
      end Compute;
   end Smooth_Numbers;

   package Hamming is new Smooth_Numbers ((2, 3, 5));

begin
   for N in 1 .. 20 loop
      Put (" " & Hamming.Image (Hamming.Compute (N)));
   end loop;
   New_Line;

   Put_Line (Hamming.Image (Hamming.Compute (1691)));
   Put_Line (Hamming.Image (Hamming.Compute (1_000_000)));
end Hamming;