langs a-z

Task/Hamming-numbers/Oz/hamming-numbers.oz

@@ -0,0 +1,32 @@
+declare
+  fun lazy {HammingFun}
+     1|{FoldL1 [{MultHamming 2} {MultHamming 3} {MultHamming 5}] LMerge}
+  end
+
+  Hamming = {HammingFun}
+
+  fun {MultHamming N}
+     {LMap Hamming fun {$ X} N*X end}
+  end
+
+  fun lazy {LMap Xs F}
+     case Xs
+     of nil  then nil
+     [] X|Xr then {F X}|{LMap Xr F}
+     end
+  end
+
+  fun lazy {LMerge Xs=X|Xr Ys=Y|Yr}
+     if     X < Y then X|{LMerge Xr Ys}
+     elseif X > Y then Y|{LMerge Xs Yr}
+     else              X|{LMerge Xr Yr}
+     end
+  end
+
+  fun {FoldL1 X|Xr F}
+     {FoldL Xr F X}
+  end
+in
+  {ForAll {List.take Hamming 20} System.showInfo}
+  {System.showInfo {Nth Hamming 1690}}
+  {System.showInfo {Nth Hamming 1000000}}

Task/Hamming-numbers/PARI-GP/hamming-numbers.pari

@@ -0,0 +1,16 @@
+Hupto(n)={
+  my(v=vector(n),x2=2,x3=3,x5=5,i=1,j=1,k=1,t);
+  v[1]=1;
+  for(m=2,n,
+    v[m]=t=min(x2,min(x3,x5));
+    if(x2 == t, x2 = v[i++] << 1);
+    if(x3 == t, x3 = 3 * v[j++]);
+    if(x5 == t, x5 = 5 * v[k++]);
+  );
+  v
+};
+H(n)=Hupto(n)[n];
+
+Hupto(20)
+H(1691)
+H(10^6)

Task/Hamming-numbers/Perl-6/hamming-numbers.pl6

@@ -0,0 +1,13 @@
+my $limit = 32;
+
+sub powers_of ($radix) { 1, [\*] $radix xx * }
+
+my @hammings =
+  (   powers_of(2)[^ $limit ]       X*
+    ( powers_of(3)[^($limit * 2/3)] X*
+      powers_of(5)[^($limit * 1/2)]
+    )
+  ).sort;
+
+say ~@hammings[^20];
+say @hammings[1690]; # zero indexed

Task/Hamming-numbers/Qi/hamming-numbers.qi

@@ -0,0 +1,20 @@
+(define smerge
+  [X|Xs] [Y|Ys] -> [X | (freeze (smerge (thaw Xs) [Y|Ys]))] where (< X Y)
+  [X|Xs] [Y|Ys] -> [Y | (freeze (smerge [X|Xs] (thaw Ys)))] where (> X Y)
+  [X|Xs] [_|Ys] -> [X | (freeze (smerge (thaw Xs) (thaw Ys)))])
+
+(define smerge3
+  Xs Ys Zs -> (smerge Xs (smerge Ys Zs)))
+
+(define smap
+  F [S|Ss] -> [(F S)|(freeze (smap F (thaw Ss)))])
+
+(set hamming [1 | (freeze (smerge3 (smap (* 2) (value hamming))
+                                   (smap (* 3) (value hamming))
+                                   (smap (* 5) (value hamming))))])
+
+(define stake
+  _      0 -> []
+  [S|Ss] N -> [S|(stake (thaw Ss) (1- N))])
+
+(stake (value hamming) 20)

Task/Hamming-numbers/Run-BASIC/hamming-numbers.run

@@ -0,0 +1,23 @@
+dim h(1000000)
+for i =1 to 20
+    print hamming(i);" ";
+next i
+
+print
+print "Hamming List First(1691)   =";chr$(9);hamming(1691)
+print "Hamming List Last(1000000) =";chr$(9);hamming(1000000)
+
+end
+
+function hamming(limit)
+    h(0) =1
+    x2 = 2: x3 = 3: x5 =5
+    i  = 0: j  = 0: k  =0
+    for n =1 to limit
+        h(n)  = min(x2, min(x3, x5))
+        if x2 = h(n) then i = i +1: x2 =2 *h(i)
+        if x3 = h(n) then j = j +1: x3 =3 *h(j)
+        if x5 = h(n) then k = k +1: x5 =5 *h(k)
+    next n
+    hamming = h(limit -1)
+end function

Task/Hamming-numbers/Seed7/hamming-numbers.seed7

@@ -0,0 +1,60 @@
+$ include "seed7_05.s7i";
+  include "bigint.s7i";
+
+const func bigInteger: min (in bigInteger: a, in bigInteger: b, in bigInteger: c) is func
+  result
+    var bigInteger: min is 0_;
+  begin
+    if a < b then
+      min := a;
+    else
+      min := b;
+    end if;
+    if c < min then
+      min := c;
+    end if;
+  end func;
+
+const func bigInteger: hamming (in integer: n) is func
+  result
+    var bigInteger: hammingNum is 1_;
+  local
+    var array bigInteger: hammingNums is 0 times 0_;
+    var integer: index is 0;
+    var bigInteger: x2 is 2_;
+    var bigInteger: x3 is 3_;
+    var bigInteger: x5 is 5_;
+    var integer: i is 1;
+    var integer: j is 1;
+    var integer: k is 1;
+  begin
+    hammingNums := n times 1_;
+    for index range 2 to n do
+      hammingNum := min(x2, x3, x5);
+      hammingNums[index] := hammingNum;
+      if x2 = hammingNum then
+        incr(i);
+        x2 := 2_ * hammingNums[i];
+      end if;
+      if x3 = hammingNum then
+        incr(j);
+        x3 := 3_ * hammingNums[j];
+      end if;
+      if x5 = hammingNum then
+        incr(k);
+        x5 := 5_ * hammingNums[k];
+      end if;
+    end for;
+  end func;
+
+const proc: main is func
+  local
+    var integer: n is 0;
+  begin
+    for n range 1 to 20 do
+      write(hamming(n) <& " ");
+    end for;
+    writeln;
+    writeln(hamming(1691));
+    writeln(hamming(1000000));
+  end func;

Task/Hamming-numbers/Ursala/hamming-numbers-1.ursala

@@ -0,0 +1,4 @@
+#import std
+#import nat
+
+smooth"p" "n" = ~&z take/"n" nleq-< (rep(length "n") ^Ts/~& product*K0/"p") <1>

Task/Hamming-numbers/Ursala/hamming-numbers-2.ursala

@@ -0,0 +1 @@
+main = smooth<2,3,5>* nrange(1,20)

Task/Hamming-numbers/Ursala/hamming-numbers-3.ursala

@@ -0,0 +1,12 @@
+#import std
+#import nat
+
+smooth"p" "n" =
+
+~&H\"p" *-<1>; @NiXS ~&/(1,1); ~&ll~="n"->lr -+
+   ^\~&rlPrrn2rrm2Zlrrmz3EZYrrm2lNCTrrm2QAX*rhlPNhrnmtPA2XtCD ~&lrPrhl2E?/~&l ^|/successor@l ~&hl,
+   ^|/~& nleq-<&l+ * ^\~&r ~&l|| product@rnmhPX+-
+
+#cast %nL
+
+main = smooth<2,3,5>* nrange(1,20)--<1691,1000000>