aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

9
Task/Hamming-numbers/00DESCRIPTION
View file

@ -13,8 +13,13 @@ Generate the sequence of Hamming numbers, ''in increasing order''.   In par
# Show the &nbsp; one million<sup>th</sup> &nbsp; Hamming number (if the language – or a convenient library – supports arbitrary-precision integers).
;Related tasks:
* [https://rosettacode.org/wiki/Humble_numbers humble numbers]
;References:
* [[wp:Hamming numbers|Hamming numbers]]
* [[wp:Smooth number|Smooth number]]
* Wikipedia entry: &nbsp; [[wp:Hamming numbers|Hamming numbers]] &nbsp; &nbsp; (this link is re-directed to &nbsp; '''Regular number''').
* Wikipedia entry: &nbsp; [[wp:Smooth number|Smooth number]]
* OEIS entry: &nbsp; [[oeis:A051037|A051037 &nbsp; 5-smooth &nbsp; or &nbsp; Hamming numbers]]
* [http://dobbscodetalk.com/index.php?option=com_content&task=view&id=913&Itemid=85 Hamming problem] from Dr. Dobb's CodeTalk (dead link as of Sep 2011; parts of the thread [http://drdobbs.com/blogs/architecture-and-design/228700538 here] and [http://www.jsoftware.com/jwiki/Essays/Hamming%20Number here]).
<br><br>

1
Task/Hamming-numbers/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

81
Task/Hamming-numbers/Dart/hamming-numbers-1.dart Normal file
View file

@ -0,0 +1,81 @@
import 'dart:math';
final lb2of2 = 1.0;
final lb2of3 = log(3.0) / log(2.0);
final lb2of5 = log(5.0) / log(2.0);
class Trival {
final double log2;
final int twos;
final int threes;
final int fives;
Trival mul2() {
return Trival(this.log2 + lb2of2, this.twos + 1, this.threes, this.fives);
}
Trival mul3() {
return Trival(this.log2 + lb2of3, this.twos, this.threes + 1, this.fives);
}
Trival mul5() {
return Trival(this.log2 + lb2of5, this.twos, this.threes, this.fives + 1);
}
@override String toString() {
return this.log2.toString() + " "
+ this.twos.toString() + " "
+ this.threes.toString() + " "
+ this.fives.toString();
}
const Trival(this.log2, this.twos, this.threes, this.fives);
}
Iterable<Trival> makeHammings() sync* {
var one = Trival(0.0, 0, 0, 0);
yield(one);
var s532 = one.mul2();
var mrg = one.mul3();
var s53 = one.mul3().mul3(); // equivalent to 9 for advance step
var s5 = one.mul5();
var i = -1; var j = -1;
List<Trival> h = [];
List<Trival> m = [];
Trival rslt;
while (true) {
if (s532.log2 < mrg.log2) {
rslt = s532; h.add(s532); ++i; s532 = h[i].mul2();
} else {
rslt = mrg; h.add(mrg);
if (s53.log2 < s5.log2) {
mrg = s53; m.add(s53); ++j; s53 = m[j].mul3();
} else {
mrg = s5; m.add(s5); s5 = s5.mul5();
}
if (j > (m.length >> 1)) {m.removeRange(0, j); j = 0; }
}
if (i > (h.length >> 1)) {h.removeRange(0, i); i = 0; }
yield(rslt);
}
}
BigInt trival2Int(Trival tv) {
return BigInt.from(2).pow(tv.twos)
* BigInt.from(3).pow(tv.threes)
* BigInt.from(5).pow(tv.fives);
}
void main() {
final numhams = 1000000000000;
var hamseqstr = "The first 20 Hamming numbers are: ( ";
makeHammings().take(20)
.forEach((h) => hamseqstr += trival2BigInt(h).toString() + " ");
print(hamseqstr + ")");
var nthhamseqstr = "The first 20 Hamming numbers are: ( ";
for (var i = 1; i <= 20; ++i) {
nthhamseqstr += trival2BigInt(nthHamming(i)).toString() + " ";
}
print(nthhamseqstr + ")");
final strt = DateTime.now().millisecondsSinceEpoch;
final answr = makeHammings().skip(999999).first;
final elpsd = DateTime.now().millisecondsSinceEpoch - strt;
print("The ${numhams}th Hamming number is: $answr");
print("in full as: ${trival2BigInt(answr)}");
print("This test took $elpsd milliseconds.");
}

88
Task/Hamming-numbers/Dart/hamming-numbers-2.dart Normal file
View file

@ -0,0 +1,88 @@
import 'dart:math';
final lb2of2 = 1.0;
final lb2of3 = log(3.0) / log(2.0);
final lb2of5 = log(5.0) / log(2.0);
class Trival {
final double log2;
final int twos;
final int threes;
final int fives;
Trival mul2() {
return Trival(this.log2 + lb2of2, this.twos + 1, this.threes, this.fives);
}
Trival mul3() {
return Trival(this.log2 + lb2of3, this.twos, this.threes + 1, this.fives);
}
Trival mul5() {
return Trival(this.log2 + lb2of5, this.twos, this.threes, this.fives + 1);
}
@override String toString() {
return this.log2.toString() + " "
+ this.twos.toString() + " "
+ this.threes.toString() + " "
+ this.fives.toString();
}
const Trival(this.log2, this.twos, this.threes, this.fives);
}
BigInt trival2BigInt(Trival tv) {
return BigInt.from(2).pow(tv.twos)
* BigInt.from(3).pow(tv.threes)
* BigInt.from(5).pow(tv.fives);
}
Trival nthHamming(int n) {
if (n < 1) throw Exception("nthHamming: argument must be higher than 0!!!");
if (n < 7) {
if (n & (n - 1) == 0) {
final bts = n.bitLength - 1;
return Trival(bts.toDouble(), bts, 0, 0);
}
switch (n) {
case 3: return Trival(lb2of3, 0, 1, 0);
case 5: return Trival(lb2of5, 0, 0, 1);
case 6: return Trival(lb2of2 + lb2of3, 1, 1, 0);
}
}
final fctr = 6.0 * lb2of3 * lb2of5;
final crctn = log(sqrt(30.0)) / log(2.0);
final lb2est = pow(fctr * n.toDouble(), 1.0/3.0) - crctn;
final lb2rng = 2.0/lb2est;
final lb2hi = lb2est + 1.0/lb2est;
List<Trival> ebnd = [];
var cnt = 0;
for (var k = 0; k < (lb2hi / lb2of5).ceil(); ++k) {
final lb2p = lb2hi - k * lb2of5;
for (var j = 0; j < (lb2p / lb2of3).ceil(); ++j) {
final lb2q = lb2p - j * lb2of3;
final i = lb2q.floor(); final lb2frac = lb2q - i;
cnt += i + 1;
if (lb2frac <= lb2rng) {
final lb2v = i * lb2of2 + j * lb2of3 + k * lb2of5;
ebnd.add(Trival(lb2v, i, j, k));
}
}
}
ebnd.sort((a, b) => b.log2.compareTo(a.log2)); // descending order
final ndx = cnt - n;
if (ndx < 0) throw Exception("nthHamming: not enough triples generated!!!");
if (ndx >= ebnd.length) throw Exception("nthHamming: error band is too narrow!!!");
return ebnd[ndx];
}
void main() {
final numhams = 1000000;
var nthhamseqstr = "The first 20 Hamming numbers are: ( ";
for (var i = 1; i <= 20; ++i) {
nthhamseqstr += trival2BigInt(nthHamming(i)).toString() + " ";
}
print(nthhamseqstr + ")");
final strt = DateTime.now().millisecondsSinceEpoch;
final answr = nthHamming(numhams);
final elpsd = DateTime.now().millisecondsSinceEpoch - strt0;
print("The ${numhams}th Hamming number is: $answr");
print("in full as: ${trival2BigInt(answr)}");
print("This test took $elpsd milliseconds.");
}

83
Task/Hamming-numbers/Dart/hamming-numbers-3.dart Normal file
View file

@ -0,0 +1,83 @@
import 'dart:math';
final biglb2of2 = BigInt.from(1) << 100; // 100 bit representations...
final biglb2of3 = (BigInt.from(1784509131911002) << 50) + BigInt.from(134114660393120);
final biglb2of5 = (BigInt.from(2614258625728952) << 50) + BigInt.from(773584997695443);
class BigTrival {
final BigInt log2;
final int twos;
final int threes;
final int fives;
@override String toString() {
return this.log2.toString() + " "
+ this.twos.toString() + " "
+ this.threes.toString() + " "
+ this.fives.toString();
}
const BigTrival(this.log2, this.twos, this.threes, this.fives);
}
BigInt bigtrival2BigInt(BigTrival tv) {
return BigInt.from(2).pow(tv.twos)
* BigInt.from(3).pow(tv.threes)
* BigInt.from(5).pow(tv.fives);
}
BigTrival nthHamming(int n) {
if (n < 1) throw Exception("nthHamming: argument must be higher than 0!!!");
if (n < 7) {
if (n & (n - 1) == 0) {
final bts = n.bitLength - 1;
return BigTrival(BigInt.from(bts) << 100, bts, 0, 0);
}
switch (n) {
case 3: return BigTrival(biglb2of3, 0, 1, 0);
case 5: return BigTrival(biglb2of5, 0, 0, 1);
case 6: return BigTrival(biglb2of2 + biglb2of3, 1, 1, 0);
}
}
final fctr = lb2of3 * lb2of5 * 6;
final crctn = log(sqrt(30.0)) / log(2.0);
final lb2est = pow(fctr * n.toDouble(), 1.0/3.0) - crctn;
final lb2rng = 2.0/lb2est;
final lb2hi = lb2est + 1.0/lb2est;
List<BigTrival> ebnd = [];
var cnt = 0;
for (var k = 0; k < (lb2hi / lb2of5).ceil(); ++k) {
final lb2p = lb2hi - k * lb2of5;
for (var j = 0; j < (lb2p / lb2of3).ceil(); ++j) {
final lb2q = lb2p - j * lb2of3;
final i = lb2q.floor(); final lb2frac = lb2q - i;
cnt += i + 1;
if (lb2frac <= lb2rng) {
// final lb2v = i * lb2of2 + j * lb2of3 + k * lb2of5;
// ebnd.add(Trival(lb2v, i, j, k));
final lb2v = BigInt.from(i) * biglb2of2
+ BigInt.from(j) * biglb2of3
+ BigInt.from(k) * biglb2of5;
ebnd.add(BigTrival(lb2v, i, j, k));
}
}
}
ebnd.sort((a, b) => b.log2.compareTo(a.log2)); // descending order
final ndx = cnt - n;
if (ndx < 0) throw Exception("nthHamming: not enough triples generated!!!");
if (ndx >= ebnd.length) throw Exception("nthHamming: error band is too narrow!!!");
return ebnd[ndx];
}
void main() {
final numhams = 1000000000;
var nthhamseqstr = "The first 20 Hamming numbers are: ( ";
for (var i = 1; i <= 20; ++i) {
nthhamseqstr += bigtrival2BigInt(nthHamming(i)).toString() + " ";
}
print(nthhamseqstr + ")");
final strt = DateTime.now().millisecondsSinceEpoch;
final answr = nthHamming(numhams);
final elpsd = DateTime.now().millisecondsSinceEpoch - strt;
print("The ${numhams}th Hamming number is: $answr");
print("in full as: ${bigtrival2BigInt(answr)}");
print("This test took $elpsd milliseconds.");
}

47
Task/Hamming-numbers/Haskell/hamming-numbers-5.hs
View file

@ -1,40 +1,9 @@
-- directly find n-th Hamming number, in ~ O(n^{2/3}) time
-- based on "top band" idea by Louis Klauder, from DDJ discussion
-- by Will Ness, original post: drdobbs.com/blogs/architecture-and-design/228700538
hamm = foldr merge1 [] . iterate (map (5*)) .
foldr merge1 [] . iterate (map (3*)) $ iterate (2*) 1
where
merge1 (x:xs) ys = x : merge xs ys
import Data.List
import Data.Function
main = let (r,t) = nthHam 1000000 in print t >> print (trival t)
lb3 = logBase 2 3; lb5 = logBase 2 5; lb30_2 = logBase 2 30 / 2
trival (i,j,k) = 2^i * 3^j * 5^k
estval n
| n > 500000 = (v - lb30_2 + (3/v), 6/v) -- the space tweak! (thx, GBG!)
| n > 500000 = (v - 2.4496 , 0.0076 ) -- empirical estimation
| n > 50000 = (v - 2.4424 , 0.0146 ) -- correction, base 2
| n > 500 = (v - 2.3948 , 0.0723 ) -- (dist,width)
| n > 1 = (v - 2.2506 , 0.2887 ) -- around (log $ sqrt 30),
| otherwise = (v - 2.2506 , 0.5771 ) -- says WP
where v = (6*lb3*lb5* fromIntegral n)**(1/3) -- estimated logval, base 2
nthHam :: Integer -> (Double, (Int, Int, Int)) -- ( 64bit: use Int!!! NB! )
nthHam n -- n: 1-based: 1,2,3...
| n <= 0 = error $ "n is 1--based: must be n > 0: " ++ show n
| w >= 1 = error $ "Breach of contract: (w < 1): " ++ show w
| m < 0 = error $ "Not enough triples generated: " ++ show (c,n)
| m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb)
| otherwise = sortBy (flip compare `on` fst) b !! m -- m-th from top in sorted band
where
(hi,w) = estval n -- hi > logval > hi-w
m = fromIntegral (c - n) -- target index, from top
nb = length b -- length of the band
(c,b) = foldl_ (\(c,b) (i,t)-> let c2=c+i in c2`seq` -- ( total count, the band )
case t of []-> (c2,b);[v]->(c2,v:b) ) (0,[]) -- ( =~= mconcat )
[ ( fromIntegral i+1, -- total triples w/ this (j,k)
[ (r,(i,j,k)) | frac < w ] ) -- store it, if inside band
| k <- [ 0 .. floor ( hi /lb5) ], let p = fromIntegral k*lb5,
j <- [ 0 .. floor ((hi-p)/lb3) ], let q = fromIntegral j*lb3 + p,
let (i,frac) = pr (hi-q) ; r = hi - frac -- r = i + q
] where pr = properFraction -- pr 1.24 => (1,0.24)
foldl_ = foldl'
{- 1, 2, 4, 8, 16, 32, ...
3, 6, 12, 24, 48, 96, ...
9, 18, 36, 72, 144, 288, ...
27, ... -}

66
Task/Hamming-numbers/Haskell/hamming-numbers-6.hs
View file

@ -1,43 +1,37 @@
{-# OPTIONS -O2 -XBangPatterns #-}
-- directly find n-th Hamming number, in ~ O(n^{2/3}) time
-- based on "top band" idea by Louis Klauder, from DDJ discussion
-- by Will Ness, original post: drdobbs.com/blogs/architecture-and-design/228700538
import Data.Word
import Data.List (sortBy)
{-# OPTIONS -O3 -XStrict -XBangPatterns #-}
import Data.List (sortBy, foldl') -- ' fix apostrophe coloring
import Data.Function (on)
main = let t = nthHam 1000000000000 in print t >> print (trival t)
main = let (r,t) = nthHam 1000000000000 in print t -- >> print (trival t)
lb3 = logBase 2 3; lb5 = logBase 2 5
lbrt30 = logBase 2 $ sqrt 30 :: Double -- estimate adjustment as per WP
trival (i,j,k) = 2^i * 3^j * 5^k
estval2 n = (6*lb3*lb5*n)**(1/3) - lbrt30 -- estimated logval, base 2
crctn n
| n < 1000 = 0.509 -- empirical correction terms
| n < 1000000 = 0.206
| n < 1000000000 = 0.122 -- further divisions have little effect as already small
| otherwise = 0.105 -- very slowly decrease from this point for a billion
trival (i,j,k) = 2^i * 3^j * 5^k
nthHam :: Word64 -> (Int, Int, Int)
nthHam n -- n: 1-based 1,2,3...
| n < 2 = case n of
0 -> error "nthHam: Argument is zero!"
_ -> (0, 0, 0) -- trivial case for 1
| m < 0 = error $ "Not enough triples generated: " ++ show (c,n)
nthHam :: Int -> (Double, (Int, Int, Int)) -- ( 64bit: use Int!!! NB! )
nthHam n -- n: 1-based: 1,2,3...
| n <= 0 = error $ "n is 1--based: must be n > 0: " ++ show n
| n < 2 = ( 0.0, (0, 0, 0) ) -- trivial case so estimation works for rest
| w >= 1 = error $ "Breach of contract: (w < 1): " ++ show w
| m < 0 = error $ "Not enough triples generated: " ++ show ((c,n) :: (Int, Int))
| m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb)
| otherwise = case res of (_, tv) -> tv -- 2^i * 3^j * 5^k
| otherwise = sortBy (flip compare `on` fst) b !! m -- m-th from top in sorted band
where
(fr,est)= (crctn n, estval2 $ fromIntegral n) -- fraction of log2 error, est val
(hi,lo) = (estval2 (fromIntegral n + fr*est), 2*est-hi) -- hi > logval2 > hi-w
(c,b) = let klmt = floor (hi/lb5) in
let loopk k !ck bndk =
if k > klmt then (ck, bndk) else
let p = fromIntegral k*lb5; jlmt = floor ((hi-p)/lb3) in
let loopj j !cj bndj =
if j > jlmt then loopk (k+1) cj bndj else
let q = fromIntegral j*lb3 + p in
let (i, frac) = properFraction (hi-q); r = hi-frac in
if r < lo then loopj (j+1) (fromIntegral i+cj+1) bndj else
loopj (j+1) (fromIntegral i+cj+1) ((r,(i,j,k)):bndj) in
loopj 0 ck bndk in
loopk 0 0 []
(m,nb) = ( fromIntegral $ c - n, length b ) -- m 0-based from top, |band|
(s,res) = ( sortBy (flip compare `on` fst) b, s!!m ) -- sorted decreasing, result<
lb3 = logBase 2 3; lb5 = logBase 2 5; lb30_2 = logBase 2 30 / 2
v = (6*lb3*lb5* fromIntegral n)**(1/3) - lb30_2 -- estimated logval, base 2
estval n = (v + (1/v), 2/v) -- the space tweak! (thx, GBG!)
(hi,w) = estval n -- hi > logval > hi-w
m = fromIntegral (c - n) -- target index, from top
nb = length (b :: [(Double, (Int, Int, Int))]) -- length of the band
(c,b) = foldl_ (\(c,b) (i,t)-> let c2=c+i in c2 `seq` -- ( total count, the band )
case t of []-> (c2,b);[v]->(c2,v:b) ) (0,[]) -- ( =~= mconcat )
[ ( fromIntegral i+1, -- total triples w/ this (j,k)
[ (r,(i,j,k)) | frac < w ] ) -- store it, if inside band
| k <- [ 0 .. floor ( hi /lb5) ], let p = fromIntegral k*lb5,
j <- [ 0 .. floor ((hi-p)/lb3) ], let q = fromIntegral j*lb3 + p,
let (i,frac) = pr (hi-q) ; r = hi - frac -- r = i + q
] where pr = properFraction -- pr 1.24 => (1,0.24)
foldl_ = foldl'

40
Task/Hamming-numbers/Haskell/hamming-numbers-7.hs Normal file
View file

@ -0,0 +1,40 @@
{-# OPTIONS_GHC -O3 -XStrict #-}
import Data.Word
import Data.List (sortBy)
import Data.Function (on)
nthHam :: Word64 -> (Int, Int, Int)
nthHam n -- n: 1-based 1,2,3...
| n < 2 = case n of
0 -> error "nthHam: Argument is zero!"
_ -> (0, 0, 0) -- trivial case for 1
| m < 0 = error $ "Not enough triples generated: " ++ show (c,n)
| m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb)
| otherwise = case res of (_, tv) -> tv -- 2^i * 3^j * 5^k
where
lb3 = logBase 2 3; lb5 = logBase 2 5.0
lbrt30 = logBase 2 $ sqrt 30 :: Double -- estimate adjustment as per WP
lg2est = (6 * lb3 * lb5 * fromIntegral n)**(1/3) - lbrt30 -- estimated logval, base 2
(hi,lo) = (lg2est + 1/lg2est, 2 * lg2est - hi) -- hi > log2est > lo
(c, b) = let klmt = floor (hi / lb5)
loopk k ck bndk =
if k > klmt then (ck, bndk) else
let p = hi - fromIntegral k * lb5; jlmt = floor (p / lb3)
loopj j cj bndj =
if j > jlmt then loopk (k + 1) cj bndj else
let q = p - fromIntegral j * lb3
(i, frac) = properFraction q
nj = j + 1; ncj = cj + fromIntegral i + 1
r = hi - frac
nbndj = i `seq` bndj `seq`
if r < lo then bndj
else case (r, (i, j, k)) of
nhd -> nhd `seq` nhd : bndj
in ncj `seq` nbndj `seq` loopj nj ncj nbndj
in loopj 0 ck bndk
in loopk 0 0 []
(m,nb) = ( fromIntegral $ c - n, length b ) -- m 0-based from top, |band|
(s,res) = ( sortBy (flip compare `on` fst) b, s!!m ) -- sorted decreasing, result<
main = putStrLn $ show $ nthHam 1000000000000

48
Task/Hamming-numbers/Haskell/hamming-numbers-8.hs Normal file
View file

@ -0,0 +1,48 @@
{-# OPTIONS_GHC -O3 -XStrict #-}
import Data.Word
import Data.List (sortBy)
import Data.Function (on)
nthHam :: Word64 -> (Int, Int, Int)
nthHam n -- n: 1-based 1,2,3...
| n < 2 = case n of
0 -> error "nthHam: Argument is zero!"
_ -> (0, 0, 0) -- trivial case for 1
| m < 0 = error $ "Not enough triples generated: " ++ show (c,n)
| m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb)
| otherwise = case res of (_, tv) -> tv -- 2^i * 3^j * 5^k
where
lb3 = logBase 2 3; lb5 = logBase 2 5.0
lbrt30 = logBase 2 $ sqrt 30 :: Double -- estimate adjustment as per WP
lg2est = (6 * lb3 * lb5 * fromIntegral n)**(1/3) - lbrt30 -- estimated logval, base 2
(hi,lo) = (lg2est + 1/lg2est, 2 * lg2est - hi) -- hi > log2est > lo
bglb2 = 1267650600228229401496703205376 :: Integer
bglb3 = 2009178665378409109047848542368 :: Integer
bglb5 = 2943393543170754072109742145491 :: Integer
(c, b) = let klmt = floor (hi / lb5)
loopk k ck bndk =
if k > klmt then (ck, bndk) else
let p = hi - fromIntegral k * lb5; jlmt = floor (p / lb3)
loopj j cj bndj =
if j > jlmt then loopk (k + 1) cj bndj else
let q = p - fromIntegral j * lb3
(i, frac) = properFraction q
nj = j + 1; ncj = cj + fromIntegral i + 1
r = hi - frac
nbndj = i `seq` bndj `seq`
if r < lo then bndj
else
let bglg = bglb2 * fromIntegral i +
bglb3 * fromIntegral j +
bglb5 * fromIntegral k in
bglg `seq` case (bglg, (i, j, k)) of
nhd -> nhd `seq` nhd : bndj
in ncj `seq` nbndj `seq` loopj nj ncj nbndj
in loopj 0 ck bndk
in loopk 0 0 []
(m,nb) = ( fromIntegral $ c - n, length b ) -- m 0-based from top, |band|
-- (s,res) = (b, s!!m)
(s,res) = ( sortBy (flip compare `on` fst) b, s!!m ) -- sorted decreasing, result<
main = putStrLn $ show $ nthHam 1000000000000

25
Task/Hamming-numbers/Julia/hamming-numbers-1.julia Normal file
View file

@ -0,0 +1,25 @@
function hammingsequence(N)
if N < 1
throw("Hamming sequence exponent must be a positive integer")
end
ham = N > 4000 ? Vector{BigInt}([1]) : Vector{Int}([1])
base2, base3, base5 = (1, 1, 1)
for i in 1:N-1
x = min(2ham[base2], 3ham[base3], 5ham[base5])
push!(ham, x)
if 2ham[base2] <= x
base2 += 1
end
if 3ham[base3] <= x
base3 += 1
end
if 5ham[base5] <= x
base5 += 1
end
end
ham
end
println(hammingsequence(20))
println(hammingsequence(1691)[end])
println(hammingsequence(1000000)[end])

16
Task/Hamming-numbers/Julia/hamming-numbers-2.julia Normal file
View file

@ -0,0 +1,16 @@
function hammingsequence(N::Int)
if N < 1
throw("Hamming sequence index must be a positive integer")
end
ham = Vector{BigInt}([1])
base2, base3, base5 = 1, 1, 1
next2, next3, next5 = BigInt(2), BigInt(3), BigInt(5)
for _ in 1:N-1
x = min(next2, next3, next5)
push!(ham, x)
next2 <= x && (base2 += 1; next2 = 2ham[base2])
next3 <= x && (base3 += 1; next3 = 3ham[base3])
next5 <= x && (base5 += 1; next5 = 5ham[base5])
end
ham
end

61
Task/Hamming-numbers/Julia/hamming-numbers-3.julia Normal file
View file

@ -0,0 +1,61 @@
function trival((twos, threes, fives))
BigInt(2)^twos * BigInt(3)^threes * BigInt(5)^fives
end
mutable struct Hammings
ham532 :: Vector{Tuple{Float64,Tuple{Int,Int,Int}}}
ham53 :: Vector{Tuple{Float64,Tuple{Int,Int,Int}}}
ndx532 :: Int
ndx53 :: Int
next2 :: Tuple{Float64,Tuple{Int,Int,Int}}
next3 :: Tuple{Float64,Tuple{Int,Int,Int}}
next5 :: Tuple{Float64,Tuple{Int,Int,Int}}
next53 :: Tuple{Float64,Tuple{Int,Int,Int}}
Hammings() = new(
Vector{Tuple{Float64,Tuple{Int,Int,Int}}}(),
Vector{Tuple{Float64,Tuple{Int,Int,Int}}}(),
1, 1,
(1.0, (1, 0, 0)), (log(2, 3), (0, 1, 0)),
(log(2, 5), (0, 0, 1)), (0.0, (0, 0, 0))
)
end
Base.eltype(::Type{Hammings}) = Tuple{Int,Int,Int}
function Base.iterate(HM::Hammings, st = HM) # :: Union{Nothing,Tuple{Tuple{Float64,Tuple{Int,Int,Int}},Hammings}}
log2of2, log2of3, log2of5 = 1.0, log(2,3), log(2,5)
if st.next2[1] < st.next53[1]
push!(st.ham532, st.next2); st.ndx532 += 1
last, (twos, threes, fives) = st.ham532[st.ndx532]
st.next2 = (log2of2 + last, (twos + 1, threes, fives))
else
push!(st.ham532, st.next53)
if st.next3[1] < st.next5[1]
st.next53 = st.next3; push!(st.ham53, st.next3)
last, (_, threes, fives) = st.ham53[st.ndx53]; st.ndx53 += 1
st.next3 = (log2of3 + last, (0, threes + 1, fives))
else
st.next53 = st.next5; push!(st.ham53, st.next5)
last, (_, _, fives) = st.next5
st.next5 = (log2of5 + last, (0, 0, fives + 1))
end
end
len53 = length(st.ham53)
if st.ndx53 > (len53 >>> 1)
nlen53 = len53 - st.ndx53 + 1
copyto!(st.ham53, 1, st.ham53, st.ndx53, nlen53)
resize!(st.ham53, nlen53); st.ndx53 = 1
end
len532 = length(st.ham532)
if st.ndx532 > (len532 >>> 1)
nlen532 = len532 - st.ndx532 + 1
copyto!(st.ham532, 1, st.ham532, st.ndx532, nlen532)
resize!(st.ham532, nlen532); st.ndx532 = 1
end
_, tri = st.ham532[end]
tri, st
# convert(Union{Nothing,Tuple{Tuple{Float64,Tuple{Int,Int,Int}},Hammings}},(st.ham532[end], st))
# (length(st.ham532), length(st.ham53)), st
end
foreach(x -> print(trival(x)," "), (Iterators.take(Hammings(), 20))); println()
let count = 1691; for t in Hammings() count <= 1 && (println(trival(t)); break); count -= 1 end end
let count = 1000000; for t in Hammings() count <= 1 && (println(trival(t)); break); count -= 1 end end

41
Task/Hamming-numbers/Julia/hamming-numbers-4.julia Normal file
View file

@ -0,0 +1,41 @@
function nthhamming(n :: UInt64) # :: Tuple{UInt32, UInt32, UInt32}
# take care of trivial cases too small for band size estimation to work...
n < 1 && throw("nthhamming: argument must be greater than zero!!!")
n < 2 && return (0, 0, 0)
n < 3 && return (1, 0, 0)
# some constants...
log2of2, log2of3, log2of5 = 1.0, log(2, 3), log(2, 5)
fctr, crctn = 6.0 * log2of3 * log2of5, log(2, sqrt(30))
log2est = (fctr * Float64(n))^(1.0 / 3.0) - crctn # log2 answer from WP formula
log2hi = log2est + 1.0 / log2est; width = 2.0 / log2est # up to 2X higher/lower
# loop to find the count of regular numbers and band of possible candidates...
count :: UInt64 = 0; band = Vector{Tuple{Float64,Tuple{UInt32,UInt32,UInt32}}}()
fiveslmt = UInt32(ceil(log2hi / log2of5)); fives :: UInt32 = 0
while fives < fiveslmt
log2p = log2hi - fives * log2of5
threeslmt = UInt32(ceil(log2p / log2of3)); threes :: UInt32 = 0
while threes < threeslmt
log2q = log2p - threes * log2of3
twos = UInt32(floor(log2q)); frac = log2q - twos; count += twos + 1
frac <= width && push!(band, (log2hi - frac, (twos, threes, fives)))
threes += 1
end
fives += 1
end
# process the band found including checks for validity and range...
n > count && throw("nthhamming: band high estimate is too low!!!")
ndx = count - n + 1
ndx > length(band) && throw("nthhamming: band width estimate is too narrow!!!")
sort!(band, by=(tpl -> let (lg,_) = tpl; -lg end)) # sort in decending order
# get and return the answer...
_, tri = band[ndx]
tri
end
foreach(x-> print(trival(nthhamming(UInt(x))), " "), 1:20); println()
println(trival(nthhamming(UInt64(1691))))
println(trival(nthhamming(UInt64(1000000))))

45
Task/Hamming-numbers/Julia/hamming-numbers-5.julia Normal file
View file

@ -0,0 +1,45 @@
function nthhamming(n :: UInt64) # :: Tuple{UInt32, UInt32, UInt32}
# take care of trivial cases too small for band size estimation to work...
n < 1 && throw("nthhamming: argument must be greater than zero!!!")
n < 2 && return (0, 0, 0)
n < 3 && return (1, 0, 0)
# some constants...
log2of2, log2of3, log2of5 = 1.0, log(2, 3), log(2, 5)
fctr, crctn = 6.0 * log2of3 * log2of5, log(2, sqrt(30))
log2est = (fctr * Float64(n))^(1.0 / 3.0) - crctn # log2 answer from WP formula
log2hi = log2est + 1.0 / log2est; width = 2.0 / log2est # up to 2X higher/lower
# some really really big constants representing the "roll-your-own" big logs...
biglog2of2 = BigInt(1267650600228229401496703205376)
biglog2of3 = BigInt(2009178665378409109047848542368)
biglog2of5 = BigInt(2943393543170754072109742145491)
# loop to find the count of regular numbers and band of possible candidates...
count :: UInt64 = 0; band = Vector{Tuple{BigInt,Tuple{UInt32,UInt32,UInt32}}}()
fiveslmt = UInt32(ceil(log2hi / log2of5)); fives :: UInt32 = 0
while fives < fiveslmt
log2p = log2hi - fives * log2of5
threeslmt = UInt32(ceil(log2p / log2of3)); threes :: UInt32 = 0
while threes < threeslmt
log2q = log2p - threes * log2of3
twos = UInt32(floor(log2q)); frac = log2q - twos; count += twos + 1
if frac <= width
biglog = biglog2of2 * twos + biglog2of3 * threes + biglog2of5 * fives
push!(band, (biglog, (twos, threes, fives)))
end
threes += 1
end
fives += 1
end
# process the band found including checks for validity and range...
n > count && throw("nthhamming: band high estimate is too low!!!")
ndx = count - n + 1
ndx > length(band) && throw("nthhamming: band width estimate is too narrow!!!")
sort!(band, by=(tpl -> let (lg,_) = tpl; -lg end)) # sort in decending order
# get and return the answer...
_, tri = band[ndx]
tri
end

19
Task/Hamming-numbers/Julia/hamming-numbers.julia
View file

@ -1,19 +0,0 @@
function hamming(n::Integer)
seq = collect(0:n)
pwrs2 = 2 .^ seq
pwrs3 = 3 .^ seq
pwrs5 = 5 .^ seq
matrix = pwrs2 * pwrs3'
pwrs23 = sort(reshape(matrix, length(matrix)))
matrix = pwrs23 * pwrs5'
if any(x -> x < 0, matrix) warn("overflow values in result, try to use big($n) instead") end
return sort(reshape(matrix, length(matrix)))
end
x = hamming(big(100))
println("First 20 hamming numbers: ", join(x[1:20], ", "))
println("1691-th hamming number: ", x[1691])
println("Million-th hamming number: ", x[1000000])

67
Task/Hamming-numbers/Nim/hamming-numbers-7.nim Normal file
View file

@ -0,0 +1,67 @@
import bigints, math, sequtils, algorithm, times
proc nth_hamming(n: uint64): (uint32, uint32, uint32) =
doAssert n > 0u64
if n < 2: return (0u32, 0u32, 0u32) # trivial case for 1
type Logrep = (float64, (uint32, uint32, uint32))
let
lb3 = 3.0f64.log2
lb5 = 5.0f64.log2
fctr = 6.0f64 * lb3 * lb5
crctn = 30.0f64.sqrt().log2 # log base 2 of sqrt 30
lgest = (fctr * n.float64).pow(1.0f64/3.0f64) - crctn # from WP formula
frctn = if n < 1000000000: 0.509f64 else: 0.105f64
lghi = (fctr * (n.float64 + frctn * lgest)).pow(1.0f64/3.0f64) - crctn
lglo = 2.0f64 * lgest - lghi # and a lower limit of the upper "band"
var count = 0u64 # need to use extended precision, might go over
var bnd = newSeq[Logrep](1) # give itone value so doubling size works
let klmt = uint32(lghi / lb5) + 1
for k in 0 ..< klmt: # i, j, k values can be just u32 values
let p = k.float64 * lb5
let jlmt = uint32((lghi - p) / lb3) + 1
for j in 0 ..< jlmt:
let q = p + j.float64 * lb3
let ir = lghi - q
let lg = q + ir.floor # current log value (estimated)
count += ir.uint64 + 1;
if lg >= lglo:
bnd.add((lg, (ir.uint32, j, k)))
if n > count: raise newException(Exception, "nth_hamming: band high estimate is too low!")
let ndx = (count - n).int
if ndx >= bnd.len: raise newException(Exception, "nth_hamming: band low estimate is too high!")
bnd.sort((proc (a, b: Logrep): int = # sort decreasing order
let (la, _) = a; let (lb, _) = b
la.cmp lb), SortOrder.Descending)
let (_, rslt) = bnd[ndx]
rslt
let num_hammings = 1_000_000_000_000u64
for i in 1 .. 20:
write stdout, nth_hamming(i.uint64).convertTrival2BigInt, " "
echo ""
echo nth_hamming(1691).convertTrival2BigInt
let strt = epochTime()
let rslt = nth_hamming(num_hammings)
let stop = epochTime()
let (x2, x3, x5) = rslt
writeLine stdout, "2^", x2, " + 3^", x3, " + 5^", x5
let lgrslt = (x2.float64 + x3.float64 * 3.0f64.log2 +
x5.float64 * 5.0f64.log2) * 2.0f64.log10
let (whl, frac) = lgrslt.splitDecimal
echo "Approximately: ", 10.0f64.pow(frac), "E+", whl.uint64
let brslt = rslt.convertTrival2BigInt()
let s = brslt.to_string
let ls = s.len
echo "Number of digits: ", ls
if ls <= 2000:
for i in countup(0, ls - 1, 100):
if i + 100 < ls: echo s[i .. i + 99]
else: echo s[i .. ls - 1]
echo "This last took ", (stop - strt)*1000, " milliseconds."

0
Task/Hamming-numbers/Perl-6/hamming-numbers.pl6 → Task/Hamming-numbers/Perl-6/hamming-numbers-1.pl6
View file

16
Task/Hamming-numbers/Perl-6/hamming-numbers-2.pl6 Normal file
View file

@ -0,0 +1,16 @@
my \Hammings := gather {
my %i = 2, 3, 5 Z=> (Hammings.iterator for ^3);
my %n = 2, 3, 5 Z=> 1 xx 3;
loop {
take my $n := %n{2, 3, 5}.min;
for 2, 3, 5 -> \k {
%n{k} = %i{k}.pull-one * k if %n{k} == $n;
}
}
}
say Hammings.[^20];
say Hammings.[1691 - 1];
say Hammings.[1000000 - 1];

28
Task/Hamming-numbers/Perl/hamming-numbers.pl
View file

@ -1,27 +1,29 @@
use strict;
use warnings;
use List::Util 'min';
# If you want the large output, uncomment either the one line
# marked (1) or the two lines marked (2)
#use Math::GMP qw/:constant/; # (1) uncomment this to use Math::GMP
#use Math::GMPz; # (2) uncomment this plus later line for Math::GMPz
sub ham_gen {
my @s = ([1], [1], [1]);
my @m = (2, 3, 5);
#@m = map { Math::GMPz->new($_) } @m; # (2) uncomment for Math::GMPz
my @s = ([1], [1], [1]);
my @m = (2, 3, 5);
#@m = map { Math::GMPz->new($_) } @m; # (2) uncomment for Math::GMPz
return sub {
my $n = min($s[0][0], $s[1][0], $s[2][0]);
for (0 .. 2) {
shift @{$s[$_]} if $s[$_][0] == $n;
push @{$s[$_]}, $n * $m[$_]
}
return $n
return sub {
my $n = min($s[0][0], $s[1][0], $s[2][0]);
for (0 .. 2) {
shift @{$s[$_]} if $s[$_][0] == $n;
push @{$s[$_]}, $n * $m[$_]
}
return $n
}
}
my ($h, $i) = ham_gen;
my $h = ham_gen;
my $i = 0;
++$i, print $h->(), " " until $i > 20;
print "...\n";

31
Task/Hamming-numbers/Phix/hamming-numbers-1.phix
View file

@ -12,22 +12,25 @@ integer i = 1, j = 1, k = 1
return h[N]
end function
include builtins\bigatom.e
include builtins\mpfr.e
function ba_min(bigatom a, bigatom b)
return iff(ba_compare(a,b)<0?a:b)
function mpz_min(mpz a, b)
return iff(mpz_cmp(a,b)<0?a:b)
end function
function ba_hamming(integer N)
sequence h = repeat(ba_new(1),N)
bigatom x2 = ba_new(2), x3 = ba_new(3), x5 = ba_new(5), hn
function mpz_hamming(integer N)
sequence h = mpz_inits(N,1)
mpz x2 = mpz_init(2),
x3 = mpz_init(3),
x5 = mpz_init(5),
hn = mpz_init()
integer i = 1, j = 1, k = 1
for n=2 to N do
hn = ba_min(x2,ba_min(x3,x5))
h[n] = hn
if ba_compare(hn,x2)=0 then i += 1 x2 = ba_multiply(2,h[i]) end if
if ba_compare(hn,x3)=0 then j += 1 x3 = ba_multiply(3,h[j]) end if
if ba_compare(hn,x5)=0 then k += 1 x5 = ba_multiply(5,h[k]) end if
mpz_set(hn,mpz_min(x2,mpz_min(x3,x5)))
mpz_set(h[n],hn)
if mpz_cmp(hn,x2)=0 then i += 1 mpz_mul_si(x2,h[i],2) end if
if mpz_cmp(hn,x3)=0 then j += 1 mpz_mul_si(x3,h[j],3) end if
if mpz_cmp(hn,x5)=0 then k += 1 mpz_mul_si(x5,h[k],5) end if
end for
return h[N]
end function
@ -38,7 +41,7 @@ for i=1 to 20 do
end for
?s
?hamming(1691)
?{hamming(1000000),"wrong!"}
?{hamming(1000000),"wrong!"} --(the hn=x2 etc fail, so multiplies are all wrong)
?ba_sprintf("%B\n",ba_hamming(1691))
?ba_sprintf("%B\n",ba_hamming(1000000))
mpfr_printf(1,"%Zd\n",mpz_hamming(1691))
mpfr_printf(1,"%Zd\n",mpz_hamming(1000000))

18
Task/Hamming-numbers/Phix/hamming-numbers-2.phix
View file

@ -39,14 +39,20 @@ end for
?s
?hint(hamming(1691))
?hint(hamming(1000000))
printf(1," %d\n",hint(hamming(1000000)))
printf(1," %d (approx)\n",hint(hamming(1000000)))
include builtins\bigatom.e
include builtins\mpfr.e
function ba_hint(sequence hm)
function mpz_hint(sequence hm)
-- (as accurate as you like)
sequence p = hm[POWS]
return ba_multiply(ba_power(2,p[POW2]),ba_multiply(ba_power(3,p[POW3]),ba_power(5,p[POW5])))
integer {p2,p3,p5} = hm[POWS]
mpz {tmp2,tmp3,tmp5} = mpz_inits(3)
mpz_ui_pow_ui(tmp2,2,p2)
mpz_ui_pow_ui(tmp3,3,p3)
mpz_ui_pow_ui(tmp5,5,p5)
mpz_mul(tmp3,tmp3,tmp5)
mpz_mul(tmp2,tmp2,tmp3)
return mpz_get_str(tmp2)
end function
?ba_sprintf("%B",ba_hint(hamming(1000000)))
?mpz_hint(hamming(1000000))

7
Task/Hamming-numbers/Python/hamming-numbers-1.py
View file

@ -3,7 +3,12 @@ from itertools import islice
def hamming2():
'''\
This version is based on a snippet from:
http://dobbscodetalk.com/index.php?option=com_content&task=view&id=913&Itemid=85
https://web.archive.org/web/20081219014725/http://dobbscodetalk.com:80
/index.php?option=com_content&task=view&id=913&Itemid=85
http://www.drdobbs.com/architecture-and-design/hamming-problem/228700538
Hamming problem
Written by Will Ness
December 07, 2008
When expressed in some imaginary pseudo-C with automatic
unlimited storage allocation and BIGNUM arithmetics, it can be

23
Task/Hamming-numbers/REXX/hamming-numbers-1.rexx
View file

@ -5,17 +5,16 @@ call hamming 1691 /*show the 1,691st Hamming numb
call hamming 1000000 /*show the 1 millionth Hamming number.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hamming: procedure; parse arg x,y; if y=='' then y=x; w=length(y)
#2=1; #3=1; #5=1; @.=0; @.1=1
do n=2 for y-1
@.n = min(2*@.#2, 3*@.#3, 5*@.#5) /*pick the minimum of 3 (Hamming) #s.*/
if 2*@.#2 == @.n then #2 = #2+1 /*number already defined? Use next #*/
if 3*@.#3 == @.n then #3 = #3+1 /* " " " " " "*/
if 5*@.#5 == @.n then #5 = #5+1 /* " " " " " "*/
end /*n*/ /* [↑] maybe assign next 3 Hamming#s*/
do j=x to y
say 'Hamming('right(j,w)") =" @.j
end /*j*/
hamming: procedure; parse arg x,y; if y=='' then y= x; w= length(y)
#2= 1; #3= 1; #5= 1; @.= 0; @.1 =1
do n=2 for y-1
@.n= min(2*@.#2, 3*@.#3, 5*@.#5) /*pick the minimum of 3 (Hamming) #s.*/
if 2*@.#2 == @.n then #2 = #2 + 1 /*number already defined? Use next #*/
if 3*@.#3 == @.n then #3 = #3 + 1 /* " " " " " "*/
if 5*@.#5 == @.n then #5 = #5 + 1 /* " " " " " "*/
end /*n*/ /* [↑] maybe assign next 3 Hamming#s*/
do j=x to y; say 'Hamming('right(j, w)") =" @.j
end /*j*/
say right( 'length of last Hamming number =' length(@.y), 70); say
say right( 'length of last Hamming number =' length(@.y), 70); say
return

35
Task/Hamming-numbers/REXX/hamming-numbers-2.rexx
View file

@ -5,23 +5,22 @@ call hamming 1691 /*show the 1,691st Hamming numb
call hamming 1000000 /*show the 1 millionth Hamming number.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hamming: procedure; parse arg x,y; if y=='' then y=x; w=length(y)
#2=1; #3=1; #5=1; @.=0; @.1=1
do n=2 for y-1
_2 = @.#2 + @.#2 /*this is faster than: @.#2 * 2 */
_3 = @.#3 * 3
_5 = @.#5 * 5
m = _2 /*assume a minimum (of the 3 Hammings).*/
if _3 < m then m = _3 /*is this number less than the minimum?*/
if _5 < m then m = _5 /* " " " " " " " */
@.n = m /*now, assign the next Hamming number.*/
if _2 == m then #2 = #2 + 1 /*number already defined? Use next #.*/
if _3 == m then #3 = #3 + 1 /* " " " " " " */
if _5 == m then #5 = #5 + 1 /* " " " " " " */
end /*n*/ /* [↑] maybe assign next Hamming #'s. */
do j=x to y
say 'Hamming('right(j, w)") =" @.j
end /*j*/
hamming: procedure; parse arg x,y; if y=='' then y= x; w= length(y)
#2= 1; #3= 1; #5= 1; @.= 0; @.1= 1
do n=2 for y-1
_2= @.#2 + @.#2 /*this is faster than: @.#2 * 2 */
_3= @.#3 * 3
_5= @.#5 * 5
m = _2 /*assume a minimum (of the 3 Hammings).*/
if _3 < m then m = _3 /*is this number less than the minimum?*/
if _5 < m then m = _5 /* " " " " " " " */
@.n = m /*now, assign the next Hamming number.*/
if _2 == m then #2= #2 + 1 /*number already defined? Use next #.*/
if _3 == m then #3= #3 + 1 /* " " " " " " */
if _5 == m then #5= #5 + 1 /* " " " " " " */
end /*n*/ /* [↑] maybe assign next Hamming #'s. */
do j=x to y; say 'Hamming('right(j, w)") =" @.j
end /*j*/
say right( 'length of last Hamming number =' length(@.y), 70); say
say right( 'length of last Hamming number =' length(@.y), 70); say
return

6
Task/Hamming-numbers/Rust/hamming-numbers-5.rust
View file

@ -89,7 +89,7 @@ impl<'a, T: 'a> Lazy<'a, T>{
}
}
// now for immutable persistent (memoized) LazyList via Lazy above
// now for immutable persistent shareable (memoized) LazyList via Lazy above
type RcLazyListNode<'a, T: 'a> = Rc<Lazy<'a, LazyList<'a, T>>>;
@ -193,6 +193,8 @@ impl<T: Clone> RcMVarMethods<T> for RcMVar<T> {
}
}
// finally what the task objective requires...
fn hammings() -> Box<Iterator<Item = Rc<BigUint>>> {
type LL<'a> = LazyList<'a, Rc<BigUint>>;
fn merge<'a>(x: LL<'a>, y: LL<'a>) -> LL<'a> {
@ -230,6 +232,8 @@ fn hammings() -> Box<Iterator<Item = Rc<BigUint>>> {
Box::new(hmng.into_iter())
}
// and the required test outputs...
fn main() {
print!("[");
for (i, h) in hammings().take(20).enumerate() {

37
Task/Hamming-numbers/SQL/hamming-numbers.sql Normal file
View file

@ -0,0 +1,37 @@
CREATE TEMPORARY TABLE factors(n INT);
INSERT INTO factors VALUES(2);
INSERT INTO factors VALUES(3);
INSERT INTO factors VALUES(5);
CREATE TEMPORARY TABLE hamming AS
WITH RECURSIVE ham AS (
SELECT 1 as h
UNION
SELECT h*n x FROM ham JOIN factors ORDER BY x
LIMIT 1700
)
SELECT h FROM ham;
sqlite> SELECT h FROM hamming ORDER BY h LIMIT 20;
1
2
3
4
5
6
8
9
10
12
15
16
18
20
24
25
27
30
32
36
sqlite> SELECT h FROM hamming ORDER BY h LIMIT 1 OFFSET 1690;
2125764000

144
Task/Hamming-numbers/VBA/hamming-numbers.vba Normal file
View file

@ -0,0 +1,144 @@
'RosettaCode Hamming numbers
'This is a well known hard problem in number theory:
'counting the number of lattice points in a
'n-dimensional tetrahedron, here n=3.
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 'stores the number of lattice points indexed on the exponents of 3 and 5
Public hn(2) As Integer 'stores the exponents of 2, 3 and 5
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)
'Computes a, b and c as the vertices
'(a,0,0), (0,b,0), (0,0,c) of a tetrahedron
'with apex (0,0,0) and volume N
'volume N=a*b*c/6
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
'Loop over y and z, compute x and
'count number of lattice points within tetrahedron.
'Step 1 is indirectly called by find_seed to calibrate the plane through A, B and C
'Step 2 fills the matrix cnt with the number of lattice points given the exponents of 3 and 5
'Step 3 the plane is lowered marginally so one or two candidates stick out
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
'This is a candidate, and ...
If cmp(cnt(j, k), j, k, hn) Then
'it is bigger dan what is already in hn
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 'a simple iterative goal search, takes a handful iterations only
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
'Step 1: find fs such that the number of lattice points is exactly N
fs = find_seed(N, 1)
'Step 2: fill the matrix cnt
init fs
err = count(fs, 2)
'Step 3: lower the plane by diminishing fs, the candidates for
'the Nth Hamming number will stick out and be recorded in hn
init fs - 1
err = count(fs - 1, 3)
Debug.Print "2^" & hn(0) - 1; " * 3^" & hn(1); " * 5^" & hn(2); "=";
If N < 1692 Then
'The task set a limit on the number size
Debug.Print pow(2, hn(0) - 1) * pow(3, hn(1)) * pow(5, hn(2))
Else
Debug.Print
If N <= 1000000 Then
'The big Hamming Number will end in a lot of zeroes. The common exponents of 2 and 5
'are split off to be printed separately.
If hn(0) - 1 < hn(2) Then
'Conversion to Decimal datatype with CDec allows to print numbers upto 10^28
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