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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

29
Task/Hailstone-sequence/00DESCRIPTION
View file

@ -1,14 +1,21 @@
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 <code>= n/2</code>
* If n is odd then the next n of the sequence <code>= (3 * n) + 1</code>
The Hailstone sequence of numbers can be generated from a starting positive integer, &nbsp; n &nbsp; by:
* &nbsp; If &nbsp; n &nbsp; is &nbsp; &nbsp; '''1''' &nbsp; &nbsp; then the sequence ends.
* &nbsp; If &nbsp; n &nbsp; is &nbsp; '''even''' then the next &nbsp; n &nbsp; of the sequence &nbsp; <big><code> = n/2 </code></big>
* &nbsp; If &nbsp; n &nbsp; is &nbsp; '''odd''' &nbsp; then the next &nbsp; n &nbsp; of the sequence &nbsp; <big><code> = (3 * n) + 1 </code></big>
The (unproven), [[wp:Collatz conjecture|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 <code>27, 82, 41, 124</code> and ending with <code>8, 4, 2, 1</code>
# Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.<br> (But don't show the actual sequence!)
The (unproven), &nbsp; [[wp:Collatz conjecture|Collatz conjecture]] &nbsp; is that the hailstone sequence for any starting number always terminates.
'''See Also:'''<br>
* [http://xkcd.com/710 xkcd] (humourous).
The &nbsp; ''hailstone sequence'' &nbsp; is also known as &nbsp; ''hailstone numbers'' &nbsp; (because the values are usually subject to multiple descents and ascents like hailstones in a cloud). &nbsp; The &nbsp; ''hailstone sequence'' &nbsp; is also sometimes known as the &nbsp; ''Collatz sequence''.
;Task:
# &nbsp; Create a routine to generate the hailstone sequence for a number.
# &nbsp; Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with <code>27, 82, 41, 124</code> and ending with <code>8, 4, 2, 1</code>
# &nbsp; Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.<br> &nbsp; (But don't show the actual sequence!)
;See also:
* &nbsp; [http://xkcd.com/710 xkcd] (humourous).
<br><br>

2
Task/Hailstone-sequence/BASIC/hailstone-sequence-3.basic
View file

@ -85,7 +85,7 @@ Next
Print "The longest sequence is for "; max_x; ", it has a sequence length of "; max_seq
' empty keyboard buffer
While Inkey <> "" : Var _key_ = Inkey : Wend
While Inkey <> "" : Wend
Print : Print : Print "hit any key to end program"
Sleep
End

90
Task/Hailstone-sequence/COBOL/hailstone-sequence.cobol Normal file
View file

@ -0,0 +1,90 @@
identification division.
program-id. hailstones.
remarks. cobc -x hailstones.cob.
data division.
working-storage section.
01 most constant as 1000000.
01 coverage constant as 100000.
01 stones usage binary-long.
01 n usage binary-long.
01 storm usage binary-long.
01 show-arg pic 9(6).
01 show-default pic 99 value 27.
01 show-sequence usage binary-long.
01 longest usage binary-long occurs 2 times.
01 filler.
05 hail usage binary-long
occurs 0 to most depending on stones.
01 show pic z(10).
01 low-range usage binary-long.
01 high-range usage binary-long.
01 range usage binary-long.
01 remain usage binary-long.
01 unused usage binary-long.
procedure division.
accept show-arg from command-line
if show-arg less than 1 or greater than coverage then
move show-default to show-arg
end-if
move show-arg to show-sequence
move 1 to longest(1)
perform hailstone varying storm
from 1 by 1 until storm > coverage
display "Longest at: " longest(2) " with " longest(1) " elements"
goback.
*> **************************************************************
hailstone.
move 0 to stones
move storm to n
perform until n equal 1
if stones > most then
display "too many hailstones" upon syserr
stop run
end-if
add 1 to stones
move n to hail(stones)
divide n by 2 giving unused remainder remain
if remain equal 0 then
divide 2 into n
else
compute n = 3 * n + 1
end-if
end-perform
add 1 to stones
move n to hail(stones)
if stones > longest(1) then
move stones to longest(1)
move storm to longest(2)
end-if
if storm equal show-sequence then
display show-sequence ": " with no advancing
perform varying range from 1 by 1 until range > stones
move 5 to low-range
compute high-range = stones - 4
if range < low-range or range > high-range then
move hail(range) to show
display function trim(show) with no advancing
if range < stones then
display ", " with no advancing
end-if
end-if
if range = low-range and stones > 8 then
display "..., " with no advancing
end-if
end-perform
display ": " stones " elements"
end-if
.
end program hailstones.

30
Task/Hailstone-sequence/Frink/hailstone-sequence.frink Normal file
View file

@ -0,0 +1,30 @@
hailstone[n] :=
{
results = new array
while n != 1
{
results.push[n]
if n mod 2 == 0 // n is even?
n = n / 2
else
n = (3n + 1)
}
results.push[1]
return results
}
longestLen = 0
longestN = 0
for n = 1 to 100000
{
seq = hailstone[n]
if length[seq] > longestLen
{
longestLen = length[seq]
longestN = n
}
}
println["$longestN has length $longestLen"]

1
Task/Hailstone-sequence/Io/hailstone-sequence.io
View file

@ -7,6 +7,7 @@ makeItHail := method(n,
)
stones append(n)
)
stones
)
out := makeItHail(27)

25
Task/Hailstone-sequence/Kotlin/hailstone-sequence.kotlin
View file

@ -1,29 +1,24 @@
import java.util.ArrayDeque
fun hailstone(n : Int) : ArrayDeque<Int> {
fun hailstone(n: Int): ArrayDeque<Int> {
val hails = when {
n == 1 -> ArrayDeque<Int>()
n % 2 == 0 -> hailstone(n / 2)
else -> hailstone(3 * n + 1)
}
hails addFirst(n)
hails.addFirst(n)
return hails
}
fun main(args : Array<String>) {
fun main(args: Array<String>) {
val hail27 = hailstone(27)
fun showSeq(s : List<Int>) = s map {it.toString()} reduce {a, b -> a + ", " + b}
System.out.println(
"Hailstone sequence for 27 is " +
showSeq(hail27 take(3)) + " ... " + showSeq(hail27 drop(hail27.size - 3)) +
" with length ${hail27.size}."
)
fun showSeq(s: List<Int>) = s.map { it.toString() }.reduce { a, b -> a + ", " + b }
println("Hailstone sequence for 27 is " + showSeq(hail27.take(3)) + " ... "
+ showSeq(hail27.drop(hail27.size - 3)) + " with length ${hail27.size}.")
var longestHail = hailstone(1)
for (x in 1 .. 99999)
longestHail = array(hailstone(x), longestHail) maxBy {it.size} ?: longestHail
System.out.println(
"${longestHail.getFirst()} is the number less than 100000 with " +
"the longest sequence, having length ${longestHail.size}."
)
for (x in 1..99999)
longestHail = arrayOf(hailstone(x), longestHail).maxBy { it.size } ?: longestHail
println("${longestHail.first} is the number less than 100000 with " +
"the longest sequence, having length ${longestHail.size}.")
}

2
Task/Hailstone-sequence/Mathematica/hailstone-sequence-1.math
View file

@ -1 +1 @@
HailstoneFP[n_Integer] := Most[FixedPointList[Which[# == 1, 1, EvenQ[#] , #/2, OddQ[#], (3*# + 1)] &, n]]
HailstoneF[n_] := NestWhileList[If[OddQ@#, 3 # + 1, #/2] &, n, # > 1 &]

4
Task/Hailstone-sequence/Mathematica/hailstone-sequence-2.math
View file

@ -1,3 +1 @@
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
HailstoneFP[n_] := Most@FixedPointList[Switch[#, 1, 1, _?OddQ , 3# + 1, _, #/2] &, n]

7
Task/Hailstone-sequence/Mathematica/hailstone-sequence-3.math
View file

@ -1,4 +1,3 @@
hailstone[n_Integer] := Block[{sequence = {}, c = n},
While[c > 1, c = If[EvenQ[c], c/2, 3 c + 1];
AppendTo[sequence, c]];
sequence]
HailstoneR[1] = {1}
HailstoneR[n_?OddQ] := Prepend[HailstoneR[3 n + 1], n]
HailstoneR[n_] := Prepend[HailstoneR[n/2], n]

14
Task/Hailstone-sequence/Mathematica/hailstone-sequence-4.math
View file

@ -1,12 +1,2 @@
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];
HailstoneP[n_] := Module[{x = {n}, s = n},
While[s > 1, x = {x, s = If[OddQ@s, 3 s + 1, s/2]}]; Flatten@x]

15
Task/Hailstone-sequence/Mathematica/hailstone-sequence-5.math
View file

@ -1 +1,14 @@
With[{seq = HailstoneFP[27]}, { Length[seq], Take[seq, 4], Take[seq, -4]}]
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];

2
Task/Hailstone-sequence/Mathematica/hailstone-sequence-6.math
View file

@ -1 +1 @@
Short[HailstoneFP[27],0.45]
With[{seq = HailstoneFP[27]}, { Length[seq], Take[seq, 4], Take[seq, -4]}]

2
Task/Hailstone-sequence/Mathematica/hailstone-sequence-7.math
View file

@ -1 +1 @@
MaximalBy[Table[{i, Length[HailstoneFP[i]]}, {i, 100000}], Last]
Short[HailstoneFP[27],0.45]

1
Task/Hailstone-sequence/Mathematica/hailstone-sequence-8.math Normal file
View file

@ -0,0 +1 @@
MaximalBy[Table[{i, Length[HailstoneFP[i]]}, {i, 100000}], Last]

0
Task/Hailstone-sequence/PARI-GP/hailstone-sequence.pari → Task/Hailstone-sequence/PARI-GP/hailstone-sequence-1.pari
View file

22
Task/Hailstone-sequence/PARI-GP/hailstone-sequence-2.pari Normal file
View file

@ -0,0 +1,22 @@
\\ Get vector with Collatz sequence for the specified starting number.
\\ Limit vector to the lim length, or less, if 1 (one) term is reached (when lim=0).
\\ 3/26/2016 aev
Collatz(n,lim=0)={
my(c=n,e=0,L=List(n)); if(lim==0, e=1; lim=n*10^6);
for(i=1,lim, if(c%2==0, c=c/2, c=3*c+1); listput(L,c); if(e&&c==1, break));
return(Vec(L)); }
Collatzmax(ns,nf)={
my(V,vn,mxn=1,mx,im=1);
print("Search range: ",ns,"..",nf);
for(i=ns,nf, V=Collatz(i); vn=#V; if(vn>mxn, mxn=vn; im=i); kill(V));
print("Hailstone/Collatz(",im,") has the longest length = ",mxn);
}
{
\\ Required tests:
print("Required tests:");
my(Vr,vrn);
Vr=Collatz(27); vrn=#Vr;
print("Hailstone/Collatz(27): ",Vr[1..4]," ... ",Vr[vrn-3..vrn],"; length = ",vrn);
Collatzmax(1,100000);
}

159
Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal
View file

@ -4,91 +4,106 @@ program ShowHailstoneSequence;
{$Else}
{$Apptype Console} // for delphi
{$ENDIF}
uses
SysUtils;// format
type
tIntArr = record
iaAktPos : integer;
iaMaxPos : integer;
iaArr : array of integer;
end;
const
maxN = 10*1000*1000;// for output 1000*1000*1000
procedure GetHailstoneSequence(aStartingNumber: Integer;var aHailstoneList: tIntArr);
type
tiaArr = array[0..1000] of Uint64;
tIntArr = record
iaMaxPos : integer;
iaArr : tiaArr
end;
tpiaArr = ^tiaArr;
function HailstoneSeqCnt(n: UInt64): NativeInt;
begin
result := 0;
//ensure n to be odd
while not(ODD(n)) do
Begin
inc(result);
n := n shr 1;
end;
IF n > 1 then
repeat
//now n == odd -> so two steps in one can be made
repeat
n := (3*n+1) SHR 1;inc(result,2);
until NOT(Odd(n));
//now n == even -> so only one step can be made
repeat
n := n shr 1; inc(result);
until odd(n);
until n = 1;
end;
procedure GetHailstoneSequence(aStartingNumber: NativeUint;var aHailstoneList: tIntArr);
var
maxPos: NativeInt;
n: UInt64;
pArr : tpiaArr;
begin
with aHailstoneList do
begin
iaAktPos := 0;
iaArr[iaAktPos] := aStartingNumber;
n := aStartingNumber;
while n <> 1 do
begin
if Odd(n) then
n := (3 * n) + 1
else
n := n div 2;
inc(iaAktPos);
IF iaAktPos>iaMaxPos then
Begin
iaMaxPos := round(iaMaxPos*1.62)+2;
setlength(iaArr,iaMaxPos+1);
end;
iaArr[iaAktPos] := n;
end;
maxPos := 0;
pArr := @iaArr;
end;
n := aStartingNumber;
pArr^[maxPos] := n;
while n <> 1 do
begin
if odd(n) then
n := (3*n+1)
else
n := n shr 1;
inc(maxPos);
pArr^[maxPos] := n;
end;
aHailstoneList.iaMaxPos := maxPos;
end;
var
i,Limit: Integer;
i,Limit: NativeInt;
lList: tIntArr;
lMaxSequence: Integer;
lMaxLength: Integer;
lAverageLength:Uint64;
lMaxSequence: NativeInt;
lMaxLength,lgth: NativeInt;
begin
try
with lList do
begin
setlength(iaArr,0+1);
iaMaxPos := 0;
iaAktPos := 0;
end;
GetHailstoneSequence(27, lList);
with lList do
begin
i := iaAktPos+1;
Writeln(Format('27: %d elements', [i]));
Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]',
[iaArr[0], iaArr[1], iaArr[2], iaArr[3],
iaArr[i - 4], iaArr[i - 3], iaArr[i - 2], iaArr[i - 1]]));
Writeln;
lMaxSequence := 0;
lMaxLength := 0;
limit := 10;
for i := 1 to 10000000 do
begin
GetHailstoneSequence(i, lList);
if iaAktPos >= lMaxLength then
begin
IF i> limit then
begin
Writeln(Format('Longest sequence under %8d : %7d with %3d elements',
[limit,lMaxSequence, lMaxLength]));
limit := limit*10;
end;
lMaxSequence := i;
lMaxLength := iaAktPos+1;
end;
end;
Writeln(Format('Longest sequence under %8d : %7d with %3d elements',
[limit,lMaxSequence, lMaxLength]));
end;
finally
setlength(lList.iaArr,0);
lList.iaMaxPos := 0;
GetHailstoneSequence(27, lList);//319804831
with lList do
begin
Limit := iaMaxPos;
writeln(Format('sequence of %d has %d elements',[iaArr[0],Limit+1]));
write(iaArr[0],',',iaArr[1],',',iaArr[2],',',iaArr[3],'..');
For i := iaMaxPos-3 to iaMaxPos-1 do
write(iaArr[i],',');
writeln(iaArr[iaMaxPos]);
end;
writeln('game over, wait for >ENTER< ');
Readln;
Writeln;
lMaxSequence := 0;
lMaxLength := 0;
i := 1;
limit := 10*i;
writeln(' Limit : number with max length | average length');
repeat
lAverageLength:= 0;
repeat
lgth:= HailstoneSeqCnt(i);
inc(lAverageLength, lgth);
if lgth >= lMaxLength then
begin
lMaxSequence := i;
lMaxLength := lgth+1;
end;
inc(i);
until i = Limit;
Writeln(Format(' %10d : %9d | %4d | %7.3f',
[limit,lMaxSequence, lMaxLength,0.9*lAverageLength/Limit]));
limit := limit*10;
until Limit > maxN;
end.

4
Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6
View file

@ -4,5 +4,5 @@ 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";
my $m = max (+hailstone($_) => $_ for 1..99_999);
say "Max length {$m.key} was found for hailstone({$m.value}) for numbers < 100_000";

31
Task/Hailstone-sequence/REBOL/hailstone-sequence.rebol Normal file
View file

@ -0,0 +1,31 @@
hail: func [
"Returns the hailstone sequence for n"
n [integer!]
/local seq
] [
seq: copy reduce [n]
while [n <> 1] [
append seq n: either n % 2 == 0 [n / 2] [3 * n + 1]
]
seq
]
hs27: hail 27
print [
"the hail sequence of 27 has length" length? hs27
"and has the form " copy/part hs27 3 "..."
back back back tail hs27
]
maxN: maxLen: 0
repeat n 99999 [
if (len: length? hail n) > maxLen [
maxN: n
maxLen: len
]
]
print [
"the number less than 100000 with the longest hail sequence is"
maxN "with length" maxLen
]

52
Task/Hailstone-sequence/REXX/hailstone-sequence-1.rexx
View file

@ -1,28 +1,26 @@
/*REXX pgm tests a number and also a range for hailstone (Collatz) sequences. */
numeric digits 20 /*be able to handle gihugeic numbers. */
parse arg x y . /*get optional arguments from the C.L. */
if x=='' | x==',' then x=27 /*No 1st argument? Then use default.*/
if y=='' | y==',' then y=100000-1 /* " 2nd " " " " */
$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, 4) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(5, words($)-3))
if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
/*REXX program tests a number and also a range for hailstone (Collatz) sequences. */
numeric digits 20 /*be able to handle gihugeic numbers. */
parse arg x y . /*get optional arguments from the C.L. */
if x=='' | x=="," then x= 27 /*No 1st argument? Then use default.*/
if y=='' | y=="," then y= 100000 - 1 /* " 2nd " " " " */
$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, 4) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(5, words($)-3))
if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say
w=0; do j=1 for y /*traipse through the range of numbers.*/
call hailstone j /*compute the hailstone sequence for J.*/
if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/
bigJ=j; w=#hs /*remember what # has biggest hailstone*/
end /*j*/
say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w
say 'and took'
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────HAILSTONE subroutine──────────────────────*/
hailstone: procedure expose #hs; parse arg n 1 s /*N & S are set to 1st arg.*/
do #hs=1 while n\==1 /*keep loop while N isn't unity. */
if n//2 then n=n*3 + 1 /*N is odd ? Then calculate 3*n + 1 */
else n=n%2 /*" " even? Then calculate fast ÷ */
s=s n /* [↑] % is REXX integer division. */
end /*#hs*/ /* [↑] append N to the sequence list*/
return s /*return the S string to the invoker.*/
w=0; do j=1 for y /*traipse through the range of numbers.*/
call hailstone j /*compute the hailstone sequence for J.*/
if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/
bigJ=j; w=#hs /*remember what # has biggest hailstone*/
end /*j*/
say '(between 1 ──►' y") " bigJ ' has the longest hailstone sequence: ' w
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hailstone: procedure expose #hs; parse arg n 1 s /*N and S: are set to the 1st argument.*/
do #hs=1 while n\==1 /*keep loop while N isn't unity. */
if n//2 then n=n*3 + 1 /*N is odd ? Then calculate 3*n + 1 */
else n=n%2 /*" " even? Then calculate fast ÷ */
s=s n /* [↑] % is REXX integer division. */
end /*#hs*/ /* [↑] append N to the sequence list*/
return s /*return the S string to the invoker.*/

73
Task/Hailstone-sequence/REXX/hailstone-sequence-2.rexx
View file

@ -1,38 +1,37 @@
/*REXX pgm tests a number and also a range for hailstone (Collatz) sequences. */
!.=0; !.0=1; !.2=1; !.4=1; !.6=1; !.8=1 /*assign even digits to be "true". */
numeric digits 20; @.=0 /*handle big numbers; initialize array.*/
parse arg x y z .; !.h=y /*get optional arguments from the C,L. */
if x=='' | x==',' then x=27 /*No 1st argument? Then use default.*/
if y=='' | y==',' then y=100000-1 /* " 2nd " " " " */
if z=='' | z==',' then z=12 /*head/tail number? " " " */
$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, z) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(z+1, words($)-z+1))
say /*Z: show first & last Z numbers*/
if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
w=0; do j=1 for y /*traipse through the range of numbers.*/
$=hailstone(j) /*compute the hailstone sequence for J.*/
#hs=words($) /*find the length of the hailstone seq.*/
if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/
bigJ=j; w=#hs /*remember what # has biggest hailstone*/
/*REXX program tests a number and also a range for hailstone (Collatz) sequences. */
!.=0; !.0=1; !.2=1; !.4=1; !.6=1; !.8=1 /*assign even numerals to be "true". */
numeric digits 20; @.=0 /*handle big numbers; initialize array.*/
parse arg x y z .; !.h=y /*get optional arguments from the C,L. */
if x=='' | x=="," then x= 27 /*No 1st argument? Then use default.*/
if y=='' | y=="," then y=100000 - 1 /* " 2nd " " " " */
if z=='' | z=="," then z= 12 /*head/tail number? " " " */
hm=max(y, 40000) /*use memoization (maximum num for @.)*/
$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, z) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(z+1, words($)-z+1))
if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
say
w=0; do j=1 for y; $=hailstone(j) /*traipse through the range of numbers.*/
#hs=words($) /*find the length of the hailstone seq.*/
if #hs<=w then iterate /*Not big enough? Then keep traipsing.*/
bigJ=j; w=#hs /*remember what # has biggest hailstone*/
end /*j*/
say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────HAILSTONE subroutine──────────────────────*/
hailstone: procedure expose @. !.; parse arg n 1 s 1 o /*N,S,O are 1st arg.*/
@.1= /*handle the special case for unity (1)*/
do while @.n==0 /*loop while the residual is unknown. */
parse var n '' -1 L /*extract the last decimal digit of N.*/
if !.L then n=n%2 /*N is even? Then calculate fast ÷ */
else n=n*3 + 1 /*? ? odd ? Then calculate 3*n + 1 */
s=s n /* [↑] %: is the REXX integer division*/
end /*#hs*/ /* [↑] append N to the sequence list*/
s=s @.n /*append the number to a sequence list.*/
@.o=subword(s,2) /*use memoization for this hailstone #.*/
r=s; h=!.h
do while r\==''; parse var r _ r /*get next the subsequence. */
if @._\==0 then return s /*Already found? Return S. */
if _>! then return s /*Out of range? Return S. */
@._=r /*assign the subsequence #. */
end /*while*/
say '(between 1 ──►' y") " bigJ ' has the longest hailstone sequence: ' w
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hailstone: procedure expose @. !. hm; parse arg n 1 s 1 o,@.1 /*N,S,O: are the 1st arg*/
do while @.n==0 /*loop while the residual is unknown. */
parse var n '' -1 L /*extract the last decimal digit of N.*/
if !.L then n=n%2 /*N is even? Then calculate fast ÷ */
else n=n*3 + 1 /*? ? odd ? Then calculate 3*n + 1 */
s=s n /* [↑] %: is the REXX integer division*/
end /*while*/ /* [↑] append N to the sequence list*/
s=s @.n /*append the number to a sequence list.*/
@.o=subword(s, 2); parse var s _ r /*use memoization for this hailstone #.*/
do while r\==''; parse var r _ r /*obtain the next hailstone sequence. */
if @._\==0 then leave /*Was number already found? Return S.*/
if _>hm then iterate /*Is number out of range? Ignore it.*/
@._=r /*assign subsequence number to array. */
end /*while*/
return s

45
Task/Hailstone-sequence/S-lang/hailstone-sequence.slang Normal file
View file

@ -0,0 +1,45 @@
% lst=1, return list of elements; lst=0 just return length
define hailstone(n, lst)
{
variable l;
if (lst) l = {n};
else l = 1;
while (n > 1) {
if (n mod 2)
n = 3 * n + 1;
else
n /= 2;
if (lst)
list_append(l, n);
else
l++;
% if (prn) () = printf("%d, ", n);
}
% if (prn) () = printf("\n");
return l;
}
variable har = list_to_array(hailstone(27, 1)), more = 0;
() = printf("Hailstone(27) has %d elements starting with:\n\t", length(har));
foreach $1 (har[[0:3]])
() = printf("%d, ", $1);
() = printf("\nand ending with:\n\t");
foreach $1 (har[[length(har)-4:]]) {
if (more) () = printf(", ");
more = printf("%d", $1);
}
() = printf("\ncalculating...\r");
variable longest, longlen = 0, h;
_for $1 (2, 99999, 1) {
$2 = hailstone($1, 0);
if ($2 > longlen) {
longest = $1;
longlen = $2;
() = printf("longest sequence started w/%d and had %d elements \r", longest, longlen);
}
}
() = printf("\n");

21
Task/Hailstone-sequence/ZX-Spectrum-Basic/hailstone-sequence.zx Normal file
View file

@ -0,0 +1,21 @@
10 LET n=27: LET s=1
20 GO SUB 1000
30 PRINT '"Sequence length = ";seqlen
40 LET maxlen=0: LET s=0
50 FOR m=2 TO 100000
60 LET n=m
70 GO SUB 1000
80 IF seqlen>maxlen THEN LET maxlen=seqlen: LET maxnum=m
90 NEXT m
100 PRINT "The number with the longest hailstone sequence is ";maxnum
110 PRINT "Its sequence length is ";maxlen
120 STOP
1000 REM Hailstone
1010 LET l=0
1020 IF s THEN PRINT n;" ";
1030 IF n=1 THEN LET seqlen=l+1: RETURN
1040 IF FN m(n,2)=0 THEN LET n=INT (n/2): GO TO 1060
1050 LET n=3*n+1
1060 LET l=l+1
1070 GO TO 1020
2000 DEF FN m(a,b)=a-INT (a/b)*b