September Morn Update

Task/Hailstone-sequence/00DESCRIPTION

@@ -7,7 +7,9 @@ The Hailstone sequence of numbers can be generated from a starting positive inte
 The (unproven) [[wp:Collatz conjecture|Collatz conjecture]] is that the hailstone sequence for any starting number always terminates.
 
 
-The hailstone sequence is also known as ''hailstone numbers'' (because the values are usually subject to multiple descents and ascents like hailstones in a cloud), or as the ''Collatz sequence''.
+The hailstone sequence is also known as   ''hailstone numbers''   (because the values are usually subject to multiple descents and ascents like hailstones in a cloud).
+
+This sequence is also known as the   ''Collatz sequence''.
 
 
 ;Task:

Task/Hailstone-sequence/00META.yaml

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

Task/Hailstone-sequence/ALGOL-W/hailstone-sequence.alg

@@ -0,0 +1,75 @@
+begin
+    % show some Hailstone Sequence related information                       %
+    % calculates the length of the sequence generated by n,                  %
+    % if showFirstAndLast is true, the first and last 4 elements of the      %
+    % sequence are stored in first and last                                  %
+    % hs holds a cache of the upbHs previously calculated sequence lengths   %
+    % if showFirstAndLast is false, the cache will be used                   %
+    procedure hailstone ( integer value  n
+                        ; integer array  first, last ( * )
+                        ; integer result length
+                        ; integer array  hs          ( * )
+                        ; integer value  upbHs
+                        ; logical value  showFirstAndLast
+                        ) ;
+    if not showFirstAndLast and n <= upbHs and hs( n ) not = 0 then begin
+        % no need to store the start and end of the sequence and we already  %
+        % know the length of the sequence for n                              %
+        length := hs( n )
+        end
+    else begin
+        % must calculate the sequence length                                 %
+        integer sv;
+        for i := 1 until 4 do first( i ) := last( i ) := 0;
+        length := 0;
+        sv     := n;
+        if sv > 0 then begin
+            while begin
+                length := length + 1;
+                if showFirstAndLast then begin
+                    if length <= 4 then first( length ) := sv;
+                    for lPos := 1 until 3 do last( lPos ) := last( lPos + 1 );
+                    last( 4 ) := sv
+                    end
+                else if sv <= upbHs and hs( sv ) not = 0 then begin
+                    % have a known value                                 %
+                    length := ( length + hs( sv ) ) - 1;
+                    sv     := 1
+                end ;
+                sv not = 1
+            end do begin
+                sv := if odd( sv ) then ( 3 * sv ) + 1 else sv div 2
+            end while_sv_ne_1 ;
+            if n < upbHs then hs( n ) := length
+        end if_sv_gt_0
+    end hailstone ;
+    begin
+        % test the hailstone procedure                                       %
+        integer HS_CACHE_SIZE;
+        HS_CACHE_SIZE := 100000;
+        begin
+            integer array first, last ( 1 :: 4 );
+            integer       length, maxLength, maxNumber;
+            integer array hs          ( 1 :: HS_CACHE_SIZE );
+            for i := 1 until HS_CACHE_SIZE do hs( i ) := 0;
+            hailstone( 27, first, last, length, hs, HS_CACHE_SIZE, true );
+            write( i_w := 1, s_w := 0
+                 , "27: length ", length, ", first: ["
+                 , first( 1 ), " ", first( 2 ), " ", first( 3 ), " ", first( 4 )
+                 , "] last: ["
+                 , last( 1 ), " ", last( 2 ), " ", last( 3 ), " ", last( 4 )
+                 , "]"
+                 );
+            maxNumber := 0;
+            maxLength := 0;
+            for n := 1 until 100000 do begin
+                hailstone( n, first, last, length, hs, HS_CACHE_SIZE, false );
+                if length > maxLength then begin
+                    maxNumber := n;
+                    maxLength := length
+                end if_length_gt_maxLength
+            end for_n ;
+            write( i_w := 1, s_w := 1, "Maximum sequence length: ", maxLength, " for: ", maxNumber )
+        end
+    end
+end.

Task/Hailstone-sequence/C++/hailstone-sequence-2.cpp

@@ -0,0 +1,38 @@
+#include <QDebug>
+#include <QVector>
+
+template <class T>
+T hailstone(typename T::value_type n)
+{
+    T seq;
+    for (seq << n; n != 1; seq << n) {
+        n = (n&1) ? (3*n)+1 : n/2;
+    }
+    return seq;
+}
+
+template <class T>
+T longest_hailstone_seq(typename T::value_type n)
+{
+    T maxSeq;
+    for (; n > 0; --n) {
+        const auto seq = hailstone<T>(n);
+        if (seq.size() > maxSeq.size()) {
+            maxSeq = seq;
+        }
+    }
+    return maxSeq;
+}
+
+int main(int, char *[]) {
+    const auto seq = hailstone<QVector<uint_fast16_t>>(27);
+    qInfo() << "hailstone(27):";
+    qInfo() << "  length:" << seq.size() << "elements";
+    qInfo() << "  first 4 elements:" << seq.mid(0,4);
+    qInfo() << "  last 4 elements:" << seq.mid(seq.size()-4);
+
+    const auto max = longest_hailstone_seq<QVector<uint_fast32_t>>(100000);
+    qInfo() << "longest sequence with starting element under 100000:";
+    qInfo() << "  length:" << max.size() << "elements";
+    qInfo() << "  starting element:" << max.first();
+}

Task/Hailstone-sequence/Elena/hailstone-sequence.elena

@@ -1,48 +1,50 @@
-import system'collections.
-import extensions.
+import system'collections;
+import extensions;
 
-int const maxNumber = 100000.
+const int maxNumber = 100000;
 
-Hailstone = (:n:lengths)
-[
+Hailstone(int n,Map<int,int> lengths)
+{
     if (n == 1)
-    [
+    {
         ^ 1
-    ].
+    };
 
     while (true)
-    [
-        if (lengths containsKey(n))
-        [
+    {
+        if (lengths.containsKey(n))
+        {
             ^ lengths[n]
-        ];
-        [
-            if (n int; isEven)
-            [
+        }
+        else
+        {
+            if (n.isEven())
+            {
                 lengths[n] := 1 + Hailstone(n/2, lengths)
-            ];
-            [
-                lengths[n] := 1 + Hailstone((3*n) + 1, lengths)
-            ]
-        ]
-    ]
-].
+            }
+            else
+            {
+                lengths[n] := 1 + Hailstone(3*n + 1, lengths)
+            }
+        }
+    }
+}
 
-program =
-[
-    int longestChain := 0.
-    int longestNumber := 0.
-    var recursiveLengths := Dictionary new.
+public program()
+{
+    int longestChain := 0;
+    int longestNumber := 0;
+    auto recursiveLengths := new Map<int,int>(4096,4096);
 
-    1 till(maxNumber) do(:i)<int>
-    [
-        var chainLength := Hailstone(i, recursiveLengths).
+    for(int i := 1, i < maxNumber, i+=1)
+    {
+        var chainLength := Hailstone(i, recursiveLengths);
         if (longestChain < chainLength)
-        [
-               longestChain := chainLength.
-               longestNumber := i.
-        ]
-    ].
+        {
+               longestChain := chainLength;
+               longestNumber := i
+        }
+    };
 
-    console printFormatted("max below {0}: {1} ({2} steps)", maxNumber, longestNumber, longestChain).
-].
+    console.printFormatted("max below {0}: {1} ({2} steps)", maxNumber, longestNumber, longestChain)
+}

Task/Hailstone-sequence/JavaScript/hailstone-sequence-4.js

@@ -1,30 +1,22 @@
 (function () {
 
-  function memoized(fn) {
+  function memoizedHailstone() {
     var dctMemo = {};
 
-    return function (x) {
-      var varValue = dctMemo[x];
+    return function hailstone(n) {
+      var value = dctMemo[n];
 
-      if ('u' === (typeof varValue)[0])
-        dctMemo[x] = varValue = fn(x);
-      return varValue;
-    };
-  }
-  // Hailstone Sequence
-  // n -> [n]
-  function hailstone(n) {
-    return n === 1 ? [1] : (
-      [n].concat(
-        hailstone(n % 2 ? n * 3 + 1 : n / 2)
-      )
-    )
+      if (typeof value === "undefined") {
+        dctMemo[n] = value = (n === 1) ?
+          [1] : ([n].concat(hailstone(n % 2 ? n * 3 + 1 : n / 2)));
+      }
+      return value;
+    }
   }
 
-   // Derived a memoized version of the function,
-  //  which can reuse previously calculated paths
-
-  var fnCollatz = memoized(hailstone);
+  // Derived a memoized version of the function,
+  // which can reuse previously calculated paths
+  var fnCollatz = memoizedHailstone();
 
   // Iterative version of range
   // [m..n]

Task/Hailstone-sequence/Julia/hailstone-sequence-1.julia

@@ -1,11 +1,11 @@
 function hailstonelength(n::Integer)
-	len = 1
-	while n > 1
-		n = ifelse(iseven(n), n ÷ 2, 3n + 1)
-		len += 1
-	end
-	return len
+    len = 1
+    while n > 1
+        n = ifelse(iseven(n), n ÷ 2, 3n + 1)
+        len += 1
+    end
+    return len
 end
 
-@show hailstonelength(27)
-@show findmax(hailstonelength(i) for i in 1:100_000)
+@show hailstonelength(27); nothing
+@show findmax([hailstonelength(i) for i in 1:100_000]); nothing

Task/Hailstone-sequence/Julia/hailstone-sequence-2.julia

@@ -1,33 +1,32 @@
 struct HailstoneSeq{T<:Integer}
-	start::T
+    count::T
 end
 
 Base.eltype(::HailstoneSeq{T}) where T = T
 
-Base.start(hs::HailstoneSeq) = (-1, hs.start)
-Base.done(::HailstoneSeq, state) = state == (1, 4)
-function Base.next(::HailstoneSeq, state)
-	_, s2 = state
-	s1 = s2
-	if iseven(s2)
-		s2 = s2 ÷ 2
-	else
-		s2 = 3s2 + 1
-	end
-	return s1, (s1, s2)
+function Base.iterate(h::HailstoneSeq, state=h.count)
+    if state == 1
+        (1, 0)
+    elseif state < 1
+        nothing
+    elseif iseven(state)
+        (state, state ÷ 2)
+    elseif isodd(state)
+        (state, 3state + 1)
+    end
 end
 
-function Base.length(hs::HailstoneSeq)
-	r = 0
-	for _ in hs
-		r += 1
-	end
-	return r
+function Base.length(h::HailstoneSeq)
+    len = 0
+    for _ in h
+        len += 1
+    end
+    return len
 end
 
-function Base.show(io::IO, hs::HailstoneSeq)
-	f5 = collect(Iterators.take(hs, 5))
-	print(io, "HailstoneSeq(", join(f5, ", "), "...)")
+function Base.show(io::IO, h::HailstoneSeq)
+    f5 = collect(Iterators.take(h, 5))
+    print(io, "HailstoneSeq{", join(f5, ", "), "...}")
 end
 
 hs = HailstoneSeq(27)

Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6

@@ -4,5 +4,5 @@ my @h = hailstone(27);
 say "Length of hailstone(27) = {+@h}";
 say ~@h;
 
-my $m = max (+hailstone($_) => $_ for 1..99_999);
+my $m = max ( (1..99_999).race.map: { +hailstone($_) => $_ } );
 say "Max length {$m.key} was found for hailstone({$m.value}) for numbers < 100_000";

Task/Hailstone-sequence/Python/hailstone-sequence-2.py

@@ -0,0 +1,112 @@
+'''Hailstone sequences'''
+
+from itertools import (islice, takewhile)
+
+
+# hailstone :: Int -> [Int]
+def hailstone(x):
+    '''Hailstone sequence starting with x.'''
+    def p(n):
+        return 1 != n
+    return list(takewhile(p, iterate(collatz)(x))) + [1]
+
+
+# collatz :: Int -> Int
+def collatz(n):
+    '''Next integer in the hailstone sequence.'''
+    return 3 * n + 1 if 1 & n else n // 2
+
+
+# TEST ----------------------------------------------------
+
+# main :: IO ()
+def main():
+    '''Tests.'''
+
+    n = 27
+    xs = hailstone(n)
+    print(unlines([
+        f'The hailstone sequence for {n} has {len(xs)} elements,',
+        f'starting with {take(4)(xs)},',
+        f'and ending with {drop(len(xs) - 4)(xs)}.\n'
+    ]))
+
+    (a, b) = (1, 99999)
+    (i, x) = max(
+        enumerate(
+            map(compose(len)(hailstone), enumFromTo(a)(b))
+        ),
+        key=snd
+    )
+    print(unlines([
+        f'The number in the range {a}..{b} '
+        f'which produces the longest sequence is {1 + i},',
+        f'generating a hailstone sequence of {x} integers.'
+    ]))
+
+
+# GENERIC ------------------------------------------------
+
+# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
+def compose(g):
+    '''Function composition.'''
+    return lambda f: lambda x: g(f(x))
+
+
+# drop :: Int -> [a] -> [a]
+# drop :: Int -> String -> String
+def drop(n):
+    '''The sublist of xs beginning at (zero-based) index n.'''
+    def go(xs):
+        if isinstance(xs, list):
+            return xs[n:]
+        else:
+            take(n)(xs)
+            return xs
+    return lambda xs: go(xs)
+
+
+# enumFromTo :: (Int, Int) -> [Int]
+def enumFromTo(m):
+    '''Integer enumeration from m to n.'''
+    return lambda n: list(range(m, 1 + n))
+
+
+# iterate :: (a -> a) -> a -> Gen [a]
+def iterate(f):
+    '''An infinite list of repeated applications of f to x.'''
+    def go(x):
+        v = x
+        while True:
+            yield v
+            v = f(v)
+    return lambda x: go(x)
+
+
+# snd :: (a, b) -> b
+def snd(tpl):
+    '''Second component of a tuple.'''
+    return tpl[1]
+
+
+# take :: Int -> [a] -> [a]
+# take :: Int -> String -> String
+def take(n):
+    '''The prefix of xs of length n,
+       or xs itself if n > length xs.'''
+    return lambda xs: (
+        xs[0:n]
+        if isinstance(xs, list)
+        else list(islice(xs, n))
+    )
+
+
+# unlines :: [String] -> String
+def unlines(xs):
+    '''A single newline-delimited string derived
+       from a list of strings.'''
+    return '\n'.join(xs)
+
+
+if __name__ == '__main__':
+    main()

Task/Hailstone-sequence/VBA/hailstone-sequence.vba

@@ -0,0 +1,54 @@
+Private Function hailstone(ByVal n As Long) As Collection
+    Dim s As New Collection
+    s.Add CStr(n), CStr(n)
+    i = 0
+    Do While n <> 1
+        If n Mod 2 = 0 Then
+            n = n / 2
+        Else
+            n = 3 * n + 1
+        End If
+        s.Add CStr(n), CStr(n)
+    Loop
+    Set hailstone = s
+End Function
+
+Private Function hailstone_count(ByVal n As Long)
+    Dim count As Long: count = 1
+    Do While n <> 1
+        If n Mod 2 = 0 Then
+            n = n / 2
+        Else
+            n = 3 * n + 1
+        End If
+        count = count + 1
+    Loop
+    hailstone_count = count
+End Function
+
+Public Sub rosetta()
+    Dim s As Collection, i As Long
+    Set s = hailstone(27)
+    Dim ls As Integer: ls = s.count
+    Debug.Print "hailstone(27) = ";
+    For i = 1 To 4
+        Debug.Print s(i); ", ";
+    Next i
+    Debug.Print "... ";
+    For i = s.count - 4 To s.count - 1
+        Debug.Print s(i); ", ";
+    Next i
+    Debug.Print s(s.count)
+    Debug.Print "length ="; ls
+    Dim hmax As Long: hmax = 1
+    Dim imax As Long: imax = 1
+    Dim count As Integer
+    For i = 2 To 100000# - 1
+        count = hailstone_count(i)
+        If count > hmax Then
+            hmax = count
+            imax = i
+        End If
+    Next i
+    Debug.Print "The longest hailstone sequence under 100,000 is"; imax; "with"; hmax; "elements."
+End Sub