Hailstone sequence
From Rosetta Code
You are encouraged to solve this task according to the task description, using any language you may know.
The Hailstone sequence of numbers can be generated from a starting positive integer, n by:
- If n is 1 then the sequence ends.
- If n is even then the next n of the sequence
= n/2 - If n is odd then the next n of the sequence
= (3 * n) + 1
The (unproven), Collatz conjecture is that the hailstone sequence for any starting number always terminates.
Task Description:
- Create a routine to generate the hailstone sequence for a number.
- Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with
27, 82, 41, 124and ending with8, 4, 2, 1 - Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.
(But don't show the actual sequence!)
See Also:
- xkcd (humourous).
[edit] ACL2
(defun hailstone (len)
(loop for x = len
then (if (evenp x)
(/ x 2)
(+ 1 (* 3 x)))
collect x until (= x 1)))
;; Must be tail recursive
(defun max-hailstone-start (limit mx curr)
(declare (xargs :mode :program))
(if (zp limit)
(mv mx curr)
(let ((new-mx (len (hailstone limit))))
(if (> new-mx mx)
(max-hailstone-start (1- limit) new-mx limit)
(max-hailstone-start (1- limit) mx curr)))))
Output:
> (take 4 (hailstone 27)) (27 82 41 124) > (nthcdr 108 (hailstone 27)) (8 4 2 1) > (len (hailstone 27)) 112 > (max-hailstone-start 100000 0 0) (351 77031)
[edit] Ada
Similar to C method:
with Ada.Text_IO; use Ada.Text_IO;
procedure hailstone is
type int_arr is array(Positive range <>) of Integer;
type int_arr_pt is access all int_arr;
function hailstones(num:Integer; pt:int_arr_pt) return Integer is
stones : Integer := 1;
n : Integer := num;
begin
if pt /= null then pt(1) := num; end if;
while (n/=1) loop
stones := stones + 1;
if n mod 2 = 0 then n := n/2;
else n := (3*n)+1;
end if;
if pt /= null then pt(stones) := n; end if;
end loop;
return stones;
end hailstones;
nmax,stonemax,stones : Integer := 0;
list : int_arr_pt;
begin
stones := hailstones(27,null);
list := new int_arr(1..stones);
stones := hailstones(27,list);
put(" 27: "&Integer'Image(stones)); new_line;
for n in 1..4 loop put(Integer'Image(list(n))); end loop;
put(" .... ");
for n in stones-3..stones loop put(Integer'Image(list(n))); end loop;
new_line;
for n in 1..100000 loop
stones := hailstones(n,null);
if stones>stonemax then
nmax := n; stonemax := stones;
end if;
end loop;
put_line(Integer'Image(nmax)&" max @ n= "&Integer'Image(stonemax));
end hailstone;
Output:
27: 112 27 82 41 124 .... 8 4 2 1 77031 max @ n= 351
[edit] Alternative method
A method without pointers or dynamic memory allocation, but slower for simply counting. This is also used for the "executable library" task Executable library#Ada.
hailstones.ads:
package Hailstones is
type Integer_Sequence is array(Positive range <>) of Integer;
function Create_Sequence (N : Positive) return Integer_Sequence;
end Hailstones;
hailstones.adb:
package body Hailstones is
function Create_Sequence (N : Positive) return Integer_Sequence is
begin
if N = 1 then
-- terminate
return (1 => N);
elsif N mod 2 = 0 then
-- even
return (1 => N) & Create_Sequence (N / 2);
else
-- odd
return (1 => N) & Create_Sequence (3 * N + 1);
end if;
end Create_Sequence;
end Hailstones;
example main.adb:
with Ada.Text_IO;
with Hailstones;
procedure Main is
package Integer_IO is new Ada.Text_IO.Integer_IO (Integer);
procedure Print_Sequence (X : Hailstones.Integer_Sequence) is
begin
for I in X'Range loop
Integer_IO.Put (Item => X (I), Width => 0);
if I < X'Last then
Ada.Text_IO.Put (", ");
end if;
end loop;
Ada.Text_IO.New_Line;
end Print_Sequence;
Hailstone_27 : constant Hailstones.Integer_Sequence :=
Hailstones.Create_Sequence (N => 27);
begin
Ada.Text_IO.Put_Line ("Length of 27:" & Integer'Image (Hailstone_27'Length));
Ada.Text_IO.Put ("First four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'First .. Hailstone_27'First + 3));
Ada.Text_IO.Put ("Last four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'Last - 3 .. Hailstone_27'Last));
declare
Longest_Length : Natural := 0;
Longest_N : Positive;
Length : Natural;
begin
for I in 1 .. 99_999 loop
Length := Hailstones.Create_Sequence (N => I)'Length;
if Length > Longest_Length then
Longest_Length := Length;
Longest_N := I;
end if;
end loop;
Ada.Text_IO.Put_Line ("Longest length is" & Integer'Image (Longest_Length));
Ada.Text_IO.Put_Line ("with N =" & Integer'Image (Longest_N));
end;
end Main;
output:
Length of 27: 112 First four: 27, 82, 41, 124 Last four: 8, 4, 2, 1 Longest length is 351 with N = 77031
[edit] ALGOL 68
- note: This specimen retains the original C coding style.MODE LINT = # LONG ... # INT;
PROC hailstone = (INT in n, REF[]LINT array)INT:
(
INT hs := 1;
INT index := 0;
LINT n := in n;
WHILE n /= 1 DO
hs +:= 1;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
n := IF ODD n THEN 3*n+1 ELSE n OVER 2 FI
OD;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
hs
);
main:
(
INT j, hmax := 0;
INT jatmax, n;
INT border = 4;
FOR j TO 100000-1 DO
n := hailstone(j, NIL);
IF hmax < n THEN
hmax := n;
jatmax := j
FI
OD;
[2]INT test := (27, jatmax);
FOR key TO UPB test DO
INT val = test[key];
n := hailstone(val, NIL);
[n]LINT array;
n := hailstone(val, array);
printf(($"[ "n(border)(g(0)", ")" ..."n(border)(", "g(0))"] len="g(0)l$,
array[:border], array[n-border+1:], n))
#;free(array) #
OD;
printf(($"Max "g(0)" at j="g(0)l$, hmax, jatmax))
# ELLA Algol68RS:
print(("Max",hmax," at j=",jatmax, new line))
#
)
Output:
[ 27, 82, 41, 124, ..., 8, 4, 2, 1] len=112 [ 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1] len=351 Max 351 at j=77031
[edit] APL
seq←hailstone n;next
⍝ Returns the hailstone sequence for a given number
seq←n ⍝ Init the sequence
:While n≠1
next←(n÷2) (1+3×n) ⍝ Compute both possibilities
n←next[1+2|n] ⍝ Pick the appropriate next step
seq,←n ⍝ Append that to the sequence
:EndWhile
Output:
5↑hailstone 27
27 82 41 124 62
¯5↑hailstone 27
16 8 4 2 1
⍴hailstone 27
112
1↑{⍵[⍒↑(⍴∘hailstone)¨⍵]}⍳100000
77031
[edit] AutoHotkey
; Submitted by MasterFocus --- http://tiny.cc/iTunis
; [1] Generate the Hailstone Seq. for a number
List := varNum := 7 ; starting number is 7, not counting elements
While ( varNum > 1 )
List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % List
; [2] Seq. for starting number 27 has 112 elements
Count := 1, List := varNum := 27 ; starting number is 27, counting elements
While ( varNum > 1 )
Count++ , List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % "Sequence:`n" List "`n`nCount: " Count
; [3] Find number<100000 with longest seq. and show both values
MaxNum := Max := 0 ; reset the Maximum variables
TimesToLoop := 100000 ; limit number here is 100000
Offset := 70000 ; offset - use 0 to process from 0 to 100000
Loop, %TimesToLoop%
{
If ( TimesToLoop < ( varNum := Index := A_Index+Offset ) )
Break
text := "Processing...`n-------------------`n"
text .= "Current starting number: " Index "`n"
text .= "Current sequence count: " Count
text .= "`n-------------------`n"
text .= "Maximum starting number: " MaxNum "`n"
text .= "Maximum sequence count: " Max " <<" ; text split to avoid long code lines
ToolTip, %text%
Count := 1 ; going to count the elements, but no "List" required
While ( varNum > 1 )
Count++ , varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 )
If ( Count > Max )
Max := Count , MaxNum := Index ; set the new maximum values, if necessary
}
ToolTip
MsgBox % "Number: " MaxNum "`nCount: " Max
[edit] AutoIt
$Hail = Hailstone(27)
ConsoleWrite("Sequence-Lenght: "&$Hail&@CRLF)
$Big = -1
$Sequenzlenght = -1
For $I = 1 To 100000
$Hail = Hailstone($i, False)
If Number($Hail) > $Sequenzlenght Then
$Sequenzlenght = Number($Hail)
$Big = $i
EndIf
Next
ConsoleWrite("Longest Sequence : "&$Sequenzlenght&" from number "&$Big&@CRLF)
Func Hailstone($int, $sequence = True)
$Counter = 0
While True
$Counter += 1
If $sequence = True Then ConsoleWrite($int & ",")
If $int = 1 Then ExitLoop
If Not Mod($int, 2) Then
$int = $int / 2
Else
$int = 3 * $int + 1
EndIf
If Not Mod($Counter, 25) AND $sequence = True Then ConsoleWrite(@CRLF)
WEnd
If $sequence = True Then ConsoleWrite(@CRLF)
Return $Counter
EndFunc ;==>Hailstone
Output:
27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,91,274,137,412,206,103, 310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132, 566,283,850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051, 6154,3077,9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,106, 53,160,80,40,20,10,5,16,8,4,2,1, Sequence-Lenght: 112 Longest Sequence : 351 from number 77031
[edit] AWK
#!/usr/bin/awk -f
function hailstone(v, verbose) {
n = 1;
u = v;
while (1) {
if (verbose) printf " "u;
if (u==1) return(n);
n++;
if (u%2 > 0 )
u = 3*u+1;
else
u = u/2;
}
}
BEGIN {
i = 27;
printf("hailstone(%i) has %i elements\n",i,hailstone(i,1));
ix=0;
m=0;
for (i=1; i<100000; i++) {
n = hailstone(i,0);
if (m<n) {
m=n;
ix=i;
}
}
printf("longest hailstone sequence is %i and has %i elements\n",ix,m);
}
Output:
27 82 41 124 ....... 8 4 2 1 hailstone(27) has 112 elements longest hailstone sequence is 77031 and has 351 elements
[edit] Batch File
1. Create a routine to generate the hailstone sequence for a number.
@echo off
setlocal enabledelayedexpansion
if "%1" equ "" goto :eof
call :hailstone %1 seq cnt
echo %seq%
goto :eof
:hailstone
set num=%1
set %2=%1
:loop
if %num% equ 1 goto :eof
call :iseven %num% res
if %res% equ T goto divideby2
set /a num = (3 * num) + 1
set %2=!%2! %num%
goto loop
:divideby2
set /a num = num / 2
set %2=!%2! %num%
goto loop
:iseven
set /a tmp = %1 %% 2
if %tmp% equ 1 (
set %2=F
) else (
set %2=T
)
goto :eof
Demonstration
>hailstone.cmd 20
20 10 5 16 8 4 2 1
[edit] BBC BASIC
seqlen% = FNhailstone(27, TRUE)
PRINT '"Sequence length = "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%, FALSE)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END
DEF FNhailstone(N%, S%)
LOCAL L%
IF S% THEN PRINT N%;
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
IF S% THEN PRINT N%;
L% += 1
ENDWHILE
= L% + 1
Output:
27 82 41 124 62 31 94 47
142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206
103 310 155 466 233 700 350 175
526 263 790 395 1186 593 1780 890
445 1336 668 334 167 502 251 754
377 1132 566 283 850 425 1276 638
319 958 479 1438 719 2158 1079 3238
1619 4858 2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232 4616 2308
1154 577 1732 866 433 1300 650 325
976 488 244 122 61 184 92 46
23 70 35 106 53 160 80 40
20 10 5 16 8 4 2 1
Sequence length = 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351
[edit] Befunge
&>:.:1-|
>3*^ @
|%2: <
v>2/>+
[edit] Bracmat
(
( hailstone
= L len
. !arg:?L
& whl
' ( !arg:~1
& (!arg*1/2:~/|3*!arg+1):?arg
& !arg !L:?L
)
& (!L:? [?len&!len.!L)
)
& ( reverse
= L e
. :?L
& whl'(!arg:%?e ?arg&!e !L:?L)
& !L
)
& hailstone$27:(?len.?list)
& reverse$!list:?first4 [4 ? [-5 ?last4
& put$"Hailstone sequence starting with "
& put$!first4
& put$(str$(" has " !len " elements and ends with "))
& put$(!last4 \n)
& 1:?N
& 0:?max:?Nmax
& whl
' ( !N+1:<100000:?N
& hailstone$!N
: ( >!max:?max&!N:?Nmax
| ?
. ?
)
)
& out
$ ( str
$ ( "The number <100000 with the longest hailstone sequence is "
!Nmax
" with "
!max
" elements."
)
)
);
[edit] Brainf***
Prints the number of terms required to map the input to 1. Does not count the first term of the sequence.
>,[
[
----------[
>>>[>>>>]+[[-]+<[->>>>++>>>>+[>>>>]++[->+<<<<<]]<<<]
++++++[>------<-]>--[>>[->>>>]+>+[<<<<]>-],<
]>
]>>>++>+>>[
<<[>>>>[-]+++++++++<[>-<-]+++++++++>[-[<->-]+[<<<<]]<[>+<-]>]
>[>[>>>>]+[[-]<[+[->>>>]>+<]>[<+>[<<<<]]+<<<<]>>>[->>>>]+>+[<<<<]]
>[[>+>>[<<<<+>>>>-]>]<<<<[-]>[-<<<<]]>>>>>>>
]>>+[[-]++++++>>>>]<<<<[[<++++++++>-]<.[-]<[-]<[-]<]<,
]
27
111
[edit] Brat
hailstone = { num |
sequence = [num]
while { num != 1 }
{ true? num % 2 == 0
{ num = num / 2 }
{ num = num * 3 + 1 }
sequence << num
}
sequence
}
#Check sequence for 27
seq = hailstone 27
true? (seq[0,3] == [27 82 41 124] && seq[-1, -4] == [8 4 2 1])
{ p "Sequence for 27 is correct" }
{ p "Sequence for 27 is not correct!" }
#Find longest sequence for numbers < 100,000
longest = [number: 0 length: 0]
1.to 99999 { index |
seq = hailstone index
true? seq.length > longest[:length]
{ longest[:length] = seq.length
longest[:number] = index
p "Longest so far: #{index} @ #{longest[:length]} elements"
}
index = index + 1
}
p "Longest was starting from #{longest[:number]} and was of length #{longest[:length]}"
Output:
Sequence for 27 is correct Longest so far: 1 @ 1 elements Longest so far: 2 @ 2 elements Longest so far: 3 @ 8 elements ... Longest so far: 52527 @ 340 elements Longest so far: 77031 @ 351 elements Longest was starting from 77031 and was of length 351
[edit] Burlesque
blsq ) 27{^^^^2.%{3.*1.+}\/{2./}\/ie}{1!=}w!bx{\/+]}{\/isn!}w!L[
112
[edit] C
#include <stdio.h>
#include <stdlib.h>
int hailstone(int n, int *arry)
{
int hs = 1;
while (n!=1) {
hs++;
if (arry) *arry++ = n;
n = (n&1) ? (3*n+1) : (n/2);
}
if (arry) *arry++ = n;
return hs;
}
int main()
{
int j, hmax = 0;
int jatmax, n;
int *arry;
for (j=1; j<100000; j++) {
n = hailstone(j, NULL);
if (hmax < n) {
hmax = n;
jatmax = j;
}
}
n = hailstone(27, NULL);
arry = malloc(n*sizeof(int));
n = hailstone(27, arry);
printf("[ %d, %d, %d, %d, ...., %d, %d, %d, %d] len=%d\n",
arry[0],arry[1],arry[2],arry[3],
arry[n-4], arry[n-3], arry[n-2], arry[n-1], n);
printf("Max %d at j= %d\n", hmax, jatmax);
free(arry);
return 0;
}
Output
[ 27, 82, 41, 124, ...., 8, 4, 2, 1] len= 112 Max 351 at j= 77031
[edit] With caching
Much faster if you want to go over a million or so.
#include <stdio.h>
#define N 10000000
#define CS N /* cache size */
typedef unsigned long ulong;
ulong cache[CS] = {0};
ulong hailstone(ulong n)
{
int x;
if (n == 1) return 1;
if (n < CS && cache[n]) return cache[n];
x = 1 + hailstone((n & 1) ? 3 * n + 1 : n / 2);
if (n < CS) cache[n] = x;
return x;
}
int main()
{
int i, l, max = 0, mi;
for (i = 1; i < N; i++) {
if ((l = hailstone(i)) > max) {
max = l;
mi = i;
}
}
printf("max below %d: %d, length %d\n", N, mi, max);
return 0;
}
[edit] C#
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
namespace Hailstone
{
class Program
{
public static List<int> hs(int n,List<int> seq)
{
List<int> sequence = seq;
sequence.Add(n);
if (n == 1)
{
return sequence;
}else{
int newn = (n % 2 == 0) ? n / 2 : (3 * n) + 1;
return hs(newn, sequence);
}
}
static void Main(string[] args)
{
int n = 27;
List<int> sequence = hs(n,new List<int>());
Console.WriteLine(sequence.Count + " Elements");
List<int> start = sequence.GetRange(0, 4);
List<int> end = sequence.GetRange(sequence.Count - 4, 4);
Console.WriteLine("Starting with : " + string.Join(",", start) + " and ending with : " + string.Join(",", end));
int number = 0, longest = 0;
for (int i = 1; i < 100000; i++)
{
int count = (hs(i, new List<int>())).Count;
if (count > longest)
{
longest = count;
number = i;
}
}
Console.WriteLine("Number < 100000 with longest Hailstone seq.: " + number + " with length of " + longest);
}
}
}
112 Elements Starting with : 27,82,41,124 and ending with : 8,4,2,1 Number < 100000 with longest Hailstone seq.: 77031 with length of 351
[edit] With caching
As with the C example, much faster if you want to go over a million or so.
using System;
using System.Collections.Generic;
namespace ConsoleApplication1
{
class Program
{
public static void Main()
{
int longestChain = 0, longestNumber = 0;
var recursiveLengths = new Dictionary<int, int>();
const int maxNumber = 100000;
for (var i = 1; i <= maxNumber; i++)
{
var chainLength = Hailstone(i, recursiveLengths);
if (longestChain >= chainLength)
continue;
longestChain = chainLength;
longestNumber = i;
}
Console.WriteLine("max below {0}: {1} ({2} steps)", maxNumber, longestNumber, longestChain);
}
private static int Hailstone(int num, Dictionary<int, int> lengths)
{
if (num == 1)
return 1;
while (true)
{
if (lengths.ContainsKey(num))
return lengths[num];
lengths[num] = 1 + ((num%2 == 0) ? Hailstone(num/2, lengths) : Hailstone((3*num) + 1, lengths));
}
}
}
}
max below 100000: 77031 (351 steps)
[edit] C++
#include <iostream>
#include <vector>
#include <utility>
std::vector<int> hailstone(int i)
{
std::vector<int> v;
while(true){
v.push_back(i);
if (1 == i) break;
i = (i % 2) ? (3 * i + 1) : (i / 2);
}
return v;
}
std::pair<int,int> find_longest_hailstone_seq(int n)
{
std::pair<int, int> maxseq(0, 0);
int l;
for(int i = 1; i < n; ++i){
l = hailstone(i).size();
if (l > maxseq.second) maxseq = std::make_pair(i, l);
}
return maxseq;
}
int main () {
// Use the routine to show that the hailstone sequence for the number 27
std::vector<int> h27;
h27 = hailstone(27);
// has 112 elements
int l = h27.size();
std::cout << "length of hailstone(27) is " << l;
// starting with 27, 82, 41, 124 and
std::cout << " first four elements of hailstone(27) are ";
std::cout << h27[0] << " " << h27[1] << " "
<< h27[2] << " " << h27[3] << std::endl;
// ending with 8, 4, 2, 1
std::cout << " last four elements of hailstone(27) are "
<< h27[l-4] << " " << h27[l-3] << " "
<< h27[l-2] << " " << h27[l-1] << std::endl;
std::pair<int,int> m = find_longest_hailstone_seq(100000);
std::cout << "the longest hailstone sequence under 100,000 is " << m.first
<< " with " << m.second << " elements." <<std::endl;
return 0;
}
output:
length of hailstone(27) is 112 first four elements of hailstone(27) are 27 82 41 124 last four elements of hailstone(27) are 8 4 2 1 the longest hailstone sequence under 100,000 is 77031 with 351 elements.
[edit] CLIPS
(deftemplate longest
(slot bound) ; upper bound for the range of values to check
(slot next (default 2)) ; next value that needs to be checked
(slot start (default 1)) ; starting value of longest sequence
(slot len (default 1)) ; length of longest sequence
)
(deffacts startup
(query 27)
(longest (bound 100000))
)
(deffunction hailstone-next
(?n)
(if (evenp ?n)
then (div ?n 2)
else (+ (* 3 ?n) 1)
)
)
(defrule extend-sequence
?hail <- (hailstone $?sequence ?tail&:(> ?tail 1))
=>
(retract ?hail)
(assert (hailstone ?sequence ?tail (hailstone-next ?tail)))
)
(defrule start-query
(query ?num)
=>
(assert (hailstone ?num))
)
(defrule result-query
(query ?num)
(hailstone ?num $?sequence 1)
=>
(bind ?sequence (create$ ?num ?sequence 1))
(printout t "Hailstone sequence starting with " ?num ":" crlf)
(bind ?len (length ?sequence))
(printout t " Length: " ?len crlf)
(printout t " First four: " (implode$ (subseq$ ?sequence 1 4)) crlf)
(printout t " Last four: " (implode$ (subseq$ ?sequence (- ?len 3) ?len)) crlf)
(printout t crlf)
)
(defrule longest-create-next-hailstone
(longest (bound ?bound) (next ?next))
(test (<= ?next ?bound))
(not (hailstone ?next $?))
=>
(assert (hailstone ?next))
)
(defrule longest-check-next-hailstone
?longest <- (longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (<= ?next ?bound))
?hailstone <- (hailstone ?next $?sequence 1)
=>
(retract ?hailstone)
(bind ?thislen (+ 2 (length ?sequence)))
(if (> ?thislen ?len) then
(modify ?longest (start ?next) (len ?thislen) (next (+ ?next 1)))
else
(modify ?longest (next (+ ?next 1)))
)
)
(defrule longest-finished
(longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (> ?next ?bound))
=>
(printout t "The number less than " ?bound " that has the largest hailstone" crlf)
(printout t "sequence is " ?start " with a length of " ?len "." crlf)
(printout t crlf)
)
Output:
The number less than 100000 that has the largest hailstone sequence is 77031 with a length of 351. Hailstone sequence starting with 27: Length: 112 First four: 27 82 41 124 Last four: 8 4 2 1
[edit] Clojure
(defn hailstone-seq [n]
(:pre [(pos? n)])
(lazy-seq
(cond (= n 1) '(1)
(even? n) (cons n (hailstone-seq (/ n 2)))
:else (cons n (hailstone-seq (+ (* n 3) 1))))))
(def hseq27 (hailstone-seq 27))
(assert (= (count hseq27) 112))
(assert (= (take 4 hseq27) [27 82 41 124]))
(assert (= (drop 108 hseq27) [8 4 2 1]))
(let [{max-i :num, max-len :len}
(reduce #(max-key :len %1 %2)
(for [i (range 1 100000)]
{:num i, :len (count (hailstone-seq i))}))]
(println "Maximum length" max-len "was found for hailstone(" max-i ")."))
[edit] CoffeeScript
Recursive version:
hailstone = (n) ->
if n is 1
[n]
else if n % 2 is 0
[n].concat hailstone n/2
else
[n].concat hailstone (3*n) + 1
h27 = hailstone 27
console.log "hailstone(27) = #{h27[0..3]} ... #{h27[-4..]} (length: #{h27.length})"
maxlength = 0
maxnums = []
for i in [1..100000]
seq = hailstone i
if seq.length is maxlength
maxnums.push i
else if seq.length > maxlength
maxlength = seq.length
maxnums = [i]
console.log "Max length: #{maxlength}; numbers generating sequences of this length: #{maxnums}"
hailstone(27) = 27,82,41,124 ... 8,4,2,1 (length: 112) Max length: 351; numbers generating sequences of this length: 77031
[edit] Common Lisp
(defun hailstone (n)
(cond ((= n 1) '(1))
((evenp n) (cons n (hailstone (/ n 2))))
(t (cons n (hailstone (+ (* 3 n) 1))))))
(defun longest (n)
(let ((k 0) (l 0))
(loop for i from 1 below n do
(let ((len (length (hailstone i))))
(when (> len l) (setq l len k i)))
finally (format t "Longest hailstone sequence under ~A for ~A, having length ~A." n k l))))
Sample session:
ROSETTA> (length (hailstone 27)) 112 ROSETTA> (subseq (hailstone 27) 0 4) (27 82 41 124) ROSETTA> (last (hailstone 27) 4) (8 4 2 1) ROSETTA> (longest-hailstone 100000) Longest hailstone sequence under 100000 for 77031, having length 351. NIL
[edit] D
[edit] Basic Version
import std.stdio, std.algorithm, std.range, std.typecons;
auto hailstone(int n) pure nothrow {
auto result = [n];
while (n != 1) {
n = n & 1 ? n*3 + 1 : n/2;
result ~= n;
}
return result;
}
void main() {
enum M = 27;
auto h = hailstone(M);
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$-4 .. $]);
writeln("length hailstone(", M, ")= ", h.length);
enum N = 100_000;
auto s = iota(1, N).map!(i => tuple(hailstone(i).length, i))();
auto p = reduce!max(s);
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}
- Output:
hailstone(27)= [27, 82, 41, 124] ... [8, 4, 2, 1] length hailstone(27)= 112 Longest sequence in [1,100000]= 77031 with len 351
[edit] Faster Lazy Version
Same output.
import std.stdio, std.algorithm, std.range, std.typecons;
struct Hail {
int n;
bool empty() { return n == 0; }
int front() { return n; }
void popFront() { n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2); }
}
void main() {
enum M = 27;
auto h = array(Hail(M));
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$-4 .. $]);
writeln("length hailstone(", M, ")= ", h.length);
enum N = 100_000;
auto s = map!(i => tuple(walkLength(Hail(i)), i))(iota(1, N));
auto p = reduce!max(s);
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}
[edit] Dart
List<int> hailstone(int n) {
if(n<=0) {
throw new IllegalArgumentException("start value must be >=1)");
}
Queue<int> seq=new Queue<int>();
seq.add(n);
while(n!=1) {
n=n%2==0?(n/2).toInt():3*n+1;
seq.add(n);
}
return new List<int>.from(seq);
}
// apparently List is missing toString()
String iterableToString(Iterable seq) {
String str="[";
Iterator i=seq.iterator();
while(i.hasNext()) {
str+=i.next();
if(i.hasNext()) {
str+=",";
}
}
return str+"]";
}
main() {
for(int i=1;i<=10;i++) {
print("h($i)="+iterableToString(hailstone(i)));
}
List<int> h27=hailstone(27);
List<int> first4=h27.getRange(0,4);
print("first 4 elements of h(27): "+iterableToString(first4));
Expect.listEquals([27,82,41,124],first4);
List<int> last4=h27.getRange(h27.length-4,4);
print("last 4 elements of h(27): "+iterableToString(last4));
Expect.listEquals([8,4,2,1],last4);
print("length of sequence h(27): "+h27.length);
Expect.equals(112,h27.length);
int seq,max=0;
for(int i=1;i<=100000;i++) {
List<int> h=hailstone(i);
if(h.length>max) {
max=h.length;
seq=i;
}
}
print("up to 100000 the sequence h($seq) has the largest length ($max)");
}
Output
h(1)=[1] h(2)=[2,1] h(3)=[3,10,5,16,8,4,2,1] h(4)=[4,2,1] h(5)=[5,16,8,4,2,1] h(6)=[6,3,10,5,16,8,4,2,1] h(7)=[7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1] h(8)=[8,4,2,1] h(9)=[9,28,14,7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1] h(10)=[10,5,16,8,4,2,1] first 4 elements of h(27): [27,82,41,124] last 4 elements of h(27): [8,4,2,1] length of sequence h(27): 112 up to 100000 the sequence h(77031) has the largest length (351)
[edit] Dc
Firstly, this code takes the value from the stack, computes and prints the corresponding Hailstone sequence, and the length of the sequence. The q procedure is for counting the length of the sequence. The e and o procedure is for even and odd number respectively. The x procedure is for overall control.
27
[[--: ]nzpq]sq
[d 2/ p]se
[d 3*1+ p]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx
Output
82 41 124 62 (omitted) 8 4 2 1 --: 112
Then we could wrap the procedure x with a new procedure s, and call it with l which is loops the value of t from 1 to 100000, and cleaning up the stack after each time we finish up with a number. Register L for the length of the longest sequence and T for the corresponding number. Also, procedure q is slightly modified for storing L and T if needed, and all printouts in procedure e and o are muted.
0dsLsT1st
[dsLltsT]sM
[[zdlL<M q]sq
[d 2/]se
[d 3*1+ ]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx]ss
[lt1+dstlsxc lt100000>l]dslx
lTn[:]nlLp
Output (Takes quite some time on a decent machine)
77031:351
[edit] Delphi
program ShowHailstoneSequence;
{$APPTYPE CONSOLE}
uses SysUtils, Generics.Collections;
procedure GetHailstoneSequence(aStartingNumber: Integer; aHailstoneList: TList<Integer>);
var
n: Integer;
begin
aHailstoneList.Clear;
aHailstoneList.Add(aStartingNumber);
n := aStartingNumber;
while n <> 1 do
begin
if Odd(n) then
n := (3 * n) + 1
else
n := n div 2;
aHailstoneList.Add(n);
end;
end;
var
i: Integer;
lList: TList<Integer>;
lMaxSequence: Integer;
lMaxLength: Integer;
begin
lList := TList<Integer>.Create;
try
GetHailstoneSequence(27, lList);
Writeln(Format('27: %d elements', [lList.Count]));
Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]',
[lList[0], lList[1], lList[2], lList[3],
lList[lList.Count - 4], lList[lList.Count - 3], lList[lList.Count - 2], lList[lList.Count - 1]]));
Writeln;
lMaxSequence := 0;
lMaxLength := 0;
for i := 1 to 100000 do
begin
GetHailstoneSequence(i, lList);
if lList.Count > lMaxLength then
begin
lMaxSequence := i;
lMaxLength := lList.Count;
end;
end;
Writeln(Format('Longest sequence under 100,000: %d with %d elements', [lMaxSequence, lMaxLength]));
finally
lList.Free;
end;
Readln;
end.
Output:
27: 112 elements [27 82 41 124 ... 8 4 2 1] Longest sequence under 100,000: 77031 with 351 elements
[edit] Erlang
-module(hailstone).Output:
-import(io).
-export([main/0]).
hailstone(1) -> [1];
hailstone(N) when N band 1 == 1 -> [N|hailstone(N * 3 + 1)];
hailstone(N) when N band 1 == 0 -> [N|hailstone(N div 2)].
max_length(Start, Stop) ->
F = fun (N) -> {length(hailstone(N)), N} end,
Lengths = lists:map(F, lists:seq(Start, Stop)),
lists:max(Lengths).
main() ->
io:format("hailstone(4): ~w~n", [hailstone(4)]),
Seq27 = hailstone(27),
io:format("hailstone(27) length: ~B~n", [length(Seq27)]),
io:format("hailstone(27) first 4: ~w~n",
[lists:sublist(Seq27, 4)]),
io:format("hailstone(27) last 4: ~w~n",
[lists:nthtail(length(Seq27) - 4, Seq27)]),
io:format("finding maximum hailstone(N) length for 1 <= N <= 100000..."),
{Length, N} = max_length(1, 100000),
io:format(" done.~nhailstone(~B) length: ~B~n", [N, Length]).
Eshell V5.8.4 (abort with ^G)
1> c(hailstone).
{ok,hailstone}
2> hailstone:main().
hailstone(4): [4,2,1]
hailstone(27) length: 112
hailstone(27) first 4: [27,82,41,124]
hailstone(27) last 4: [8,4,2,1]
finding maximum hailstone(N) length for 1 <= N <= 100000... done.
hailstone(77031) length: 351
ok
[edit] Euler Math Toolbox
>function hailstone (n) ...
$ v=[n];
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ v=v|n;
$ until n==1;
$ end;
$ return v;
$ endfunction
>hailstone(27), length(%)
[ 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668
334 167 502 251 754 377 1132 566 283 850 425 1276 638 319
958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644
1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154
577 1732 866 433 1300 650 325 976 488 244 122 61 184 92
46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 ]
112
>function hailstonelength (n) ...
$ v=zeros(1,n);
$ v[1]=4; v[2]=2;
$ loop 3 to n;
$ count=1;
$ n=#;
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ if n<=cols(v) and v[n] then
$ v[#]=v[n]+count;
$ break;
$ endif;
$ count=count+1;
$ end;
$ end;
$ return v;
$ endfunction
>h=hailstonelength(100000);
>ex=extrema(h); ex[3], ex[4]
351
77031
[edit] Euphoria
function hailstone(atom n)
sequence s
s = {n}
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
s &= n
end while
return s
end function
function hailstone_count(atom n)
integer count
count = 1
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
count += 1
end while
return count
end function
sequence s
s = hailstone(27)
puts(1,"hailstone(27) =\n")
? s
printf(1,"len = %d\n\n",length(s))
integer max,imax,count
max = 0
for i = 2 to 1e5-1 do
count = hailstone_count(i)
if count > max then
max = count
imax = i
end if
end for
printf(1,"The longest hailstone sequence under 100,000 is %d with %d elements.\n",
{imax,max})
Output:
hailstone(27) =
{27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,
91,274,137,412,206,103,310,155,466,233,700,350,175,526,263,790,395,
1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,566,283,
850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,
7288,3644,1822,911,2734,1367,4102,2051,6154,3077,9232,4616,2308,1154,
577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,
106,53,160,80,40,20,10,5,16,8,4,2,1}
len = 112
The longest hailstone sequence under 100,000 is 77031 with 351 elements.
[edit] Excel
In cell A1, place the starting number. In cell A2 enter this formula =IF(A1/2=ROUND(A1/2,0),A1/2,A1*3+1) Drag and copy the formula down until 4, 2, 1
[edit] Factor
! rosetta/hailstone/hailstone.factorOutput:
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone
: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;
<PRIVATE
: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print
! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>
MAIN: main
$ ./factor -run=rosetta.hailstone Loading resource:work/rosetta/hailstone/hailstone.factor The hailstone sequence from 27: has length 112 starts with 27, 82, 41, 124 ends with 8, 4, 2, 1 The hailstone sequence from 77031 has length 351.
[edit] FALSE
[$1&$[%3*1+0~]?~[2/]?]n:
[[$." "$1>][n;!]#%]s:
[1\[$1>][\1+\n;!]#%]c:
27s;! 27c;!."
"
0m:0f:
1[$100000\>][$c;!$m;>[m:$f:0]?%1+]#%
f;." has hailstone sequence length "m;.
[edit] Forth
: hail-next ( n -- n )
dup 1 and if 3 * 1+ else 2/ then ;
: .hail ( n -- )
begin dup . dup 1 > while hail-next repeat drop ;
: hail-len ( n -- n )
1 begin over 1 > while swap hail-next swap 1+ repeat nip ;
27 hail-len . cr
27 .hail cr
: longest-hail ( max -- )
0 0 rot 1+ 1 do ( n length )
i hail-len 2dup < if
nip nip i swap
else drop then
loop
swap . ." has hailstone sequence length " . ;
100000 longest-hail
[edit] Fortran
program Hailstone
implicit none
integer :: i, maxn
integer :: maxseqlen = 0, seqlen
integer, allocatable :: seq(:)
call hs(27, seqlen)
allocate(seq(seqlen))
call hs(27, seqlen, seq)
write(*,"(a,i0,a)") "Hailstone sequence for 27 has ", seqlen, " elements"
write(*,"(a,4(i0,a),3(i0,a),i0)") "Sequence = ", seq(1), ", ", seq(2), ", ", seq(3), ", ", seq(4), " ...., ", &
seq(seqlen-3), ", ", seq(seqlen-2), ", ", seq(seqlen-1), ", ", seq(seqlen)
do i = 1, 99999
call hs(i, seqlen)
if (seqlen > maxseqlen) then
maxseqlen = seqlen
maxn = i
end if
end do
write(*,*)
write(*,"(a,i0,a,i0,a)") "Longest sequence under 100000 is for ", maxn, " with ", maxseqlen, " elements"
deallocate(seq)
contains
subroutine hs(number, length, seqArray)
integer, intent(in) :: number
integer, intent(out) :: length
integer, optional, intent(inout) :: seqArray(:)
integer :: n
n = number
length = 1
if(present(seqArray)) seqArray(1) = n
do while(n /= 1)
if(mod(n,2) == 0) then
n = n / 2
else
n = n * 3 + 1
end if
length = length + 1
if(present(seqArray)) seqArray(length) = n
end do
end subroutine
end program
Output:
Hailstone sequence for 27 has 112 elements Sequence = 27, 82, 41, 124, ...., 8, 4, 2, 1 Longest sequence under 100000 is for 77031 with 351 elements
[edit] Frege
module Hailstone where
import Data.List (maximumBy)
hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)
withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)
main _ = do
let h27 = hailstone 27
printStrLn $ show $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
printStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
printStrLn $ show $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) (1..100000)
- Output:
112 hailstone 27: [27, 82, 41, 124] ... [8, 4, 2, 1] (351, 77031) runtime 4.374 wallclock seconds.
[edit] F#
let rec hailstone n = seq {
match n with
| 1 -> yield 1
| n when n % 2 = 0 -> yield n; yield! hailstone (n / 2)
| n -> yield n; yield! hailstone (n * 3 + 1)
}
let hailstone27 = hailstone 27 |> Array.ofSeq
assert (Array.length hailstone27 = 112)
assert (hailstone27.[..3] = [|27;82;41;124|])
assert (hailstone27.[108..] = [|8;4;2;1|])
let maxLen, maxI = Seq.max <| seq { for i in 1..99999 -> Seq.length (hailstone i), i}
printfn "Maximum length %d was found for hailstone(%d)" maxLen maxI
Output:
Maximum length 351 was found for hailstone(77031)
[edit] GAP
CollatzSequence := function(n)
local v;
v := [ n ];
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
Add(v, n);
od;
return v;
end;
CollatzLength := function(n)
local m;
m := 1;
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
m := m + 1;
od;
return m;
end;
CollatzMax := function(a, b)
local n, len, nmax, lmax;
lmax := 0;
for n in [a .. b] do
len := CollatzLength(n);
if len > lmax then
nmax := n;
lmax := len;
fi;
od;
return [ nmax, lmax ];
end;
CollatzSequence(27);
# [ 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206,
# 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502,
# 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429,
# 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300,
# 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1 ]
CollatzLength(27);
# 112
CollatzMax(1, 100);
# [ 97, 119 ]
CollatzMax(1, 1000);
# [ 871, 179 ]
CollatzMax(1, 10000);
# [ 6171, 262 ]
CollatzMax(1, 100000);
# [ 77031, 351 ]
CollatzMax(1, 1000000);
# [ 837799, 525 ]
[edit] Go
package main
import "fmt"
func hs(n int, seq *[]int) {
s := append((*seq)[:0], n)
for n > 1 {
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
s = append(s, n)
}
*seq = s
}
func main() {
var seq []int
hs(27, &seq)
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
len(seq), seq[0], seq[1], seq[2], seq[3],
seq[len(seq)-4], seq[len(seq)-3], seq[len(seq)-2], seq[len(seq)-1])
var maxN, maxLen int
for n := 1; n < 100000; n++ {
// reusing seq reduces garbage
hs(n, &seq)
if len(seq) > maxLen {
maxN = n
maxLen = len(seq)
}
}
fmt.Printf("hs(%d): %d elements\n", maxN, maxLen)
}
Output:
hs(27): 112 elements: [27 82 41 124 ... 8 4 2 1] hs(77031): 351 elements
Alternate solution (inspired both by recent news of a new proof submitted for publication and by recent chat on #rosettacode about generators.)
This solution interprets the wording of the task differently, and takes the word "generate" to mean use a generator. This has the advantage of not storing the whole sequence in memory at once. Elements are generated one at a time, counted and discarded. A time optimization added for task 3 is to store the sequence lengths computed so far.
Output is the same as version above.
package main
import "fmt"
// Task 1 implemented with a generator. Calling newHg will "create
// a routine to generate the hailstone sequence for a number."
func newHg(n int) func() int {
return func() (n0 int) {
n0 = n
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
return
}
}
func main() {
// make generator for sequence starting at 27
hg := newHg(27)
// save first four elements for printing later
s1, s2, s3, s4 := hg(), hg(), hg(), hg()
// load next four elements in variables to use as shift register.
e4, e3, e2, e1 := hg(), hg(), hg(), hg()
// 4+4= 8 that we've generated so far
ec := 8
// until we get to 1, generate another value, shift, and increment.
// note that intermediate elements--those shifted off--are not saved.
for e1 > 1 {
e4, e3, e2, e1 = e3, e2, e1, hg()
ec++
}
// Complete task 2:
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
ec, s1, s2, s3, s4, e4, e3, e2, e1)
// Task 3: strategy is to not store sequences, but just the length
// of each sequence. as soon as the sequence we're currently working on
// dips into the range that we've already computed, we short-circuit
// to the end by adding the that known length to whatever length
// we've accumulated so far.
var nMaxLen int // variable holds n with max length encounted so far
// slice holds sequence length for each n as it is computed
var computedLen [1e5]int
computedLen[1] = 1
for n := 2; n < 1e5; n++ {
var ele, lSum int
for hg := newHg(n); ; lSum++ {
ele = hg()
// as soon as we get an element in the range we have already
// computed, we're done...
if ele < n {
break
}
}
// just add the sequence length already computed from this point.
lSum += computedLen[ele]
// save the sequence length for this n
computedLen[n] = lSum
// and note if it's the maximum so far
if lSum > computedLen[nMaxLen] {
nMaxLen = n
}
}
fmt.Printf("hs(%d): %d elements\n", nMaxLen, computedLen[nMaxLen])
}
[edit] Groovy
def hailstone = { long start ->
def sequence = []
while (start != 1) {
sequence << start
start = (start % 2l == 0l) ? start / 2l : 3l * start + 1l
}
sequence << start
}
Test Code
def sequence = hailstone(27)
assert sequence.size() == 112
assert sequence[0..3] == [27, 82, 41, 124]
assert sequence[-4..-1] == [8, 4, 2, 1]
def results = (1..100000).collect { [n:it, size:hailstone(it).size()] }.max { it.size }
println results
Output:
[n:77031, size:351]
[edit] Haskell
import Data.List (maximumBy)
import Data.Ord (comparing)
hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)
withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)
main :: IO ()
main = do
let h27 = hailstone 27
print $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
putStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
print $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) [1..100000]
Output:
112 hailstone 27: [27,82,41,124] ... [8,4,2,1] (351,77031)
[edit] HicEst
DIMENSION stones(1000)
H27 = hailstone(27)
ALIAS(stones,1, first4,4)
ALIAS(stones,H27-3, last4,4)
WRITE(ClipBoard, Name) H27, first4, "...", last4
longest_sequence = 0
DO try = 1, 1E5
elements = hailstone(try)
IF(elements >= longest_sequence) THEN
number = try
longest_sequence = elements
WRITE(StatusBar, Name) number, longest_sequence
ENDIF
ENDDO
WRITE(ClipBoard, Name) number, longest_sequence
END
FUNCTION hailstone( n )
USE : stones
stones(1) = n
DO i = 1, LEN(stones)
IF(stones(i) == 1) THEN
hailstone = i
RETURN
ELSEIF( MOD(stones(i),2) ) THEN
stones(i+1) = 3*stones(i) + 1
ELSE
stones(i+1) = stones(i) / 2
ENDIF
ENDDO
END
H27=112; first4(1)=27; first4(2)=82; first4(3)=41; first4(4)=124; ...; last4(1)=8; last4(2)=4; last4(3)=2; last4(4)=1;
number=77031; longest_sequence=351;
[edit] Icon and Unicon
A simple solution that generates (in the Icon sense) the sequence is:
procedure hailstone(n)
while n > 1 do {
suspend n
n := if n%2 = 0 then n/2 else 3*n+1
}
suspend 1
end
and a test program for this solution is:
procedure main(args)
n := integer(!args) | 27
every writes(" ",hailstone(n))
end
but this solution is computationally expensive when run repeatedly (task 3).
The following solution uses caching to improve performance on task 3 at the expense of space.
procedure hailstone(n)
static cache
initial {
cache := table()
cache[1] := [1]
}
/cache[n] := [n] ||| hailstone(if n%2 = 0 then n/2 else 3*n+1)
return cache[n]
end
A test program is:
procedure main(args)
n := integer(!args) | 27
task2(n)
write()
task3()
end
procedure task2(n)
count := 0
every writes(" ",right(!(sequence := hailstone(n)),5)) do
if (count +:= 1) % 15 = 0 then write()
write()
write(*sequence," value",(*sequence=1,"")|"s"," in the sequence.")
end
procedure task3()
maxHS := 0
every n := 1 to 100000 do {
count := *hailstone(n)
if maxHS <:= count then maxN := n
}
write(maxN," has a sequence of ",maxHS," values")
end
A sample run is:
->hs
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484
242 121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051
6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488
244 122 61 184 92 46 23 70 35 106 53 160 80 40 20
10 5 16 8 4 2 1
112 values in the sequence.
77031 has a sequence of 351 values
->
[edit] Io
Here is a simple, brute-force approach:
makeItHail := method(n,
stones := list(n)
while (n != 1,
if(n isEven,
n = n / 2,
n = 3 * n + 1
)
stones append(n)
)
)
out := makeItHail(27)
writeln("For the sequence beginning at 27, the number of elements generated is ", out size, ".")
write("The first four elements generated are ")
for(i, 0, 3,
write(out at(i), " ")
)
writeln(".")
write("The last four elements generated are ")
for(i, out size - 4, out size - 1,
write(out at(i), " ")
)
writeln(".")
numOfElems := 0
nn := 3
for(x, 3, 100000,
out = makeItHail(x)
if(out size > numOfElems,
numOfElems = out size
nn = x
)
)
writeln("For numbers less than or equal to 100,000, ", nn,
" has the longest sequence of ", numOfElems, " elements.")
Output:
For the sequence beginning at 27, the number of elements generated is 112. The first four elements generated are 27 82 41 124 . The last four elements generated are 8 4 2 1 . For numbers less than or equal to 100,000, 77031 has the longest sequence of 351 elements.
[edit] Ioke
collatz = method(n,
n println
unless(n <= 1,
if(n even?, collatz(n / 2), collatz(n * 3 + 1)))
)
[edit] Inform 7
This solution uses a cache to speed up the length calculation for larger numbers.
Home is a room.
To decide which list of numbers is the hailstone sequence for (N - number):
let result be a list of numbers;
add N to result;
while N is not 1:
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
add N to result;
decide on result.
Hailstone length cache relates various numbers to one number.
To decide which number is the hailstone sequence length for (N - number):
let ON be N;
let length so far be 0;
while N is not 1:
if N relates to a number by the hailstone length cache relation:
let result be length so far plus the number to which N relates by the hailstone length cache relation;
now the hailstone length cache relation relates ON to result;
decide on result;
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
increment length so far;
let result be length so far plus 1;
now the hailstone length cache relation relates ON to result;
decide on result.
To say first and last (N - number) entry/entries in (L - list of values of kind K):
let length be the number of entries in L;
if length <= N * 2:
say L;
else:
repeat with M running from 1 to N:
if M > 1, say ", ";
say entry M in L;
say " ... ";
repeat with M running from length - N + 1 to length:
say entry M in L;
if M < length, say ", ".
When play begins:
let H27 be the hailstone sequence for 27;
say "Hailstone sequence for 27 has [number of entries in H27] element[s]: [first and last 4 entries in H27].";
let best length be 0;
let best number be 0;
repeat with N running from 1 to 99999:
let L be the hailstone sequence length for N;
if L > best length:
let best length be L;
let best number be N;
say "The number under 100,000 with the longest hailstone sequence is [best number] with [best length] element[s].";
end the story.
Output:
Hailstone sequence for 27 has 112 elements: 27, 82, 41, 124 ... 8, 4, 2, 1. The number under 100,000 with the longest hailstone sequence is 77031 with 351 elements.
[edit] J
Solution:
hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
Usage:
# hailseq 27 NB. sequence length
112
4 _4 {."0 1 hailseq 27 NB. first & last 4 numbers in sequence
27 82 41 124
8 4 2 1
(>:@(i. >./) , >./) #@hailseq }.i. 1e5 NB. number < 100000 with max seq length & its seq length
77031 351
See also the Collatz Conjecture essay on the J wiki.
[edit] Java
import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;
class Hailstone {
public static List<Long> getHailstoneSequence(long n) {
if (n <= 0)
throw new IllegalArgumentException("Invalid starting sequence number");
List<Long> list = new ArrayList<Long>();
list.add(Long.valueOf(n));
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
list.add(Long.valueOf(n));
}
return list;
}
public static void main(String[] args) {
List<Long> sequence27 = getHailstoneSequence(27);
System.out.println("Sequence for 27 has " + sequence27.size() + " elements: " + sequence27);
long MAX = 100000;
// Simple way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = getHailstoneSequence(i).size();
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 1, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}
// More memory efficient way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = 1;
long n = i;
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
count++;
}
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 2, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}
// Efficient for analyzing all sequences
{
long highestNumber = 1;
long highestCount = 1;
Map<Long, Integer> sequenceMap = new HashMap<Long, Integer>();
sequenceMap.put(Long.valueOf(1), Integer.valueOf(1));
List<Long> currentList = new ArrayList<Long>();
for (long i = 2; i < MAX; i++) {
currentList.clear();
Long n = Long.valueOf(i);
Integer count = null;
while ((count = sequenceMap.get(n)) == null) {
currentList.add(n);
long nValue = n.longValue();
if ((nValue & 1) == 0)
n = Long.valueOf(nValue / 2);
else
n = Long.valueOf(3 * nValue + 1);
}
int curCount = count.intValue();
for (int j = currentList.size() - 1; j >= 0; j--)
sequenceMap.put(currentList.get(j), Integer.valueOf(++curCount));
if (curCount > highestCount) {
highestCount = curCount;
highestNumber = i;
}
}
System.out.println("Method 3, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}
return;
}
}
Output:
Sequence for 27 has 112 elements: [27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1] Method 1, number 77031 has the longest sequence, with a length of 351 Method 2, number 77031 has the longest sequence, with a length of 351 Method 3, number 77031 has the longest sequence, with a length of 351
[edit] JavaScript
function hailstone (n) {
var seq = [n];
while (n > 1) {
n = n % 2 ? 3 * n + 1 : n / 2;
seq.push(n);
}
return seq;
}
// task 2: verify the sequence for n = 27
var h = hailstone(27), hLen = h.length;
print("sequence 27 is (" + h.slice(0, 4).join(", ") + " ... "
+ h.slice(hLen - 4, hLen).join(", ") + "). length: " + hLen);
// task 3: find the longest sequence for n < 100000
for (var n, max = 0, i = 100000; --i;) {
var seq = hailstone(i), sLen = seq.length;
if (sLen > max) {
n = i;
max = sLen;
}
}
print("longest sequence: " + max + " numbers for starting point " + n);
outputs
sequence 27 is (27, 82, 41, 124 ... 8, 4, 2, 1). length: 112 longest sequence: 351 numbers for starting point 77031
[edit] Julia
function hailstone(n)
seq = [n]
while n>1
n = n % 2 == 0 ? n/2 : 3n + 1
push!(seq,n)
end
return seq
end
julia> h = hailstone(27); julia> @assert length(h) == 112 julia> @assert h[1:4] == [27,82,41,124] julia> @assert h[end-3:end] == [8,4,2,1] julia> max([(length(hailstone(i)),i) for i in 1:100000]) (351,77031)
[edit] K
hail: (1<){:[x!2;1+3*x;_ x%2]}\
seqn: hail 27
#seqn
112
4#seqn
27 82 41 124
-4#seqn
8 4 2 1
{m,x@s?m:|/s:{#hail x}'x}{x@&x!2}!:1e5
351 77031
[edit] Liberty BASIC
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""
while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
print ""
print "The following is the 'Hailstone Sequence' for your number..."
print ""
print hailstone
while hailstone <> 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print hailstone
wend
print ""
input "Hit 'Enter' to continue to part 2...";dummy$
cls
print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
print ""
print "No. in Seq.","Hailstone Sequence Number for 27"
print ""
c = 1: hailstone = 27
print c, hailstone
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print c, hailstone
wend
print ""
input "Hit 'Enter' to continue to part 3...";dummy$
cls
print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print ""
print "Calculating result... Please wait... This could take a little while..."
print ""
print "Percent Done", "Start Number", "Seq. Length", "Maximum Sequence So Far"
print ""
for cc = 1 to 99999
hailstone = cc: c = 1
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
wend
if c > max then max = c: largesthailstone = cc
locate 1, 7
print " "
locate 1, 7
print using("###.###", cc / 99999 * 100);"%", cc, c, max
scan
next cc
print ""
print "The number less than 100,000 with the longest 'Hailstone Sequence' is "; largesthailstone;". It's sequence length is "; max;"."
end
[edit] Logo
to hail.next :n
output ifelse equal? 0 modulo :n 2 [:n/2] [3*:n + 1]
end
to hail.seq :n
if :n = 1 [output [1]]
output fput :n hail.seq hail.next :n
end
show hail.seq 27
show count hail.seq 27
to max.hail :n
localmake "max.n 0
localmake "max.length 0
repeat :n [if greater? count hail.seq repcount :max.length [
make "max.n repcount
make "max.length count hail.seq repcount
] ]
(print :max.n [has hailstone sequence length] :max.length)
end
max.hail 100000
[edit] Logtalk
:- object(hailstone).
:- public(generate_sequence/2).
:- mode(generate_sequence(+natural, -list(natural)), zero_or_one).
:- info(generate_sequence/2, [
comment is 'Generates the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Sequence']
]).
:- public(write_sequence/1).
:- mode(write_sequence(+natural), zero_or_one).
:- info(write_sequence/1, [
comment is 'Writes to the standard output the Hailstone sequence that starts with its argument. Fails if the argument is not a natural number.',
argnames is ['Start']
]).
:- public(sequence_length/2).
:- mode(sequence_length(+natural, -natural), zero_or_one).
:- info(sequence_length/2, [
comment is 'Calculates the length of the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Length']
]).
:- public(longest_sequence/4).
:- mode(longest_sequence(+natural, +natural, -natural, -natural), zero_or_one).
:- info(longest_sequence/4, [
comment is 'Calculates the longest Hailstone sequence in the interval [Start, End]. Fails if the interval is not valid.',
argnames is ['Start', 'End', 'N', 'Length']
]).
generate_sequence(Start, Sequence) :-
integer(Start),
Start >= 1,
sequence(Start, Sequence).
sequence(1, [1]) :-
!.
sequence(N, [N| Sequence]) :-
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M, Sequence).
write_sequence(Start) :-
integer(Start),
Start >= 1,
sequence(Start).
sequence(1) :-
!,
write(1), nl.
sequence(N) :-
write(N), write(' '),
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M).
sequence_length(Start, Length) :-
integer(Start),
Start >= 1,
sequence_length(Start, 1, Length).
sequence_length(1, Length, Length) :-
!.
sequence_length(N, Length0, Length) :-
Length1 is Length0 + 1,
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence_length(M, Length1, Length).
longest_sequence(Start, End, N, Length) :-
integer(Start),
integer(End),
Start >= 1,
Start =< End,
longest_sequence(Start, End, 1, N, 1, Length).
longest_sequence(Current, End, N, N, Length, Length) :-
Current > End,
!.
longest_sequence(Current, End, N0, N, Length0, Length) :-
sequence_length(Current, 1, CurrentLength),
Next is Current + 1,
( CurrentLength > Length0 ->
longest_sequence(Next, End, Current, N, CurrentLength, Length)
; longest_sequence(Next, End, N0, N, Length0, Length)
).
:- end_object.
Testing:
| ?- hailstone::write_sequence(27).
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
true
| ?- hailstone::sequence_length(27, Length).
Length = 112
true
| ?- hailstone::longest_sequence(1, 100000, N, Length).
N = 77031, Length = 351
true
[edit] LOLCODE
There is presently no way to query a BUKKIT for the existence of a given key, thus making memoization infeasible. This solution takes advantage of prior knowledge to run in reasonable time.
HAI 1.3
HOW IZ I hailin YR stone
I HAS A sequence ITZ A BUKKIT
sequence HAS A length ITZ 1
sequence HAS A SRS 0 ITZ stone
IM IN YR stoner
BOTH SAEM stone AN 1, O RLY?
YA RLY, FOUND YR sequence
OIC
MOD OF stone AN 2, O RLY?
YA RLY, stone R SUM OF PRODUKT OF stone AN 3 AN 1
NO WAI, stone R QUOSHUNT OF stone AN 2
OIC
sequence HAS A SRS sequence'Z length ITZ stone
sequence'Z length R SUM OF sequence'Z length AN 1
IM OUTTA YR stoner
IF U SAY SO
I HAS A hail27 ITZ I IZ hailin YR 27 MKAY
VISIBLE "hail(27) = "!
IM IN YR first4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE hail27'Z SRS i " "!
IM OUTTA YR first4
VISIBLE "..."!
IM IN YR last4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE " " hail27'Z SRS SUM OF 108 AN i!
IM OUTTA YR last4
VISIBLE ", length = " hail27'Z length
I HAS A max, I HAS A len ITZ 0
BTW, DIS IZ RLY NOT FAST SO WE ONLY CHEK N IN [75000, 80000)
IM IN YR maxer UPPIN YR n TIL BOTH SAEM n AN 5000
I HAS A n ITZ SUM OF n AN 75000
I HAS A seq ITZ I IZ hailin YR n MKAY
BOTH SAEM len AN SMALLR OF len AN seq'Z length, O RLY?
YA RLY, max R n, len R seq'Z length
OIC
IM OUTTA YR maxer
VISIBLE "len(hail(" max ")) = " len
KTHXBYE
- Output:
hail(27) = 27 82 41 124 ... 8 4 2 1, length = 112 len(hail(77031)) = 351
[edit] Lua
function hailstone( n, print_numbers )
local n_iter = 1
while n ~= 1 do
if print_numbers then print( n ) end
if n % 2 == 0 then
n = n / 2
else
n = 3 * n + 1
end
n_iter = n_iter + 1
end
if print_numbers then print( n ) end
return n_iter;
end
hailstone( 27, true )
max_i, max_iter = 0, 0
for i = 1, 100000 do
num = hailstone( i, false )
if num >= max_iter then
max_i = i
max_iter = num
end
end
print( string.format( "Needed %d iterations for the number %d.\n", max_iter, max_i ) )
[edit] Mathematica
Here are three ways to generate the sequence.
[edit] Fixed-Point formulation
HailstoneFP[n_] := Drop[FixedPointList[If[# != 1, Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ], 1] &, n], -1]
[edit] Recursive formulation using piece-wise function definitions
HailstoneR[1] := {1}
HailstoneR[n_Integer] := Prepend[HailstoneR[3 n + 1], n] /; OddQ[n] && n > 0
HailstoneR[n_Integer] := Prepend[HailstoneR[n/2], n] /; EvenQ[n] && n > 0
[edit] Nested function-call formulation
I use this version to do the validation:
Hailstone[n_] :=
NestWhileList[Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ] &, n, # != 1 &];
c27 = Hailstone@27;
Print["Hailstone sequence for n = 27: [", c27[[;; 4]], "...", c27[[-4 ;;]], "]"]
Print["Length Hailstone[27] = ", Length@c27]
longest = -1; comp = 0;
Do[temp = Length@Hailstone@i;
If[comp < temp, comp = temp; longest = i],
{i, 100000}
]
Print["Longest Hailstone sequence at n = ", longest, "\nwith length = ", comp];
Output:
Hailstone sequence for n = 27: [{27,82,41,124}...{8,4,2,1}]
Length Hailstone[27] = 112
Longest Hailstone sequence at n = 77031
with length = 351
I think the fixed-point and the recursive piece-wise function formulations are more idiomatic for Mathematica
[edit] MATLAB / Octave
function x = hailstone(n)
% iterative definition
global VERBOSE;
x = 1;
while (1)
if VERBOSE,
printf('%i ',n); % print element
end;
if n==1,
return;
elseif mod(n,2),
n = 3*n+1;
else
n = n/2;
end;
x = x + 1;
end;
end;
Show sequence of hailstone(27) and number of elements
global VERBOSE;
VERBOSE = 1; % display of sequence elements turned on
N = hailstone(27); %display sequence
printf('\n\n%i\n',N); %
Output:
>> global VERBOSE; VERBOSE=1; hailstone(27) 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 112
global VERBOSE;
VERBOSE = 0; % display of sequence elements turned off
N = 100000;
M = zeros(N,1);
for k=1:N,
M(k) = hailstone(k); %display sequence
end;
[maxLength, n] = max(M)
Output:
maxLength = 351 n = 77031
[edit] Maxima
collatz(n) := block([L], L: [n], while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, L: endcons(n, L)), L)$
collatz_length(n) := block([m], m: 1, while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, m: m + 1), m)$
collatz_max(n) := block([j, m, p], m: 0,
for i from 1 thru n do
(p: collatz_length(i), if p > m then (m: p, j: i)),
[j, m])$
collatz(27); /* [27, 82, 41, ..., 4, 2, 1] */
length(%); /* 112 */
collatz_length(27); /* 112 */
collatz_max(100000); /* [77031, 351] */
[edit] Modula-2
MODULE hailst;
IMPORT InOut;
CONST maxCard = MAX (CARDINAL) DIV 3;
TYPE action = (List, Count, Max);
VAR a : CARDINAL;
PROCEDURE HailStone (start : CARDINAL; type : action) : CARDINAL;
VAR n, max, count : CARDINAL;
BEGIN
count := 1;
n := start;
max := n;
LOOP
IF type = List THEN
InOut.WriteCard (n, 12);
IF count MOD 6 = 0 THEN InOut.WriteLn END
END;
IF n = 1 THEN EXIT END;
IF ODD (n) THEN
IF n < maxCard THEN
n := 3 * n + 1;
IF n > max THEN max := n END
ELSE
InOut.WriteString ("Exceeding max value for type CARDINAL at count = ");
InOut.WriteCard (count, 10);
InOut.WriteString (" for intermediate value ");
InOut.WriteCard (n, 10);
InOut.WriteString (". Aborting.");
HALT
END
ELSE
n := n DIV 2
END;
INC (count)
END;
IF type = Max THEN RETURN max ELSE RETURN count END
END HailStone;
PROCEDURE FindMax (num : CARDINAL);
VAR val, maxCount, maxVal, cnt : CARDINAL;
BEGIN
maxCount := 0;
maxVal := 0;
FOR val := 2 TO num DO
cnt := HailStone (val, Count);
IF cnt > maxCount THEN
maxVal := val;
maxCount := cnt
END
END;
InOut.WriteString ("Longest sequence below "); InOut.WriteCard (num, 1);
InOut.WriteString (" is "); InOut.WriteCard (HailStone (maxVal, Count), 1);
InOut.WriteString (" for n = "); InOut.WriteCard (maxVal, 1);
InOut.WriteString (" with an intermediate maximum of ");
InOut.WriteCard (HailStone (maxVal, Max), 1);
InOut.WriteLn
END FindMax;
BEGIN
a := HailStone (27, List);
InOut.WriteLn;
InOut.WriteString ("Iterations total = "); InOut.WriteCard (HailStone (27, Count), 12);
InOut.WriteString (" max value = "); InOut.WriteCard (HailStone (27, Max) , 12);
InOut.WriteLn;
FindMax (100000);
InOut.WriteString ("Done."); InOut.WriteLn
END hailst.
Producing:
jan@Beryllium:~/modula/rosetta$ hailst
27 82 41 124 62 31
94 47 142 71 214 107
322 161 484 242 121 364
182 91 274 137 412 206
103 310 155 466 233 700
350 175 526 263 790 395
1186 593 1780 890 445 1336
668 334 167 502 251 754
377 1132 566 283 850 425
1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858
2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232
4616 2308 1154 577 1732 866
433 1300 650 325 976 488
244 122 61 184 92 46
23 70 35 106 53 160
80 40 20 10 5 16
8 4 2 1
Iterations total = 112 max value = 9232
Longest sequence below 100000 is 351 for n = 77031 with an intermediate maximum of 21933016
Done.When trying the same for all values below 1 million:Exceeding max value for type CARDINAL at n = 159487 , count = 60 and intermediate value 1699000271. Aborting.
[edit] MUMPS
hailstone(n) ;
If n=1 Quit n
If n#2 Quit n_" "_$$hailstone(3*n+1)
Quit n_" "_$$hailstone(n\2)
Set x=$$hailstone(27) Write !,$Length(x," ")," terms in ",x,!
112 terms in 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
[edit] NetRexx
/* NetRexx */
options replace format comments java crossref savelog symbols binary
do
start = 27
hs = hailstone(start)
hsCount = hs.words
say 'The number' start 'has a hailstone sequence comprising' hsCount 'elements'
say ' its first four elements are:' hs.subword(1, 4)
say ' and last four elements are:' hs.subword(hsCount - 3)
hsMax = 0
hsCountMax = 0
llimit = 100000
loop x_ = 1 to llimit - 1
hs = hailstone(x_)
hsCount = hs.words
if hsCount > hsCountMax then do
hsMax = x_
hsCountMax = hsCount
end
end x_
say 'The number' hsMax 'has the longest hailstone sequence in the range 1 to' llimit - 1 'with a sequence length of' hsCountMax
catch ex = Exception
ex.printStackTrace
end
return
method hailstone(hn = long) public static returns Rexx signals IllegalArgumentException
hs = Rexx('')
if hn <= 0 then signal IllegalArgumentException('Invalid start point. Must be a positive integer greater than 0')
loop label n_ while hn > 1
hs = hs' 'hn
if hn // 2 \= 0 then hn = hn * 3 + 1
else hn = hn % 2
end n_
hs = hs' 'hn
return hs.strip
- Output
The number 27 has a hailstone sequence comprising 112 elements its first four elements are: 27 82 41 124 and last four elements are: 8 4 2 1 The number 77031 has the longest hailstone sequence in the range 1 to 99999 with a sequence length of 351
[edit] Oberon-2
MODULE hailst;
IMPORT Out;
CONST maxCard = MAX (INTEGER) DIV 3;
List = 1;
Count = 2;
Max = 3;
VAR a : INTEGER;
PROCEDURE HailStone (start, type : INTEGER) : INTEGER;
VAR n, max, count : INTEGER;
BEGIN
count := 1;
n := start;
max := n;
LOOP
IF type = List THEN
Out.Int (n, 12);
IF count MOD 6 = 0 THEN Out.Ln END
END;
IF n = 1 THEN EXIT END;
IF ODD (n) THEN
IF n < maxCard THEN
n := 3 * n + 1;
IF n > max THEN max := n END
ELSE
Out.String ("Exceeding max value for type INTEGER at: ");
Out.String (" n = "); Out.Int (start, 12);
Out.String (" , count = "); Out.Int (count, 12);
Out.String (" and intermediate value ");
Out.Int (n, 1);
Out.String (". Aborting.");
Out.Ln;
HALT (2)
END
ELSE
n := n DIV 2
END;
INC (count)
END;
IF type = Max THEN RETURN max ELSE RETURN count END
END HailStone;
PROCEDURE FindMax (num : INTEGER);
VAR val, maxCount, maxVal, cnt : INTEGER;
BEGIN
maxCount := 0;
maxVal := 0;
FOR val := 2 TO num DO
cnt := HailStone (val, Count);
IF cnt > maxCount THEN
maxVal := val;
maxCount := cnt
END
END;
Out.String ("Longest sequence below "); Out.Int (num, 1);
Out.String (" is "); Out.Int (HailStone (maxVal, Count), 1);
Out.String (" for n = "); Out.Int (maxVal, 1);
Out.String (" with an intermediate maximum of ");
Out.Int (HailStone (maxVal, Max), 1);
Out.Ln
END FindMax;
BEGIN
a := HailStone (27, List);
Out.Ln;
Out.String ("Iterations total = "); Out.Int (HailStone (27, Count), 12);
Out.String (" max value = "); Out.Int (HailStone (27, Max) , 12);
Out.Ln;
FindMax (1000000);
Out.String ("Done.");
Out.Ln
END hailst.
Producing
27 82 41 124 62 31
94 47 142 71 214 107
322 161 484 242 121 364
182 91 274 137 412 206
103 310 155 466 233 700
350 175 526 263 790 395
1186 593 1780 890 445 1336
668 334 167 502 251 754
377 1132 566 283 850 425
1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858
2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232
4616 2308 1154 577 1732 866
433 1300 650 325 976 488
244 122 61 184 92 46
23 70 35 106 53 160
80 40 20 10 5 16
8 4 2 1
Iterations total = 112 max value = 9232
Exceeding max value for type INTEGER at: n = 113383 , count = 120 and intermediate value 827370449. Aborting.
[edit] OCaml
#load "nums.cma";;
open Num;;
(* generate Hailstone sequence *)
let hailstone n =
let one = Int 1
and two = Int 2
and three = Int 3 in
let rec g s x =
if x =/ one
then x::s
else g (x::s) (if mod_num x two =/ one
then three */ x +/ one
else x // two)
in
g [] (Int n)
;;
(* compute only sequence length *)
let haillen n =
let one = Int 1
and two = Int 2
and three = Int 3 in
let rec g s x =
if x =/ one
then s+1
else g (s+1) (if mod_num x two =/ one
then three */ x +/ one
else x // two)
in
g 0 (Int n)
;;
(* max length for starting values in 1..n *)
let hailmax =
let rec g idx len = function
| 0 -> (idx, len)
| i ->
let a = haillen i in
if a > len
then g i a (i-1)
else g idx len (i-1)
in
g 0 0
;;
hailmax 100000 ;;
(* - : int * int = (77031, 351) *)
List.rev_map string_of_num (hailstone 27) ;;
(* - : string list =
["27"; "82"; "41"; "124"; "62"; "31"; "94"; "47"; "142"; "71"; "214"; "107";
"322"; "161"; "484"; "242"; "121"; "364"; "182"; "91"; "274"; "137"; "412";
"206"; "103"; "310"; "155"; "466"; "233"; "700"; "350"; "175"; "526"; "263";
"790"; "395"; "1186"; "593"; "1780"; "890"; "445"; "1336"; "668"; "334";
"167"; "502"; "251"; "754"; "377"; "1132"; "566"; "283"; "850"; "425";
"1276"; "638"; "319"; "958"; "479"; "1438"; "719"; "2158"; "1079"; "3238";
"1619"; "4858"; "2429"; "7288"; "3644"; "1822"; "911"; "2734"; "1367";
"4102"; "2051"; "6154"; "3077"; "9232"; "4616"; "2308"; "1154"; "577";
"1732"; "866"; "433"; "1300"; "650"; "325"; "976"; "488"; "244"; "122";
"61"; "184"; "92"; "46"; "23"; "70"; "35"; "106"; "53"; "160"; "80"; "40";
"20"; "10"; "5"; "16"; "8"; "4"; "2"; "1"] *)
[edit] ooRexx
sequence = hailstone(27)
say "Hailstone sequence for 27 has" sequence~items "elements and is ["sequence~toString('l', ", ")"]"
highestNumber = 1
highestCount = 1
loop i = 2 to 100000
sequence = hailstone(i)
count = sequence~items
if count > highestCount then do
highestNumber = i
highestCount = count
end
end
say "Number" highestNumber "has the longest sequence with" highestCount "elements"
-- short routine to generate a hailstone sequence
::routine hailstone
use arg n
sequence = .array~of(n)
loop while n \= 1
if n // 2 == 0 then n = n / 2
else n = 3 * n + 1
sequence~append(n)
end
return sequence
Output:
Hailstone sequence for 27 has 112 elements and is [27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 77, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 102, 051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 0, 40, 20, 10, 5, 16, 8, 4, 2, 1] Number 77031 has the longest sequence with 351 elements
[edit] Order
To display the length, and first and last elements, of the hailstone sequence for 27, we could do this:
#include <order/interpreter.h>
#define ORDER_PP_DEF_8hailstone ORDER_PP_FN( \
8fn(8N, \
8cond((8equal(8N, 1), 8seq(1)) \
(8is_0(8remainder(8N, 2)), \
8seq_push_front(8N, 8hailstone(8quotient(8N, 2)))) \
(8else, \
8seq_push_front(8N, 8hailstone(8inc(8times(8N, 3))))))) )
ORDER_PP(
8lets((8H, 8seq_map(8to_lit, 8hailstone(27)))
(8S, 8seq_size(8H)),
8print(8(h(27) - length:) 8to_lit(8S) 8comma 8space
8(starts with:) 8seq_take(4, 8H) 8comma 8space
8(ends with:) 8seq_drop(8minus(8S, 4), 8H))
) )
- Output:
h(27) - length:112, starts with:(27)(82)(41)(124), ends with:(8)(4)(2)(1)
Unfortunately, the C preprocessor not really being designed with large amounts of garbage collection in mind, trying to compute the hailstone sequences up to 100000 is almost guaranteed to run out of memory (and take a very, very long time). If we wanted to try, we could add this to the program, which in most languages would use relatively little memory:
#define ORDER_PP_DEF_8h_longest ORDER_PP_FN( \
8fn(8M, 8P, \
8if(8is_0(8M), \
8P, \
8let((8L, 8seq_size(8hailstone(8M))), \
8h_longest(8dec(8M), \
8if(8greater(8L, 8tuple_at_1(8P)), \
8pair(8M, 8L), 8P))))) )
ORDER_PP(
8let((8P, 8h_longest(8nat(1,0,0,0,0,0), 8pair(0, 0))),
8pair(8to_lit(8tuple_at_0(8P)), 8to_lit(8tuple_at_1(8P))))
)
...or even this "more elegant" version, which will run out of memory very quickly indeed (but in practice seems to work better for smaller ranges):
ORDER_PP(
8let((8P,
8seq_head(
8seq_sort(8fn(8P, 8Q, 8greater(8tuple_at_1(8P),
8tuple_at_1(8Q))),
8seq_map(8fn(8N,
8pair(8N, 8seq_size(8hailstone(8N)))),
8seq_iota(1, 8nat(1,0,0,0,0,0)))))),
8pair(8to_lit(8tuple_at_0(8P)), 8to_lit(8tuple_at_1(8P)))) )
Notice that large numbers (>100) must be entered as digit sequences with 8nat. 8to_lit converts a digit sequence back to a readable number.
[edit] OxygenBasic
function Hailstone(sys *n)
'=========================
if n and 1
n=n*3+1
else
n=n>>1
end if
end function
function HailstoneSequence(sys n) as sys
'=======================================
count=1
do
Hailstone n
Count++
if n=1 then exit do
end do
return count
end function
'MAIN
'====
maxc=0
maxn=0
e=100000
for n=1 to e
c=HailstoneSequence n
if c>maxc
maxc=c
maxn=n
end if
next
print e ", " maxn ", " maxc
'result 100000, 77031, 351
[edit] Oz
declare
fun {HailstoneSeq N}
N > 0 = true %% assert
if N == 1 then [1]
elseif {IsEven N} then N|{HailstoneSeq N div 2}
else N|{HailstoneSeq 3*N+1}
end
end
HSeq27 = {HailstoneSeq 27}
{Length HSeq27} = 112
{List.take HSeq27 4} = [27 82 41 124]
{List.drop HSeq27 108} = [8 4 2 1]
fun {MaxBy2nd A=A1#A2 B=B1#B2}
if B2 > A2 then B else A end
end
Pairs = {Map {List.number 1 99999 1}
fun {$ I} I#{Length {HailstoneSeq I}} end}
MaxI#MaxLen = {List.foldL Pairs MaxBy2nd 0#0}
{System.showInfo
"Maximum length "#MaxLen#" was found for hailstone("#MaxI#")"}
Output:
Maximum length 351 was found for hailstone(77031)
[edit] PARI/GP
show(n)={
my(t=1);
while(n>1,
print1(n",");
n=if(n%2,
3*n+1
,
n/2
);
t++
);
print(1);
t
};
len(n)={
my(t=1);
while(n>1,
if(n%2,
t+=2;
n+=(n>>1)+1
,
t++;
n>>=1
)
);
t
};
show(27)
r=0;for(n=1,1e5,t=len(n);if(t>r,r=t;ra=n));print(ra"\t"r)
Output:
27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,91,274,137,4 12,206,103,310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,133 6,668,334,167,502,251,754,377,1132,566,283,850,425,1276,638,319,958,479,1438,719 ,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051,6154,3077, 9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,2 3,70,35,106,53,160,80,40,20,10,5,16,8,4,2,1
and
77031 351
[edit] Pascal
See Delphi
[edit] Perl
[edit] Straightforward
#!/usr/bin/perl
use warnings;
use strict;
my @h = hailstone(27);
print "Length of hailstone(27) = " . scalar @h . "\n";
print "[" . join(", ", @h[0 .. 3], "...", @h[-4 .. -1]) . "]\n";
my ($max, $n) = (0, 0);
for my $x (1 .. 99_999) {
@h = hailstone($x);
if (scalar @h > $max) {
($max, $n) = (scalar @h, $x);
}
}
print "Max length $max was found for hailstone($n) for numbers < 100_000\n";
sub hailstone {
my ($n) = @_;
my @sequence = ($n);
while ($n > 1) {
if ($n % 2 == 0) {
$n = int($n / 2);
} else {
$n = $n * 3 + 1;
}
push @sequence, $n;
}
return @sequence;
}
Output:
Length of hailstone(27) = 112 [27, 82, 41, 124, ..., 8, 4, 2, 1] Max length 351 was found for hailstone(77031) for numbers < 100_000
[edit] Compact
A more compact version:
#!/usr/bin/perl
use strict;
sub hailstone {
@_ = local $_ = shift;
push @_, $_ = $_ % 2 ? 3 * $_ + 1 : $_ / 2 while $_ > 1;
@_;
}
my @h = hailstone($_ = 27);
print "$_: @h[0 .. 3] ... @h[-4 .. -1] (".@h.")\n";
@h = ();
for (1 .. 99_999) { @h = ($_, $h[2]) if ($h[2] = hailstone($_)) > $h[1] }
printf "%d: (%d)\n", @h;
The same approach as in the compact version above, obfuscated:
sub _{my$_=$_[''];push@_,$_&1?$_+=$_++<<1:($_>>=1)while$_^1;@_}
@_=_($_=031^2);print "$_: @_[0..3] ... @_[-4..-1] (".@_.")\n";
$_[1]<($_[2]=_($_))and@_=($_,$_[2])for 1..1e5-1;printf "%d: (%d)\n", @_;
Output in either case:
27: 27 82 41 124 ... 8 4 2 1 (112) 77031: (351)
[edit] Perl 6
sub hailstone($n) { $n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1 }
my @h = hailstone(27);
say "Length of hailstone(27) = {+@h}";
say ~@h;
my $m max= +hailstone($_) => $_ for 1..99_999;
say "Max length $m.key() was found for hailstone($m.value()) for numbers < 100_000";
[edit] PHP
function hailstone($n,$seq=array()){
$sequence = $seq;
$sequence[] = $n;
if($n == 1){
return $sequence;
}else{
$n = ($n%2==0) ? $n/2 : (3*$n)+1;
return hailstone($n, $sequence);
}
}
$result = hailstone(27);
echo count($result) . ' Elements.<br>';
echo 'Starting with : ' . implode(",",array_slice($result,0,4)) .' and ending with : ' . implode(",",array_slice($result,count($result)-4)) . '<br>';
$maxResult = array(0);
for($i=1;$i<=100000;$i++){
$result = count(hailstone($i));
if($result > max($maxResult)){
$maxResult = array($i=>$result);
}
}
foreach($maxResult as $key => $val){
echo 'Number < 100000 with longest Hailstone seq.: ' . $key . ' with length of ' . $val;
}
112 Elements. Starting with : 27,82,41,124 and ending with : 8,4,2,1 Number < 100000 with longest Hailstone seq.: 77031 with length of 351
[edit] PicoLisp
(de hailstone (N)
(make
(until (= 1 (link N))
(setq N
(if (bit? 1 N)
(inc (* N 3))
(/ N 2) ) ) ) ) )
(let L (hailstone 27)
(println 27 (length L) (head 4 L) '- (tail 4 L)) )
(let N (maxi '((N) (length (hailstone N))) (range 1 100000))
(println N (length (hailstone N))) )
Output:
27 112 (27 82 41 124) - (8 4 2 1) 77031 351
[edit] Pike
#!/usr/bin/env pike
int next(int n)
{
if (n==1)
return 0;
if (n%2)
return 3*n+1;
else
return n/2;
}
array(int) hailstone(int n)
{
array seq = ({ n });
while (n=next(n))
seq += ({ n });
return seq;
}
void main()
{
array(int) two = hailstone(27);
if (equal(two[0..3], ({ 27, 82, 41, 124 })) && equal(two[<3..], ({ 8,4,2,1 })))
write("sizeof(({ %{%d, %}, ... %{%d, %} }) == %d\n", two[0..3], two[<3..], sizeof(two));
mapping longest = ([ "length":0, "start":0 ]);
foreach(allocate(100000); int start; )
{
int length = sizeof(hailstone(start));
if (length > longest->length)
{
longest->length = length;
longest->start = start;
}
}
write("longest sequence starting at %d has %d elements\n", longest->start, longest->length);
}
Output:
sizeof(({ 27, 82, 41, 124, , ... 8, 4, 2, 1, }) == 112
longest sequence starting at 77031 has 351 elements
[edit] PL/I
test: proc options (main);
declare (longest, n) fixed (15);
declare flag bit (1);
declare (i, value) fixed (15);
/* Task 1: */
flag = '1'b;
put skip list ('The sequence for 27 is');
i = hailstones(27);
/* Task 2: */
flag = '0'b;
longest = 0;
do i = 1 to 99999;
if longest < hailstones(i) then
do; longest = hailstones(i); value = i; end;
end;
put skip edit (value, ' has the longest sequence of ', longest) (a);
hailstones: procedure (n) returns ( fixed (15));
declare n fixed (15) nonassignable;
declare (m, p) fixed (15);
m = n;
p = 1;
if flag then put skip list (m);
do p = 1 by 1 while (m > 1);
if iand(m, 1) = 0 then
m = m/2;
else
m = 3*m + 1;
if flag then put skip list (m);
end;
if flag then put skip list ('The hailstone sequence has length' || p);
return (p);
end hailstones;
end test;
Output:
The sequence for 27 is
27
82
41
124
62
31
94
47
142
71
214
107
322
161
484
242
121
364
182
91
274
137
412
206
103
310
155
466
233
700
350
175
526
263
790
395
1186
593
1780
890
445
1336
668
334
167
502
251
754
377
1132
566
283
850
425
1276
638
319
958
479
1438
719
2158
1079
3238
1619
4858
2429
7288
3644
1822
911
2734
1367
4102
2051
6154
3077
9232
4616
2308
1154
577
1732
866
433
1300
650
325
976
488
244
122
61
184
92
46
23
70
35
106
53
160
80
40
20
10
5
16
8
4
2
1
The hailstone sequence has length 112
77031 has the longest sequence of 351
[edit] Prolog
1. Create a routine to generate the hailstone sequence for a number.
hailstone(1,[1]) :- !.
hailstone(N,[N|S]) :- 0 is N mod 2, N1 is N / 2, hailstone(N1,S).
hailstone(N,[N|S]) :- 1 is N mod 2, N1 is (3 * N) + 1, hailstone(N1, S).
2. Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1.
The following query performs the test.
hailstone(27,X),
length(X,112),
append([27, 82, 41, 124], _, X),
append(_, [8, 4, 2, 1], X).
3. Show the number less than 100,000 which has the longest hailstone sequence together with that sequences length.
longestHailstoneSequence(M, Seq, Len) :- longesthailstone(M, 1, 1, Seq, Len).
longesthailstone(1, Cn, Cl, Mn, Ml):- Mn = Cn,
Ml = Cl.
longesthailstone(N, _, Cl, Mn, Ml) :- hailstone(N, X),
length(X, L),
Cl < L,
N1 is N-1,
longesthailstone(N1, N, L, Mn, Ml).
longesthailstone(N, Cn, Cl, Mn, Ml) :- N1 is N-1,
longesthailstone(N1, Cn, Cl, Mn, Ml).
run this query.
longestHailstoneSequence(100000, Seq, Len).
to get the following result
Seq = 77031, Len = 351
[edit] Constraint Handling Rules
CHR is a programming language created by Professor Thom Frühwirth.
Works with SWI-Prolog and module chr written by Tom Schrijvers and Jan Wielemaker
:- use_module(library(chr)).
:- chr_option(debug, off).
:- chr_option(optimize, full).
:- chr_constraint collatz/2, hailstone/1, clean/0.
% to remove all constraints hailstone/1 after computation
clean @ clean \ hailstone(_) <=> true.
clean @ clean <=> true.
% compute Collatz number
init @ collatz(1,X) <=> X = 1 | true.
collatz @ collatz(N, C) <=> (N mod 2 =:= 0 -> C is N / 2; C is 3 * N + 1).
% Hailstone loop
hailstone(1) ==> true.
hailstone(N) ==> N \= 1 | collatz(N, H), hailstone(H).
Code for task one :
task1 :-
hailstone(27),
findall(X, find_chr_constraint(hailstone(X)), L),
clean,
% check the requirements
( (length(L, 112), append([27, 82, 41, 124 | _], [8,4,2,1], L)) -> writeln(ok); writeln(ko)).
Output :
?- task1. ok true.
Code for task two :
longest_sequence :-
seq(2, 100000, 1-[1], Len-V),
format('For ~w sequence has ~w len ! ~n', [V, Len]).
% walk through 2 to 100000 and compute the length of the sequences
% memorize the longest
seq(N, Max, Len-V, Len-V) :- N is Max + 1, !.
seq(N, Max, CLen - CV, FLen - FV) :-
len_seq(N, Len - N),
( Len > CLen -> Len1 = Len, V1 = [N]
; Len = CLen -> Len1 = Len, V1 = [N | CV]
; Len1 = CLen, V1 = CV),
N1 is N+1,
seq(N1, Max, Len1 - V1, FLen - FV).
% compute the len of the Hailstone sequence for a number
len_seq(N, Len - N) :-
hailstone(N),
findall(hailstone(X), find_chr_constraint(hailstone(X)), L),
length(L, Len),
clean.
Output :
?- longest_sequence. For [77031] sequence has 351 len ! true.
[edit] Pure
// 1. Create a routine to generate the hailstone sequence for a number.
type odd x::int = x mod 2;
type even x::int = ~odd x;
odd x = typep odd x;
even x = typep even x;
hailstone 1 = [1];
hailstone n::even = n:hailstone (n div 2);
hailstone n::odd = n:hailstone (3*n + 1);
// 2. Use the routine to show that the hailstone sequence for the number 27
// has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
n = 27;
hs = hailstone n;
l = # hs;
using system;
printf
("the hailstone sequence for the number %d has %d elements " +
"starting with %s and ending with %s\n")
(n, l, __str__ (hs!!(0..3)), __str__ ( hs!!((l-4)..l)));
// 3. Show the number less than 100,000 which has the longest hailstone
// sequence together with that sequences length.
printf ("the number under 100,000 with the longest sequence is %d " +
"with a sequence length of %d\n")
(foldr (\ (a,b) (c,d) -> if (b > d) then (a,b) else (c,d))
(0,0)
(map (\ x -> (x, # hailstone x)) (1..100000)));
Output:
the hailstone sequence for the number 27 has 112 elements starting with [27,82,41,124] and ending with [8,4,2,1] the number under 100,000 with the longest sequence is 77031 with a sequence length of 351
[edit] PureBasic
NewList Hailstones.i() ; Make a linked list to use as we do not know the numbers of elements needed for an Array
Procedure.i FillHailstones(n) ; Fills the list & returns the amount of elements in the list
Shared Hailstones() ; Get access to the Hailstones-List
ClearList(Hailstones()) ; Remove old data
Repeat
AddElement(Hailstones()) ; Add an element to the list
Hailstones()=n ; Fill current value in the new list element
If n=1
ProcedureReturn ListSize(Hailstones())
ElseIf n%2=0
n/2
Else
n=(3*n)+1
EndIf
ForEver
EndProcedure
If OpenConsole()
Define i, l, maxl, maxi
l=FillHailstones(27)
Print("#27 has "+Str(l)+" elements and the sequence is: "+#CRLF$)
ForEach Hailstones()
If i=6
Print(#CRLF$)
i=0
EndIf
i+1
Print(RSet(Str(Hailstones()),5))
If Hailstones()<>1
Print(", ")
EndIf
Next
i=1
Repeat
l=FillHailstones(i)
If l>maxl
maxl=l
maxi=i
EndIf
i+1
Until i>=100000
Print(#CRLF$+#CRLF$+"The longest sequence below 100000 is #"+Str(maxi)+", and it has "+Str(maxl)+" elements.")
Print(#CRLF$+#CRLF$+"Press ENTER to exit."): Input()
CloseConsole()
EndIf
Output
#27 has 112 elements and the sequence is:
27, 82, 41, 124, 62, 31,
94, 47, 142, 71, 214, 107,
322, 161, 484, 242, 121, 364,
182, 91, 274, 137, 412, 206,
103, 310, 155, 466, 233, 700,
350, 175, 526, 263, 790, 395,
1186, 593, 1780, 890, 445, 1336,
668, 334, 167, 502, 251, 754,
377, 1132, 566, 283, 850, 425,
1276, 638, 319, 958, 479, 1438,
719, 2158, 1079, 3238, 1619, 4858,
2429, 7288, 3644, 1822, 911, 2734,
1367, 4102, 2051, 6154, 3077, 9232,
4616, 2308, 1154, 577, 1732, 866,
433, 1300, 650, 325, 976, 488,
244, 122, 61, 184, 92, 46,
23, 70, 35, 106, 53, 160,
80, 40, 20, 10, 5, 16,
8, 4, 2, 1
The longest sequence found up to 100000 is #77031 which has 351 elements.
Press ENTER to exit.
[edit] Python
def hailstone(n):
seq = [n]
while n>1:
n = 3*n + 1 if n & 1 else n//2
seq.append(n)
return seq
if __name__ == '__main__':
h = hailstone(27)
assert len(h)==112 and h[:4]==[27, 82, 41, 124] and h[-4:]==[8, 4, 2, 1]
print("Maximum length %i was found for hailstone(%i) for numbers <100,000" %
max((len(hailstone(i)), i) for i in range(1,100000)))
Sample Output
Maximum length 351 was found for hailstone(77031) for numbers <100,000
[edit] R
### PART 1:Output:
makeHailstone <- function(n){
hseq <- n
while (hseq[length(hseq)] > 1){
current.value <- hseq[length(hseq)]
if (current.value %% 2 == 0){
next.value <- current.value / 2
} else {
next.value <- (3 * current.value) + 1
}
hseq <- append(hseq, next.value)
}
return(list(hseq=hseq, seq.length=length(hseq)))
}
### PART 2:
twenty.seven <- makeHailstone(27)
twenty.seven$hseq
twenty.seven$seq.length
### PART 3:
max.length <- 0; lower.bound <- 1; upper.bound <- 100000
for (index in lower.bound:upper.bound){
current.hseq <- makeHailstone(index)
if (current.hseq$seq.length > max.length){
max.length <- current.hseq$seq.length
max.index <- index
}
}
cat("Between ", lower.bound, " and ", upper.bound, ", the input of ",
max.index, " gives the longest hailstone sequence, which has length ",
max.length, ". \n", sep="")
> twenty.seven$hseq
[1] 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484
[16] 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700
[31] 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
[46] 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438
[61] 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051
[76] 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488
[91] 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20
[106] 10 5 16 8 4 2 1
> twenty.seven$seq.length
[1] 112
Between 1 and 1e+05, the input of 77031 gives the longest hailstone sequence,
which has length 351.
[edit] Racket
#lang racket
(define hailstone
(let ([t (make-hasheq)])
(hash-set! t 1 '(1))
(λ(n) (hash-ref! t n
(λ() (cons n (hailstone (if (even? n) (/ n 2) (+ (* 3 n) 1)))))))))
(define h27 (hailstone 27))
(printf "h(27) = ~s, ~s items\n"
`(,@(take h27 4) ... ,@(take-right h27 4))
(length h27))
(define N 100000)
(define longest
(for/fold ([m #f]) ([i (in-range 1 (add1 N))])
(define h (hailstone i))
(if (and m (> (cdr m) (length h))) m (cons i (length h)))))
(printf "for x<=~s, ~s has the longest sequence with ~s items\n"
N (car longest) (cdr longest))
Output:
h(27) = (27 82 41 124 ... 8 4 2 1), 112 items for x<=100000, 77031 has the longest sequence with 351 items
[edit] REXX
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x .; if x=='' then x=27 /*get the optional first argument*/
numeric digits 20
$=hailstone(x) /*═════════════task 1════════════*/
say x 'has a hailstone sequence of' #hs 'and starts with: ' subword($,1,4),
' and ends with:' subword($,#hs-3)
say
w=0; do j=1 for 99999 /*═════════════task 2════════════*/
call hailstone j /*compute the hailstone sequence.*/
if #hs<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=#hs /*remember what # has biggest HS.*/
end /*j*/
say '(between 1──►99,999) ' bigJ 'has the longest hailstone sequence:' w
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────HAILSTONE subroutine────────────────*/
hailstone: procedure expose #hs; parse arg n 1 s /*N & S set to 1st arg*/
do #hs=1 while n\==1 /*loop while N isn't unity. */
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*#hs*/
return s
output
27 has a hailstone sequence of 112 and starts with: 27 82 41 124 and ends with: 8 4 2 1 (between 1──►99,999) 77031 has the longest hailstone sequence: 351
[edit] Ruby
This program uses new methods (Integer#even? and Enumerable#max_by) from Ruby 1.8.7.
def hailstone n
seq = [n]
until n == 1
n = (n.even?) ? (n / 2) : (3 * n + 1)
seq << n
end
seq
end
# for n = 27, show sequence length and first and last 4 elements
hs27 = hailstone 27
p [hs27.length, hs27[0..3], hs27[-4..-1]]
# find the longest sequence among n less than 100,000
n, len = (1 ... 100_000) .collect {|n|
[n, hailstone(n).length]} .max_by {|n, len| len}
puts "#{n} has a hailstone sequence length of #{len}"
puts "the largest number in that sequence is #{hailstone(n).max}"
Output:
[112, [27, 82, 41, 124], [8, 4, 2, 1]] 77031 has a hailstone sequence length of 351 the largest number in that sequence is 21933016
[edit]
This version builds some linked lists with shared structure. Hailstone::ListNode is an adaptation of ListNode from Singly-linked list/Element definition#Ruby. When two sequences contain the same value, those two lists share a tail. This avoids recomputing the end of the sequence.
module Hailstone
class ListNode
include Enumerable
attr_reader :value, :size, :succ
def initialize(value, size, succ=nil)
@value, @size, @succ = value, size, succ
end
def each
node = self
while node
yield node.value
node = node.succ
end
end
end
@@sequence = {1 => ListNode.new(1, 1)}
module_function
def sequence(n)
unless @@sequence[n]
ary = []
m = n
until succ = @@sequence[m]
ary << m
m = (m.even?) ? (m / 2) : (3 * m + 1)
end
ary.reverse_each do |m|
@@sequence[m] = succ = ListNode.new(m, succ.size + 1, succ)
end
end
@@sequence[n]
end
end
# for n = 27, show sequence length and first and last 4 elements
hs27 = Hailstone.sequence(27).to_a
p [hs27.length, hs27[0..3], hs27[-4..-1]]
# find the longest sequence among n less than 100,000
hs_big = (1 ... 100_000) .collect {|n|
Hailstone.sequence n}.max_by {|hs| hs.size}
puts "#{hs_big.first} has a hailstone sequence length of #{hs_big.size}"
puts "the largest number in that sequence is #{hs_big.max}"
[edit] Run BASIC
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""
while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
count = doHailstone(hailstone,"Y")
print: print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
count = doHailstone(27,"Y")
print: print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print "Calculating result... Please wait... This could take a little while..."
print "Stone Percent Count"
for i = 1 to 99999
count = doHailstone(i,"N")
if count > maxCount then
theBigStone = i
maxCount = count
print using("#####",i);" ";using("###.#", i / 99999 * 100);"% ";using("####",count)
end if
next i
end
'---------------------------------------------
' pass number and print (Y/N)
FUNCTION doHailstone(hailstone,prnt$)
if prnt$ = "Y" then
print "The following is the 'Hailstone Sequence' for number:";hailstone
end if
while hailstone <> 1
if (hailstone and 1) then hailstone = (hailstone * 3) + 1 else hailstone = hailstone / 2
doHailstone = doHailstone + 1
if prnt$ = "Y" then
print hailstone;chr$(9);
if (doHailstone mod 10) = 0 then print
end if
wend
END FUNCTION
[edit] Scala
def hailstone(n: Int): Stream[Int] =
n #:: {
if (n == 1) Stream.empty
else hailstone(if (n % 2 == 0) n / 2 else n * 3 + 1)
}
def main(args: Array[String]) {
println(hailstone(27).toList)
val (n, len) = (1 to 100000).map(n => (n, hailstone(n).length)).maxBy(_._2)
println("value=" + n + " len=" + len)
}
Output:
List(27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1) value=77031 len=351
[edit] Scheme
(define (collatz n)
(if (= n 1) '(1)
(cons n (collatz (if (even? n) (/ n 2) (+ 1 (* 3 n)))))))
(define (collatz-length n)
(let aux ((n n) (r 1)) (if (= n 1) r
(aux (if (even? n) (/ n 2) (+ 1 (* 3 n))) (+ r 1)))))
(define (collatz-max a b)
(let aux ((i a) (j 0) (k 0))
(if (> i b) (list j k)
(let ((h (collatz-length i)))
(if (> h k) (aux (+ i 1) i h) (aux (+ i 1) j k))))))
(collatz 27)
; (27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182
; 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395
; 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283
; 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429
; 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154
; 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35
; 106 53 160 80 40 20 10 5 16 8 4 2 1)
(collatz-length 27)
; 112
(collatz-max 1 100000)
; (77031 351)
[edit] Seed7
$ include "seed7_05.s7i";
const func array integer: hailstone (in var integer: n) is func
result
var array integer: hSequence is 0 times 0;
begin
while n <> 1 do
hSequence &:= n;
if odd(n) then
n := 3 * n + 1;
else
n := n div 2;
end if;
end while;
hSequence &:= n;
end func;
const func integer: hailstoneSequenceLength (in var integer: n) is func
result
var integer: sequenceLength is 1;
begin
while n <> 1 do
incr(sequenceLength);
if odd(n) then
n := 3 * n + 1;
else
n := n div 2;
end if;
end while;
end func;
const proc: main is func
local
var integer: number is 0;
var integer: length is 0;
var integer: maxLength is 0;
var integer: numberOfMaxLength is 0;
var array integer: h27 is 0 times 0;
begin
for number range 1 to 99999 do
length := hailstoneSequenceLength(number);
if length > maxLength then
maxLength := length;
numberOfMaxLength := number;
end if;
end for;
h27 := hailstone(27);
writeln("hailstone(27):");
for number range 1 to 4 do
write(h27[number] <& ", ");
end for;
write("....");
for number range length(h27) -3 to length(h27) do
write(", " <& h27[number]);
end for;
writeln(" length=" <& length(h27));
writeln("Maximum length " <& maxLength <& " at number=" <& numberOfMaxLength);
end func;
Output:
hailstone(27): 27, 82, 41, 124, ...., 8, 4, 2, 1 length=112 Maximum length 351 at number=77031
[edit] Smalltalk
Object subclass: Sequences [
Sequences class >> hailstone: n [
|seq|
seq := OrderedCollection new.
seq add: n.
(n = 1) ifTrue: [ ^seq ].
(n even) ifTrue: [ seq addAll: (Sequences hailstone: (n / 2)) ]
ifFalse: [ seq addAll: (Sequences hailstone: ( (3*n) + 1 ) ) ].
^seq.
]
Sequences class >> hailstoneCount: n [
^ (Sequences hailstoneCount: n num: 1)
]
"this 'version' avoids storing the sequence, it just counts
its length - no memoization anyway"
Sequences class >> hailstoneCount: n num: m [
(n = 1) ifTrue: [ ^m ].
(n even) ifTrue: [ ^ Sequences hailstoneCount: (n / 2) num: (m + 1) ]
ifFalse: [ ^ Sequences hailstoneCount: ( (3*n) + 1) num: (m + 1) ].
]
].
|r|
r := Sequences hailstone: 27. "hailstone 'from' 27"
(r size) displayNl. "its length"
"test 'head' ..."
( (r first: 4) = #( 27 82 41 124 ) asOrderedCollection ) displayNl.
"... and 'tail'"
( ( (r last: 4 ) ) = #( 8 4 2 1 ) asOrderedCollection) displayNl.
|longest|
longest := OrderedCollection from: #( 1 1 ).
2 to: 100000 do: [ :c |
|l|
l := Sequences hailstoneCount: c.
(l > (longest at: 2) ) ifTrue: [ longest replaceFrom: 1 to: 2 with: { c . l } ].
].
('Sequence generator %1, sequence length %2' % { (longest at: 1) . (longest at: 2) })
displayNl.
[edit] SNUSP
/@+@@@+++# 27
| halve odd /===count<<\ /recurse\ #/?\ zero
$>@/===!/===-?\==>?!/-<+++\ \!/=!\@\>?!\@/<@\.!\-/
/+<-\!>\?-<+>/++++<\?>+++/*6+4 | | \=/ \=itoa=@@@+@+++++#
\=>?/<=!=\ | | ! /+ !/+ !/+ !/+ \ mod10
|//!==/========\ | /<+> -\!?-\!?-\!?-\!?-\!
/=>?\<=/\<+>!\->+>+<<?/>>=print@/\ln \?!\-?!\-?!\-?!\-?!\-?/\ div10
\+<-/!< ----------.++++++++++/ # +/! +/! +/! +/! +/
[edit] Tcl
The core looping structure is an example of an n-plus-one-half loop, except the loop is officially infinite here.
proc hailstone n {
while 1 {
lappend seq $n
if {$n == 1} {return $seq}
set n [expr {$n & 1 ? $n*3+1 : $n/2}]
}
}
set h27 [hailstone 27]
puts "h27 len=[llength $h27]"
puts "head4 = [lrange $h27 0 3]"
puts "tail4 = [lrange $h27 end-3 end]"
set maxlen [set max 0]
for {set i 1} {$i<100000} {incr i} {
set l [llength [hailstone $i]]
if {$l>$maxlen} {set maxlen $l;set max $i}
}
puts "max is $max, with length $maxlen"
Output:
h27 len=112 head4 = 27 82 41 124 tail4 = 8 4 2 1 max is 77031, with length 351
[edit] TXR
@(do (defun hailstone (n)
(cons n
(gen (not (eq n 1))
(set n (if (evenp n)
(trunc n 2)
(+ (* 3 n) 1)))))))
@(next :list @(mapcar* (fun tostring) (hailstone 27)))
27
82
41
124
@(skip)
8
4
2
1
@(eof)
@(do (let ((max 0) maxi)
(each* ((i (range 1 99999))
(h (mapcar* (fun hailstone) i))
(len (mapcar* (fun length) h)))
(if (> len max)
(progn
(set max len)
(set maxi i))))
(format t "longest sequence is ~a for n = ~a\n" max maxi)))
$ txr -l hailstone.txr longest sequence is 351 for n = 77031
[edit] UNIX Shell
The best way is to use a shell with built-in arrays and arithmetic, such as Bash.
#!/bin/bash
# seq is the array genereated by hailstone
# index is used for seq
declare -a seq
declare -i index
# Create a routine to generate the hailstone sequence for a number
hailstone () {
unset seq index
seq[$((index++))]=$((n=$1))
while [ $n -ne 1 ]; do
[ $((n % 2)) -eq 1 ] && ((n=n*3+1)) || ((n=n/2))
seq[$((index++))]=$n
done
}
# Use the routine to show that the hailstone sequence for the number 27
# has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
i=27
hailstone $i
echo "$i: ${#seq[@]}"
echo "${seq[@]:0:4} ... ${seq[@]:(-4):4}"
# Show the number less than 100,000 which has the longest hailstone
# sequence together with that sequences length.
# (But don't show the actual sequence)!
max=0
maxlen=0
for ((i=1;i<100000;i++)); do
hailstone $i
if [ $((len=${#seq[@]})) -gt $maxlen ]; then
max=$i
maxlen=$len
fi
done
echo "${max} has a hailstone sequence length of ${maxlen}"
output
27: 112 27 82 41 124 ... 8 4 2 1 77031 has a hailstone sequence of 351
[edit] Bourne Shell
This script follows tradition for the Bourne Shell; its hailstone() function writes the sequence to standard output, so the shell can capture or pipe this output. This script is very slow because it forks many processes. Each `command substitution` forks a subshell, and each expr(1) command forks a process.
- Therefore, this script only examines sequences from 1 to 1000, not 100000. A fast computer might run this script in 45 to 120 seconds, using most time to run system calls in kernel mode. If the script went to 100000, it would need several hours.
# Outputs a hailstone sequence from $1, with one element per line.
# Clobbers $n.
hailstone() {
n=`expr "$1" + 0`
eval "test $? -lt 2 || return $?" # $n must be integer.
echo $n
while test $n -ne 1; do
if expr $n % 2 >/dev/null; then
n=`expr 3 \* $n + 1`
else
n=`expr $n / 2`
fi
echo $n
done
}
set -- `hailstone 27`
echo "Hailstone sequence from 27 has $# elements:"
first="$1, $2, $3, $4"
shift `expr $# - 4`
echo " $first, ..., $1, $2, $3, $4"
i=1 max=0 maxlen=0
while test $i -lt 1000; do
len=`hailstone $i | wc -l | tr -d ' '`
test $len -gt $maxlen && max=$i maxlen=$len
i=`expr $i + 1`
done
echo "Hailstone sequence from $max has $maxlen elements."
[edit] C Shell
This script is several times faster than the previous Bourne Shell script, because it uses C Shell expressions, not the expr(1) command. This script is slow, but it can reach 100000, and a fast computer might run it in less than 15 minutes.
# Outputs a hailstone sequence from !:1, with one element per line.
# Clobbers $n.
alias hailstone eval \''@ n = \!:1:q \\
echo $n \\
while ( $n != 1 ) \\
if ( $n % 2 ) then \\
@ n = 3 * $n + 1 \\
else \\
@ n /= 2 \\
endif \\
echo $n \\
end \\
'\'
set sequence=(`hailstone 27`)
echo "Hailstone sequence from 27 has $#sequence elements:"
@ i = $#sequence - 3
echo " $sequence[1-4] ... $sequence[$i-]"
# hailstone-length $i
# acts like
# @ len = `hailstone $i | wc -l | tr -d ' '`
# but without forking any subshells.
alias hailstone-length eval \''@ n = \!:1:q \\
@ len = 1 \\
while ( $n != 1 ) \\
if ( $n % 2 ) then \\
@ n = 3 * $n + 1 \\
else \\
@ n /= 2 \\
endif \\
@ len += 1 \\
end \\
'\'
@ i = 1
@ max = 0
@ maxlen = 0
while ($i < 100000)
# XXX - I must run hailstone-length in a subshell, because my
# C Shell has a bug when it runs hailstone-length inside this
# while ($i < 1000) loop: it forgets about this loop, and
# reports an error <<end: Not in while/foreach.>>
@ len = `hailstone-length $i; echo $len`
if ($len > $maxlen) then
@ max = $i
@ maxlen = $len
endif
@ i += 1
end
echo "Hailstone sequence from $max has $maxlen elements."
$ csh -f hailstone.csh Hailstone sequence from 27 has 112 elements: 27 82 41 124 ... 8 4 2 1 Hailstone sequence from 77031 has 351 elements.
[edit] Ursala
#import std
#import nat
hail = @iNC ~&h~=1->x ^C\~& @h ~&h?\~&t successor+ sum@iNiCX
#show+
main =
<
^T(@ixX take/$4; %nLP~~lrxPX; ^|TL/~& :/'...',' has length '--@h+ %nP+ length) hail 27,
^|TL(~&,:/' has sequence length ') %nP~~ nleq$^&r ^(~&,length+ hail)* nrange/1 100000>
The hail function computes the sequence as follows.
- Given a number as an argument,
@iNCmakes a list containing only that number before passing it to the rest of the function. Theiin the expression stands for the identity function,Nfor the constant null function, andCfor the cons operator. - The iteration combinator (
->) is used with a predicate of~&h~=lwhich tests the condition that the head (~&h) of its argument is not equal (~=) to 1. Iteration of the rest of the function continues while this predicate holds. - The
xsuffix says to return the reversal of the list after the iteration finishes. - The function being iterated builds a list using the cons operator (
^C) with the identity function (~&) of the argument for the tail, and the result of the rest of the line for the head. - The
@hoperator says that the function following will be applied to the head of the list. - The conditional operator (
?) has the head function (~&h) as its predicate, which tests whether the head of its argument is non-null. - In this case, the argument is a natural number, but naturals are represented as lists of booleans, so taking the head of a number is the same as testing the least significant bit.
- If the condition is not met, the number has a 0 least significant bit, and therefore is even. In this case, the conditional predicate calls for taking its tail (
~&t), effectively dividing it by 2 using a bit shift. - If the condition is met, the number is odd, so the rest of the function computes the successor of the number multiplied by three.
- Rather than multiplying the hard way, the function
sum@iNiCXcomputes the sum of the pair (X) of numbers given by the identity function (i) of the argument, and the doubling of the argument (NiC), also obtained by a bit shift, with a zero bit (N) consed (C) with the identity (i).
Most of the main expression pertains to less interesting printing and formatting, but the part that searches for the longest sequence in the range is nleq$^&r ^(~&,length+ hail)* nrange/1 100000.
- The expression
nrange/1 100000evaluates to the list of the first 100000 positive integers. - The map operator (
*) causes a list to be made of the results of its operand applied to each number. - The operand to the map operator, applied to an individual number in the list, constructs a pair (
^) with the identity function (~&) of the number on the left, and the length of thehailsequence on the right. - The maximizing operator (
$^) with respect to the natural less or equal relation (nleq) applied to the right sides (&r) of its pair of arguments extracts the number with the maximum length sequence.
output:
<27,82,41,124>...<8,4,2,1> has length 112 77031 has sequence length 351
[edit] Visual Basic .NET
Module HailstoneSequence
Sub Main()
' Checking sequence of 27.
Dim l As List(Of Long) = HailstoneSequence(27)
Console.WriteLine("27 has {0} elements in sequence:", l.Count())
For i As Integer = 0 To 3 : Console.Write("{0}, ", l(i)) : Next
Console.Write("... ")
For i As Integer = l.Count - 4 To l.Count - 1 : Console.Write(", {0}", l(i)) : Next
Console.WriteLine()
' Finding longest sequence for numbers below 100000.
Dim max As Integer = 0
Dim maxCount As Integer = 0
For i = 1 To 99999
l = HailstoneSequence(i)
If l.Count > maxCount Then
max = i
maxCount = l.Count
End If
Next
Console.WriteLine("Max elements in sequence for number below 100k: {0} with {1} elements.", max, maxCount)
Console.ReadLine()
End Sub
Private Function HailstoneSequence(ByVal n As Long) As List(Of Long)
Dim valList As New List(Of Long)()
valList.Add(n)
Do Until n = 1
n = IIf(n Mod 2 = 0, n / 2, (3 * n) + 1)
valList.Add(n)
Loop
Return valList
End Function
End Module
Output:
27 has 112 elements in sequence: 27, 82, 41, 124, ... , 8, 4, 2, 1 Max elements in sequence for number below 100k: 77031 with 351 elements.
[edit] XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
int Seq(1000); \more than enough for longest sequence
func Hailstone(N); \Return length of Hailstone sequence starting at N
int N; \ also fills Seq array with sequence
int I;
[I:= 0;
loop [Seq(I):= N; I:= I+1;
if N=1 then return I;
N:= if N&1 then N*3+1 else N/2;
];
];
int N, SN, Len, MaxLen;
[Len:= Hailstone(27);
Text(0, "27's Hailstone length = "); IntOut(0, Len); CrLf(0);
Text(0, "Sequence = ");
for N:= 0 to 3 do [IntOut(0, Seq(N)); ChOut(0, ^ )];
Text(0, "... ");
for N:= Len-4 to Len-1 do [IntOut(0, Seq(N)); ChOut(0, ^ )];
CrLf(0);
MaxLen:= 0;
for N:= 1 to 100_000-1 do
[Len:= Hailstone(N);
if Len > MaxLen then [MaxLen:= Len; SN:= N]; \save N with max length
];
IntOut(0, SN); Text(0, "'s Hailstone length = "); IntOut(0, MaxLen);
]
Output:
27's Hailstone length = 112 Sequence = 27 82 41 124 ... 8 4 2 1 77031's Hailstone length = 351
Categories:
- Programming Tasks
- Solutions by Programming Task
- ACL2
- Ada
- ALGOL 68
- APL
- AutoHotkey
- AutoIt
- AWK
- Batch File
- BBC BASIC
- Befunge
- Befunge examples needing attention
- Examples needing attention
- Bracmat
- Brainf***
- Brat
- Burlesque
- C
- C sharp
- C++
- CLIPS
- Clojure
- CoffeeScript
- Common Lisp
- D
- Dart
- Dc
- Delphi
- Erlang
- Euler Math Toolbox
- Euphoria
- Excel
- Excel examples needing attention
- Factor
- FALSE
- Forth
- Fortran
- Frege
- F Sharp
- GAP
- Go
- Groovy
- Haskell
- HicEst
- Icon
- Unicon
- Io
- Ioke
- Ioke examples needing attention
- Inform 7
- J
- Java
- JavaScript
- Julia
- K
- Liberty BASIC
- Logo
- Logtalk
- LOLCODE
- Lua
- Mathematica
- MATLAB
- Octave
- Maxima
- Modula-2
- MUMPS
- NetRexx
- Oberon-2
- OCaml
- OoRexx
- Order
- OxygenBasic
- Oz
- PARI/GP
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- Pike
- PL/I
- Prolog
- Pure
- PureBasic
- Python
- R
- Racket
- REXX
- Ruby
- Run BASIC
- Scala
- Scheme
- Seed7
- Smalltalk
- SNUSP
- Tcl
- TXR
- UNIX Shell
- C Shell
- Ursala
- Visual Basic .NET
- XPL0
