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

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Hailstone-sequence/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Hailstone_sequence

35
Task/Hailstone-sequence/00-TASK.txt Normal file
View file

@ -0,0 +1,35 @@
The Hailstone sequence of numbers can be generated from a starting positive integer,   n   by:
*   If   n   is     '''1'''     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.
This sequence was named by Lothar Collatz in 1937 &nbsp; (or possibly in 1939), &nbsp; and is also known as (the):
:::* &nbsp; hailstone sequence, &nbsp; hailstone numbers
:::* &nbsp; 3x + 2 mapping, &nbsp; 3n + 1 problem
:::* &nbsp; Collatz sequence
:::* &nbsp; Hasse's algorithm
:::* &nbsp; Kakutani's problem
:::* &nbsp; Syracuse algorithm, &nbsp; Syracuse problem
:::* &nbsp; Thwaites conjecture
:::* &nbsp; Ulam's problem
The hailstone sequence is also known as &nbsp; ''hailstone numbers'' &nbsp; (because the values are usually subject to multiple descents and ascents like hailstones in a cloud).
;Task:
# 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> &nbsp; (But don't show the actual sequence!)
;See also:
* &nbsp; [http://xkcd.com/710 xkcd] (humourous).
* &nbsp; [https://terrytao.files.wordpress.com/2020/02/collatz.pdf The Notorious Collatz conjecture] Terence Tao, UCLA (Presentation, pdf).
* &nbsp; [https://www.youtube.com/watch?v=094y1Z2wpJg The Simplest Math Problem No One Can Solve] Veritasium (video, sponsored).
<br><br>

12
Task/Hailstone-sequence/11l/hailstone-sequence.11l Normal file
View file

@ -0,0 +1,12 @@
F hailstone(=n)
V seq = [n]
L n > 1
n = I n % 2 != 0 {3 * n + 1} E n I/ 2
seq.append(n)
R seq
V h = hailstone(27)
assert(h.len == 112 & h[0.<4] == [27, 82, 41, 124] & h[(len)-4 ..] == [8, 4, 2, 1])
V m = max((1..99999).map(i -> (hailstone(i).len, i)))
print(‘Maximum length #. was found for hailstone(#.) for numbers <100,000’.format(m[0], m[1]))

103
Task/Hailstone-sequence/360-Assembly/hailstone-sequence.360 Normal file
View file

@ -0,0 +1,103 @@
* Hailstone sequence 16/08/2015
HAILSTON CSECT
USING HAILSTON,R12
LR R12,R15
ST R14,SAVER14
BEGIN L R11,=F'100000' nmax
LA R8,27 n=27
LR R1,R8
MVI FTAB,X'01' ftab=true
BAL R14,COLLATZ
LR R10,R1 p
XDECO R8,XDEC n
MVC BUF1+10(6),XDEC+6
XDECO R10,XDEC p
MVC BUF1+18(5),XDEC+7
LA R5,6
LA R3,0 i
LA R4,BUF1+25
LOOPED L R2,TAB(R3) tab(i)
XDECO R2,XDEC
MVC 0(7,R4),XDEC+5
LA R3,4(R3) i=i+1
LA R4,7(R4)
C R5,=F'4'
BNE BCT
LA R4,7(R4)
BCT BCT R5,LOOPED
XPRNT BUF1,80 print hailstone(n)=p,tab(*)
MVC LONGEST,=F'0' longest=0
MVI FTAB,X'00' ftab=true
LA R8,1 i
LOOPI CR R8,R11 do i=1 to nmax
BH ELOOPI
LR R1,R8 n
BAL R14,COLLATZ
LR R10,R1 p
L R4,LONGEST
CR R4,R10 if longest<p
BNL NOTSUP
ST R8,IVAL ival=i
ST R10,LONGEST longest=p
NOTSUP LA R8,1(R8) i=i+1
B LOOPI
ELOOPI EQU * end i
XDECO R11,XDEC maxn
MVC BUF2+9(6),XDEC+6
L R1,IVAL ival
XDECO R1,XDEC
MVC BUF2+28(6),XDEC+6
L R1,LONGEST longest
XDECO R1,XDEC
MVC BUF2+36(5),XDEC+7
XPRNT BUF2,80 print maxn,hailstone(ival)=longest
B RETURN
* * * r1=collatz(r1)
COLLATZ LR R7,R1 m=n (R7)
LA R6,1 p=1 (R6)
LOOPP C R7,=F'1' do p=1 by 1 while(m>1)
BNH ELOOPP
CLI FTAB,X'01' if ftab
BNE NONOK
C R6,=F'1' if p>=1
BL NONOK
C R6,=F'3' & p<=3
BH NONOK
LR R1,R6 then
BCTR R1,0
SLA R1,2
ST R7,TAB(R1) tab(p)=m
NONOK LR R4,R7 m
N R4,=F'1' m&1
LTR R4,R4 if m//2=0 (if not(m&1))
BNZ ODD
EVEN SRA R7,1 m=m/2
B EIFM
ODD LA R3,3
MR R2,R7 *m
LA R7,1(R3) m=m*3+1
EIFM CLI FTAB,X'01' if ftab
BNE NEXTP
MVC TAB+12,TAB+16 tab(4)=tab(5)
MVC TAB+16,TAB+20 tab(5)=tab(6)
ST R7,TAB+20 tab(6)=m
NEXTP LA R6,1(R6) p=p+1
B LOOPP
ELOOPP LR R1,R6 end p; return(p)
BR R14 end collatz
*
RETURN L R14,SAVER14 restore caller address
XR R15,R15 set return code
BR R14 return to caller
SAVER14 DS F
IVAL DS F
LONGEST DS F
N DS F
TAB DS 6F
FTAB DS X
BUF1 DC CL80'hailstone(nnnnnn)=nnnnn : nnnnnn nnnnnn nnnnnn ...*
... nnnnnn nnnnnn nnnnnn'
BUF2 DC CL80'longest <nnnnnn : hailstone(nnnnnn)=nnnnn'
XDEC DS CL12
YREGS
END HAILSTON

89
Task/Hailstone-sequence/ABAP/hailstone-sequence.abap Normal file
View file

@ -0,0 +1,89 @@
CLASS lcl_hailstone DEFINITION.
PUBLIC SECTION.
TYPES: tty_sequence TYPE STANDARD TABLE OF i
WITH NON-UNIQUE EMPTY KEY,
BEGIN OF ty_seq_len,
start TYPE i,
len TYPE i,
END OF ty_seq_len,
tty_seq_len TYPE HASHED TABLE OF ty_seq_len
WITH UNIQUE KEY start.
CLASS-METHODS:
get_next
IMPORTING
n TYPE i
RETURNING
VALUE(r_next_hailstone_num) TYPE i,
get_sequence
IMPORTING
start TYPE i
RETURNING
VALUE(r_sequence) TYPE tty_sequence,
get_longest_sequence_upto
IMPORTING
limit TYPE i
RETURNING
VALUE(r_longest_sequence) TYPE ty_seq_len.
PRIVATE SECTION.
TYPES: BEGIN OF ty_seq,
start TYPE i,
seq TYPE tty_sequence,
END OF ty_seq.
CLASS-DATA: sequence_buffer TYPE HASHED TABLE OF ty_seq
WITH UNIQUE KEY start.
ENDCLASS.
CLASS lcl_hailstone IMPLEMENTATION.
METHOD get_next.
r_next_hailstone_num = COND #( WHEN n MOD 2 = 0 THEN n / 2
ELSE ( 3 * n ) + 1 ).
ENDMETHOD.
METHOD get_sequence.
INSERT start INTO TABLE r_sequence.
IF start = 1.
RETURN.
ENDIF.
READ TABLE sequence_buffer ASSIGNING FIELD-SYMBOL(<buff>)
WITH TABLE KEY start = start.
IF sy-subrc = 0.
INSERT LINES OF <buff>-seq INTO TABLE r_sequence.
ELSE.
DATA(seq) = get_sequence( get_next( start ) ).
INSERT LINES OF seq INTO TABLE r_sequence.
INSERT VALUE ty_seq( start = start
seq = seq ) INTO TABLE sequence_buffer.
ENDIF.
ENDMETHOD.
METHOD get_longest_sequence_upto.
DATA: max_seq TYPE ty_seq_len,
act_seq TYPE ty_seq_len.
DO limit TIMES.
act_seq-len = lines( get_sequence( sy-index ) ).
IF act_seq-len > max_seq-len.
max_seq-len = act_seq-len.
max_seq-start = sy-index.
ENDIF.
ENDDO.
r_longest_sequence = max_seq.
ENDMETHOD.
ENDCLASS.
START-OF-SELECTION.
cl_demo_output=>begin_section( |Hailstone sequence of 27 is: | ).
cl_demo_output=>write( REDUCE string( INIT result = ``
FOR item IN lcl_hailstone=>get_sequence( 27 )
NEXT result = |{ result } { item }| ) ).
cl_demo_output=>write( |With length: { lines( lcl_hailstone=>get_sequence( 27 ) ) }| ).
cl_demo_output=>begin_section( |Longest hailstone sequence upto 100k| ).
cl_demo_output=>write( lcl_hailstone=>get_longest_sequence_upto( 100000 ) ).
cl_demo_output=>display( ).

16
Task/Hailstone-sequence/ACL2/hailstone-sequence.acl2 Normal file
View file

@ -0,0 +1,16 @@
(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)))))

43
Task/Hailstone-sequence/ALGOL-60/hailstone-sequence.alg Normal file
View file

@ -0,0 +1,43 @@
begin
comment Hailstone sequence - Algol 60;
integer array collatz[1:400]; integer icollatz;
integer procedure mod(i,j); value i,j; integer i,j;
mod:=i-(i div j)*j;
integer procedure hailstone(num);
value num; integer num;
begin
integer i,n;
icollatz:=1; n:=num; i:=0;
collatz[icollatz]:=n;
for i:=i+1 while n notequal 1 do begin
if mod(n,2)=0 then n:=n div 2
else n:=(3*n)+1;
icollatz:=icollatz+1;
collatz[icollatz]:=n
end;
hailstone:=icollatz
end hailstone;
integer i,nn,ncollatz,count,nlongest,nel,nelcur,nnn;
nn:=27;
ncollatz:=hailstone(nn);
outstring(1,"sequence for"); outinteger(1,nn); outstring(1," :\n");
for i:=1 step 1 until ncollatz do outinteger(1,collatz[i]);
outstring(1,"\n");
outstring(1,"number of elements:"); outinteger(1,ncollatz);
outstring(1,"\n\n");
nlongest:=0; nel:=0; nnn:=100000;
for count:=1, count+1 while count<nnn do begin
nelcur:=hailstone(count);
if nelcur>nel then begin
nel:=nelcur;
nlongest:=count
end
end;
outstring(1,"number <"); outinteger(1,nnn);
outstring(1,"with the longest sequence:"); outinteger(1,nlongest);
outstring(1,", with"); outinteger(1,nel); outstring(1,"elements.");
outstring(1,"\n")
end

47
Task/Hailstone-sequence/ALGOL-68/hailstone-sequence.alg Normal file
View file

@ -0,0 +1,47 @@
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))
#
)

60
Task/Hailstone-sequence/ALGOL-M/hailstone-sequence.alg Normal file
View file

@ -0,0 +1,60 @@
BEGIN
INTEGER N, LEN, YES, NO, LIMIT, LONGEST, NLONG;
% RETURN P MOD Q %
INTEGER FUNCTION MOD(P, Q);
INTEGER P, Q;
BEGIN
MOD := P - Q * (P / Q);
END;
% COMPUTE AND OPTIONALLY DISPLAY HAILSTONE SEQUENCE FOR N. %
% RETURN LENGTH OF SEQUENCE OR ZERO ON OVERFLOW. %
INTEGER FUNCTION HAILSTONE(N, DISPLAY);
INTEGER N, DISPLAY;
BEGIN
INTEGER LEN;
LEN := 1;
IF DISPLAY = 1 THEN WRITE("");
WHILE (N <> 1) AND (N > 0) DO
BEGIN
IF DISPLAY = 1 THEN WRITEON(N," ");
IF MOD(N,2) = 0 THEN
N := N / 2
ELSE
N := (N * 3) + 1;
LEN := LEN + 1;
END;
IF DISPLAY = 1 THEN WRITEON(N);
HAILSTONE := (IF N < 0 THEN 0 ELSE LEN);
END;
% EXERCISE THE FUNCTION %
YES := 1; NO := 0;
WRITE("DISPLAY HAILSTONE SEQUENCE FOR WHAT NUMBER?");
READ(N);
LEN := HAILSTONE(N, YES);
WRITE("SEQUENCE LENGTH =", LEN);
% FIND LONGEST SEQUENCE BEFORE OVERFLOW %
N := 2;
LONGEST := 1;
LEN := 2;
NLONG := 2;
LIMIT := 1000;
WRITE("SEARCHING FOR LONGEST SEQUENCE UP TO N =",LIMIT," ...");
WHILE (N < LIMIT) AND (LEN <> 0) DO
BEGIN
LEN := HAILSTONE(N, NO);
IF LEN > LONGEST THEN
BEGIN
LONGEST := LEN;
NLONG := N;
END;
N := N + 1;
END;
IF LEN = 0 THEN WRITE("SEARCH TERMINATED WITH OVERFLOW AT N =",N-1);
WRITE("MAXIMUM SEQUENCE LENGTH =", LONGEST, " FOR N =", NLONG);
END

75
Task/Hailstone-sequence/ALGOL-W/hailstone-sequence.alg Normal file
View file

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

18
Task/Hailstone-sequence/APL/hailstone-sequence-1.apl Normal file
View file

@ -0,0 +1,18 @@
⍝ recursive dfn:
dfnHailstone←{
c←⊃⌽⍵ ⍝ last element
1=c:1 ⍝ if it is 1, stop.
⍵,∇(1+2|c)⊃(c÷2)(1+3×c) ⍝ otherwise pick the next step, and append the result of the recursive call
}
⍝ tradfn version:
∇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
∇

10
Task/Hailstone-sequence/APL/hailstone-sequence-2.apl Normal file
View file

@ -0,0 +1,10 @@
dfnHailstone 5
5 16 8 4 2 1
5↑hailstone 27
27 82 41 124 62
¯5↑hailstone 27
16 8 4 2 1
⍴hailstone 27
112
1↑{⍵[⍒↑(⍴∘hailstone)¨⍵]}⍳100000
77031

150
Task/Hailstone-sequence/ARM-Assembly/hailstone-sequence-1.arm Normal file
View file

@ -0,0 +1,150 @@
.org 0x08000000
b ProgramStart
;cartridge header goes here
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Program Start
.equ ramarea, 0x02000000
.equ CursorX,ramarea
.equ CursorY,ramarea+1
.equ hailstoneram,0x02000004
ProgramStart:
mov sp,#0x03000000 ;Init Stack Pointer
mov r4,#0x04000000 ;DISPCNT - LCD Video Controller
mov r2,#0x403 ;4= Layer 2 on / 3= ScreenMode 3
str r2,[r4] ;now the user can see the screen
bl ResetTextCursors ;set text cursors to top left of screen. This routine, as well as the other I/O
; routines, were omitted to keep this entry short.
mov r0,#27
adr r1,HailStoneMessage_Init
bl PrintString
bl NewLine
bl ShowHex32
bl NewLine
bl NewLine
bl Hailstone
;function is complete, return the output
adr r1,HailStoneMessage_0
bl PrintString
bl NewLine
ldr r1,HailStoneRam_Mirror ;mov r2,0x02000004
ldr r0,[r1],#4
bl ShowHex32
bl NewLine
ldr r0,[r1],#4
bl ShowHex32
bl NewLine
ldr r0,[r1],#4
bl ShowHex32
bl NewLine
ldr r0,[r1],#4
bl ShowHex32
bl NewLine
bl NewLine
adr r1,HailStoneMessage_1
bl PrintString
bl NewLine
ldr r0,[r2],#4
bl ShowHex32
bl NewLine
ldr r0,[r2],#4
bl ShowHex32
bl NewLine
ldr r0,[r2],#4
bl ShowHex32
bl NewLine
ldr r0,[r2],#4
bl ShowHex32
bl NewLine
bl NewLine
adr r1,HailStoneMessage_2
bl PrintString
bl NewLine
mov r0,r3
bl ShowHex32
forever:
b forever ;we're done, so trap the program counter.
Hailstone:
;input: R0 = n.
;out: r2 = pointer to last 4 entries
; r3 = length of sequence
;reg usage:
;R1 = scratchpad
;R3 = counter for entries in the sequence.
;R5 = pointer to output ram
stmfd sp!,{r4-r12,lr}
mov r5,#0x02000000
add r5,r5,#4
str r0,[r5],#4 ;store in hailstone ram and post-inc by 4
mov r3,#0
loop_hailstone:
add r3,r3,#1 ;represents number of entries in the sequence
cmp r0,#1
beq hailstone_end
tst r0,#1
;;;; executes only if r0 was even
moveq r0,r0,lsr #1 ;divide
;;;; executes only if r0 was odd
movne r1,r0
movne r0,r0,lsl #1
addne r0,r1,r0
addne r0,r0,#1
str r0,[r5],#4 ;store in hailstone ram, post inc by 4
b loop_hailstone
hailstone_end:
sub r5,r5,#16 ;subtract 16 to get pointer to last 4 entries.
mov r2,r5 ;output ptr to last 4 entries to r2.
;pointer to first 4 entries is 0x02000004
ldmfd sp!,{r4-r12,pc}
HailStoneRam_Mirror:
.long 0x02000004
HailstoneMessage_Init:
.byte "Your input was:",255
.align 4
HailstoneMessage_0:
.byte "First 4 numbers are:",255
.align 4
HailstoneMessage_1:
.byte "Last 4 numbers are:",255
.align 4
HailstoneMessage_2:
.byte "Sequence length is:",255
.align 4
;;;;;;;;;;; EVERYTHING PAST THIS POINT IS JUST I/O ROUTINES FOR PRINTING NUMBERS AND WORDS TO THE GAME BOY ADVANCE'S SCREEN
;;;;;;;;;;; I ASSURE YOU THAT ALL OF IT WORKS BUT CHANCES ARE YOU DIDN'T COME HERE TO SEE THAT.
;;;;;;;;;;; THANKS TO KEITH OF CHIBIAKUMAS.COM FOR WRITING THEM!

39
Task/Hailstone-sequence/ARM-Assembly/hailstone-sequence-2.arm Normal file
View file

@ -0,0 +1,39 @@
mov r0,#1
bl Hailstone
mov r6,r3
mov r0,#2
mov r8,#100000
loop_getBiggestHailstone:
mov r10,r0
bl Hailstone
mov r0,r10
cmp r3,r6
movgt r6,r3 ;if greater than, store in r6
movgt r7,r0 ;if greater than, store in r7
add r0,r0,#1
cmp r0,r8
blt loop_getBiggestHailstone
adr r1,HailstoneMessage_0
bl PrintString
bl NewLine
adr r1,HailStoneMessage_1
bl PrintString
bl NewLine
mov r0,r7
bl ShowHex32
bl NewLine
adr r1,HailStoneMessage_2
bl PrintString
bl NewLine
mov r0,r6
bl ShowHex32
bl NewLine

29
Task/Hailstone-sequence/AWK/hailstone-sequence.awk Normal file
View file

@ -0,0 +1,29 @@
#!/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);
}

39
Task/Hailstone-sequence/Ada/hailstone-sequence-1.ada Normal file
View file

@ -0,0 +1,39 @@
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;

4
Task/Hailstone-sequence/Ada/hailstone-sequence-2.ada Normal file
View file

@ -0,0 +1,4 @@
package Hailstones is
type Integer_Sequence is array(Positive range <>) of Integer;
function Create_Sequence (N : Positive) return Integer_Sequence;
end Hailstones;

15
Task/Hailstone-sequence/Ada/hailstone-sequence-3.ada Normal file
View file

@ -0,0 +1,15 @@
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;

43
Task/Hailstone-sequence/Ada/hailstone-sequence-4.ada Normal file
View file

@ -0,0 +1,43 @@
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;

58
Task/Hailstone-sequence/Aime/hailstone-sequence.aime Normal file
View file

@ -0,0 +1,58 @@
void
print_hailstone(integer h)
{
list l;
while (h ^ 1) {
lb_p_integer(l, h);
h = h & 1 ? 3 * h + 1 : h / 2;
}
o_form("hailstone sequence for ~ is ~1 ~ ~ ~ .. ~ ~ ~ ~, it is ~ long\n",
l[0], l[1], l[2], l[3], l[-3], l[-2], l[-1], 1, ~l + 1);
}
void
max_hailstone(integer x)
{
integer e, i, m;
index r;
m = 0;
i = 1;
while (i < x) {
integer h, k, l;
h = i;
l = 1;
while (h ^ 1) {
if (i_j_integer(k, r, h)) {
l += k;
break;
} else {
l += 1;
h = h & 1 ? 3 * h + 1 : h / 2;
}
}
r[i] = l - 1;
if (m < l) {
m = l;
e = i;
}
i += 1;
}
o_form("hailstone sequence length for ~ is ~\n", e, m);
}
integer
main(void)
{
print_hailstone(27);
max_hailstone(100000);
return 0;
}

21
Task/Hailstone-sequence/AppleScript/hailstone-sequence-1.applescript Normal file
View file

@ -0,0 +1,21 @@
on hailstoneSequence(n)
script o
property sequence : {n}
end script
repeat until (n = 1)
if (n mod 2 is 0) then
set n to n div 2
else
set n to 3 * n + 1
end if
set end of o's sequence to n
end repeat
return o's sequence
end hailstoneSequence
set n to 27
tell hailstoneSequence(n)
return {n:n, |length of sequence|:(its length), |first 4 numbers|:items 1 thru 4, |last 4 numbers|:items -4 thru -1}
end tell

13
Task/Hailstone-sequence/AppleScript/hailstone-sequence-2.applescript Normal file
View file

@ -0,0 +1,13 @@
-- Number(s) below 100,000 giving the longest sequence length, using the hailstoneSequence(n) handler above.
set nums to {}
set longestLength to 1
repeat with n from 2 to 99999
set thisLength to (count hailstoneSequence(n))
if (thisLength < longestLength) then
else if (thisLength > longestLength) then
set nums to {n}
set longestLength to thisLength
else
set end of nums to n
end if
end repeat

32
Task/Hailstone-sequence/Applesoft-BASIC/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,32 @@
10 HOME
100 N = 27
110 GOSUB 400"HAILSTONE
120 DEF FN L(I) = E(I + 4 * (I < 0))
130IFL=112AND(S(0)=27ANDS(1)=82ANDS(2)=41ANDS(3)=124)AND(FNL(M-3)=8ANDFNL(M-2)=4ANDFNL(M-1)=2ANDFNL(M)=1)THENPRINT"THE HAILSTONE SEQUENCE FOR THE NUMBER 27 HAS 112 ELEMENTS STARTING WITH 27, 82, 41, 124 AND ENDING WITH 8, 4, 2, 1"
140 PRINT
150 V = PEEK(37) + 1
200 N = 1
210 GOSUB 400"HAILSTONE
220 MN = 1
230 ML = L
240 FOR I = 2 TO 99999
250 N = I
260 GOSUB 400"HAILSTONE
270 IFL>MLTHENMN=I:ML=L:VTABV:HTAB1:PRINT "THE NUMBER " MN " HAS A HAILSTONE SEQUENCE LENGTH OF "L" WHICH IS THE LONGEST HAILSTONE SEQUENCE OF NUMBERS LESS THAN ";:Y=PEEK(37)+1:X=PEEK(36)+1
280 IF Y THEN VTAB Y : HTAB X : PRINTI+1;
290 NEXT I
300 END
400 M = 0
410 FOR L = 1 TO 1E38
420 IF L < 5 THEN S(L-1) = N
430 M = (M + 1) * (M < 3)
440 E(M) = N
450 IF N = 1 THEN RETURN
460 EVEN = INT(N/2)=N/2
470 IF EVEN THEN N=N/2
480 IF NOT EVEN THEN N = (3 * N) + 1
490 NEXT L : STOP

26
Task/Hailstone-sequence/Arturo/hailstone-sequence.arturo Normal file
View file

@ -0,0 +1,26 @@
hailstone: function [n][
ret: @[n]
while [n>1][
if? 1 = and n 1 -> n: 1+3*n
else -> n: n/2
'ret ++ n
]
ret
]
print "Hailstone sequence for 27:"
print hailstone 27
maxHailstoneLength: 0
maxHailstone: 0
loop 2..1000 'x [
l: size hailstone x
if l>maxHailstoneLength [
maxHailstoneLength: l
maxHailstone: x
]
]
print ["max hailstone sequence found (<100000): of length" maxHailstoneLength "for" maxHailstone]

40
Task/Hailstone-sequence/AutoHotkey/hailstone-sequence.ahk Normal file
View file

@ -0,0 +1,40 @@
; 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

28
Task/Hailstone-sequence/AutoIt/hailstone-sequence.autoit Normal file
View file

@ -0,0 +1,28 @@
$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

23
Task/Hailstone-sequence/BBC-BASIC/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,23 @@
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

13
Task/Hailstone-sequence/BQN/hailstone-sequence-1.bqn Normal file
View file

@ -0,0 +1,13 @@
Collatz ← ⥊⊸{
𝕨𝕊1: 𝕨;
(𝕨⊸∾ 𝕊 ⊢) (2|𝕩)⊑⟨𝕩÷2⋄1+3×𝕩⟩
}
Collatz1 ← ⌽∘{
1: ⟨1⟩;
𝕩∾˜𝕊(2|𝕩)⊑⟨𝕩÷2⋄1+3×𝕩⟩
}
•Show Collatz1 5
•Show (⊑∾≠){𝕩⊑˜⊑⍒≠¨𝕩}Collatz1¨1+↕99999

2
Task/Hailstone-sequence/BQN/hailstone-sequence-2.bqn Normal file
View file

@ -0,0 +1,2 @@
⟨ 5 16 8 4 2 1 ⟩
⟨ 77031 351 ⟩

41
Task/Hailstone-sequence/Batch-File/hailstone-sequence-1.bat Normal file
View file

@ -0,0 +1,41 @@
@echo off
setlocal enabledelayedexpansion
echo.
::Task #1
call :hailstone 111
echo Task #1: (Start:!sav!)
echo !seq!
echo.
echo Sequence has !cnt! elements.
echo.
::Task #2
call :hailstone 27
echo Task #2: (Start:!sav!)
echo !seq!
echo.
echo Sequence has !cnt! elements.
echo.
pause>nul
exit /b 0
::The Function
:hailstone
set num=%1
set seq=%1
set sav=%1
set cnt=0
:loop
set /a cnt+=1
if !num! equ 1 goto :eof
set /a isodd=%num%%%2
if !isodd! equ 0 goto divideby2
set /a num=(3*%num%)+1
set seq=!seq! %num%
goto loop
:divideby2
set /a num/=2
set seq=!seq! %num%
goto loop

23
Task/Hailstone-sequence/Batch-File/hailstone-sequence-2.bat Normal file
View file

@ -0,0 +1,23 @@
@echo off
setlocal enableDelayedExpansion
if "%~1"=="test" (
for /l %%. in () do (
set /a "test1=num %% 2, cnt=cnt+1"
if !test1! equ 0 (set /a num/=2 & if !num! equ 1 exit !cnt!) else (set /a num=3*num+1)
)
)
set max=0
set record=0
for /l %%X in (2,1,100000) do (
set num=%%X & cmd /c "%~f0" test
if !errorlevel! gtr !max! (set /a "max=!errorlevel!,record=%%X")
)
set /a max+=1
echo.Number less than 100000 with longest sequence: %record%
echo.With length %max%.
pause>nul
exit /b 0

3
Task/Hailstone-sequence/Beeswax/hailstone-sequence-1.beeswax Normal file
View file

@ -0,0 +1,3 @@
>@:N q
>%"d3~@.PNp
d~2~pL~1F{<T_

4
Task/Hailstone-sequence/Beeswax/hailstone-sequence-2.beeswax Normal file
View file

@ -0,0 +1,4 @@
>@:N q
>%"d3~@.PNq
d~2~qL~1Ff{<BF3_
{NNgA<

30
Task/Hailstone-sequence/Beeswax/hailstone-sequence-3.beeswax Normal file
View file

@ -0,0 +1,30 @@
27
82
41
124
62
31
94
47
...
2158
1079
3238
1619
4858
2429
7288
3644
1822
...
16
8
4
2
1
112

5
Task/Hailstone-sequence/Beeswax/hailstone-sequence-4.beeswax Normal file
View file

@ -0,0 +1,5 @@
>@: q pf1_#
>%"d3~@.Pqf#{g?` `{gpK@~BP9~5@P@q'M<
d~2~pL~1Ff< < >?d
>zAg?MM@1~y@~gLpz2~yg@~3~hAg?M d
>?~fz1~y?yg@hhAg?Mb

1
Task/Hailstone-sequence/Beeswax/hailstone-sequence-5.beeswax Normal file
View file

@ -0,0 +1 @@
77031 351

18
Task/Hailstone-sequence/Befunge/hailstone-sequence.bf Normal file
View file

@ -0,0 +1,18 @@
93*:. v
> :2%v >
v+1*3_2/
>" ",:.v v<
<v v-1:< <
+1\_$1+v^ \
v .,+94<>^>::v
>" "03pv :* p
v67:" "< 0: 1
>p78p25 *^*p0
v!-1: <<*^<
9$_:0\ ^-^< v
v01g00:< 1 4
>g"@"*+`v^ <+
v01/"@":_ $ ^,
>p"@"%00p\$:^.
vg01g00 ,+49<
>"@"*+.@

43
Task/Hailstone-sequence/Bracmat/hailstone-sequence.bracmat Normal file
View file

@ -0,0 +1,43 @@
(
( 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."
)
)
);

82
Task/Hailstone-sequence/Brainf---/hailstone-sequence.bf Normal file
View file

@ -0,0 +1,82 @@
>>>>>>,>,>,<<
[
.[-<+>]
]
>
[
.[-<+>]
]
>
[
.[-<+>]
]
<<<<
>------------------------------------------------[<<+>>-]>
[
<<<
[<+>-]<
[>++++++++++<-]>
>>>
------------------------------------------------
[<<<+>>>-]>
[
<<<<
[<+>-]<
[>++++++++++<-]>
>>>>
------------------------------------------------
[<<<<+>>>>-]
]
<
<<<[>+<<<+>>-]>[-<+>]>>>>>>>>>++++[>+++++++++++<-]++++[>>++++++++<<-]<<<<<<<<<<
[
>>>>>>>>>>+>.>.<<<<<<<<<<<<
>>+>+<<<
[-[->]<]+
>>>[>]
<[-<]<[-]<
[>+>+<<-]>[<+>-]+
>[
<<<[->>>>+>+>+<<<<<<]>>>>>>
[-<<<<<<+>>>>>>]<[-<<<<<+>>>>>]<[-<<<<+>>>>]
<<<<+>>
-
>[-]]
<<[-]>[
<<[-<+>[-<->>>>>+>]<<<<<]>>>>[-<<<<+>>>>]<<
-]
<<[->+>+<<]>[-<+>]>
[>>+>+<<<-]>>>[<<<+>>>-]<<+>[<->[>++++++++++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]
++++++++[<++++++>-]>[<<+>>-]>[<<+>>-]<<]>]<[->>++++++++[<++++++>-]]<[.[-]<]<
-[+>]<
]
[This program never terminates! ]
[This program isn't complete, (it only prints the hailstone ]
[sequence of a number until 1) but it may help other people ]
[to make complete versions. ]
[ ]
[This program only takes in up to 3 digit numbers as input ]
[If you want to input 1 digit integers, add a 0 before. e.g ]
[04. ]
[ ]
[Summary: ]
[This program takes 16 memory cells of space. Their data is ]
[presented below: ]
[ ]
[Cell 0: Temp cell. ]
[Cell 1: Displays the current number. This changes based on ]
[Collatz' Conjecture. ]
[Cell 14: Displays length of the hailstone sequence. ]
[Cell 15: ASCII code for ",". ]
[Cell 16: ASCII code for " " (Space). ]
[Rest of the cells: Temp cells. ]

33
Task/Hailstone-sequence/Brat/hailstone-sequence.brat Normal file
View file

@ -0,0 +1,33 @@
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]}"

2
Task/Hailstone-sequence/Burlesque/hailstone-sequence.blq Normal file
View file

@ -0,0 +1,2 @@
blsq ) 27{^^^^2.%{3.*1.+}\/{2./}\/ie}{1!=}w!bx{\/+]}{\/isn!}w!L[
112

50
Task/Hailstone-sequence/C++/hailstone-sequence-1.cpp Normal file
View file

@ -0,0 +1,50 @@
#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;
}

38
Task/Hailstone-sequence/C++/hailstone-sequence-2.cpp Normal file
View file

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

51
Task/Hailstone-sequence/C-Shell/hailstone-sequence.csh Normal file
View file

@ -0,0 +1,51 @@
# 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."

44
Task/Hailstone-sequence/C-sharp/hailstone-sequence-1.cs Normal file
View file

@ -0,0 +1,44 @@
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);
}
}
}

42
Task/Hailstone-sequence/C-sharp/hailstone-sequence-2.cs Normal file
View file

@ -0,0 +1,42 @@
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));
}
}
}
}

41
Task/Hailstone-sequence/C/hailstone-sequence-1.c Normal file
View file

@ -0,0 +1,41 @@
#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;
}

31
Task/Hailstone-sequence/C/hailstone-sequence-2.c Normal file
View file

@ -0,0 +1,31 @@
#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;
}

76
Task/Hailstone-sequence/CLIPS/hailstone-sequence.clips Normal file
View file

@ -0,0 +1,76 @@
(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)
)

55
Task/Hailstone-sequence/CLU/hailstone-sequence.clu Normal file
View file

@ -0,0 +1,55 @@
% Generate the hailstone sequence for a number
hailstone = iter (n: int) yields (int)
while true do
yield(n)
if n=1 then break end
if n//2 = 0 then
n := n/2
else
n := 3*n + 1
end
end
end hailstone
% Make an array from an iterator
iter_array = proc [T,U: type] (i: itertype (U) yields (T), s: U) returns (array[T])
arr: array[T] := array[T]$[]
for item: T in i(s) do array[T]$addh(arr, item) end
return(arr)
end iter_array
start_up = proc ()
po: stream := stream$primary_output()
% Generate the hailstone sequence for 27
h27: array[int] := iter_array[int,int](hailstone, 27)
lo27: int := array[int]$low(h27)
hi27: int := array[int]$high(h27)
stream$putl(po, "The hailstone sequence for 27 has "
|| int$unparse(array[int]$size(h27)) || " elements.")
stream$puts(po, "The first 4 elements are:")
for i: int in int$from_to(lo27, lo27+3) do
stream$puts(po, " " || int$unparse(h27[i]))
end
stream$puts(po, ", and the last 4 elements are:")
for i: int in int$from_to(hi27-3, hi27) do
stream$puts(po, " " || int$unparse(h27[i]))
end
stream$putl(po, "")
% Find whichever sequence < 100 000 has the longest sequence
maxnum: int := 0
maxlen: int := 0
for i: int in int$from_to(1, 99999) do
len: int := array[int]$size(iter_array[int,int](hailstone, i))
if len > maxlen then
maxnum, maxlen := i, len
end
end
stream$putl(po, int$unparse(maxnum)
|| " has the longest hailstone sequence < 100000: "
|| int$unparse(maxlen))
end start_up

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.

23
Task/Hailstone-sequence/Ceylon/hailstone-sequence.ceylon Normal file
View file

@ -0,0 +1,23 @@
shared void run() {
{Integer*} hailstone(variable Integer n) {
variable [Integer*] stones = [n];
while(n != 1) {
n = if(n.even) then n / 2 else 3 * n + 1;
stones = stones.append([n]);
}
return stones;
}
value hs27 = hailstone(27);
print("hailstone sequence for 27 is ``hs27.take(3)``...``hs27.skip(hs27.size - 3).take(3)`` with length ``hs27.size``");
variable value longest = hailstone(1);
for(i in 2..100k - 1) {
value current = hailstone(i);
if(current.size > longest.size) {
longest = current;
}
}
print("the longest sequence under 100,000 starts with ``longest.first else "what?"`` and has length ``longest.size``");
}

17
Task/Hailstone-sequence/Clojure/hailstone-sequence.clj Normal file
View file

@ -0,0 +1,17 @@
(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))))))
(let [hseq (hailstone-seq 27)]
(-> hseq count (= 112) assert)
(->> hseq (take 4) (= [27 82 41 124]) assert)
(->> hseq (drop 108) (= [8 4 2 1]) assert))
(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 ")."))

26
Task/Hailstone-sequence/CoffeeScript/hailstone-sequence.coffee Normal file
View file

@ -0,0 +1,26 @@
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}"

23
Task/Hailstone-sequence/Commodore-BASIC/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,23 @@
100 PRINT : PRINT "HAILSTONE SEQUENCE FOR N = 27:"
110 N=27 : SHOW=1
120 GOSUB 1000
130 PRINT X"ELEMENTS"
140 PRINT : PRINT "FINDING N WITH THE LONGEST HAILSTONE SEQUENCE"
150 SHOW=0
160 T0 = TI
170 FOR N=2 TO 100000
180 : GOSUB 1000
190 : IF X>MAX THEN MAX=X : NMAX = N
200 : REM' PRINT N,X,MAX
210 NEXT
230 PRINT "LONGEST HAILSTONE SEQUENCE STARTS WITH "NMAX"."
240 PRINT "IT HAS"MAX"ELEMENTS"
260 END
1000 REM '*** HAILSTONE SEQUENCE SUBROUTINE ***
1010 X = 0 : S = N
1020 IF SHOW THEN PRINT S,
1030 X = X+1
1040 IF S=1 THEN RETURN
1050 IF INT(S/2)=S/2 THEN S = S/2 : GOTO 1020
1060 S = 3*S+1
1070 GOTO 1020

11
Task/Hailstone-sequence/Common-Lisp/hailstone-sequence.lisp Normal file
View file

@ -0,0 +1,11 @@
(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))))

63
Task/Hailstone-sequence/Cowgol/hailstone-sequence.cowgol Normal file
View file

@ -0,0 +1,63 @@
include "cowgol.coh";
# Generate the hailstone sequence for the given N and return the length.
# If a non-NULL pointer to a buffer is given, then store the sequence there.
sub hailstone(n: uint32, buf: [uint32]): (len: uint32) is
len := 0;
loop
if buf != 0 as [uint32] then
[buf] := n;
buf := @next buf;
end if;
len := len + 1;
if n == 1 then
break;
elseif n & 1 == 0 then
n := n / 2;
else
n := 3*n + 1;
end if;
end loop;
end sub;
# Generate hailstone sequence for 27
var h27: uint32[113];
var h27len := hailstone(27, &h27[0]);
# Print information about it
print("The hailstone sequence for 27 has ");
print_i32(h27len);
print(" elements.\nThe first 4 elements are:");
var n: @indexof h27 := 0;
while n < 4 loop
print_char(' ');
print_i32(h27[n]);
n := n + 1;
end loop;
print(", and the last 4 elements are:");
n := h27len as @indexof h27 - 4;
while n as uint32 < h27len loop
print_char(' ');
print_i32(h27[n]);
n := n + 1;
end loop
print(".\n");
# Find longest hailstone sequence < 100,000
var i: uint32 := 1;
var max_i := i;
var len: uint32 := 0;
var max_len := len;
while i < 100000 loop
len := hailstone(i, 0 as [uint32]);
if len > max_len then
max_i := i;
max_len := len;
end if;
i := i + 1;
end loop;
print_i32(max_i);
print(" has the longest hailstone sequence < 100000: ");
print_i32(max_len);
print_nl();

17
Task/Hailstone-sequence/Crystal/hailstone-sequence.crystal Normal file
View file

@ -0,0 +1,17 @@
def hailstone(n)
seq = [n]
until n == 1
n = n.even? ? n // 2 : n * 3 + 1
seq << n
end
seq
end
max_len = (1...100_000).max_by{|n| hailstone(n).size }
max = hailstone(max_len)
puts ([max_len, max.size, max.max, max.first(4), max.last(4)])
# => [77031, 351, 21933016, [77031, 231094, 115547, 346642], [8, 4, 2, 1]]
twenty_seven = hailstone(27)
puts ([twenty_seven.size, twenty_seven.first(4), max.last(4)])
# => [112, [27, 82, 41, 124], [8, 4, 2, 1]]

23
Task/Hailstone-sequence/D/hailstone-sequence-1.d Normal file
View file

@ -0,0 +1,23 @@
import std.stdio, std.algorithm, std.range, std.typecons;
auto hailstone(uint 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;
immutable h = M.hailstone;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);
enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.hailstone.length, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

20
Task/Hailstone-sequence/D/hailstone-sequence-2.d Normal file
View file

@ -0,0 +1,20 @@
import std.stdio, std.algorithm, std.typecons, std.range;
auto hailstone(uint m) pure nothrow @nogc {
return m
.recurrence!q{ a[n - 1] & 1 ? a[n - 1] * 3 + 1 : a[n - 1]/2}
.until!q{ a == 1 }(OpenRight.no);
}
void main() {
enum M = 27;
immutable h = M.hailstone.array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);
enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.hailstone.walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

23
Task/Hailstone-sequence/D/hailstone-sequence-3.d Normal file
View file

@ -0,0 +1,23 @@
struct Hailstone {
uint n;
bool empty() const pure nothrow @nogc { return n == 0; }
uint front() const pure nothrow @nogc { return n; }
void popFront() pure nothrow @nogc {
n = n == 1 ? 0 : (n & 1 ? (n * 3 + 1) : n / 2);
}
}
void main() {
import std.stdio, std.algorithm, std.range, std.typecons;
enum M = 27;
immutable h = M.Hailstone.array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);
enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone.walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

33
Task/Hailstone-sequence/D/hailstone-sequence-4.d Normal file
View file

@ -0,0 +1,33 @@
import std.stdio, std.algorithm, std.range, std.typecons;
struct Hailstone(size_t cacheSize = 500_000) {
size_t n;
__gshared static size_t[cacheSize] cache;
bool empty() const pure nothrow @nogc { return n == 0; }
size_t front() const pure nothrow @nogc { return n; }
void popFront() nothrow {
if (n >= cacheSize) {
n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
} else if (cache[n]) {
n = cache[n];
} else {
immutable n2 = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
n = cache[n] = n2;
}
}
}
void main() {
enum M = 27;
const h = M.Hailstone!().array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);
enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone!().walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

24
Task/Hailstone-sequence/D/hailstone-sequence-5.d Normal file
View file

@ -0,0 +1,24 @@
import std.stdio, std.algorithm, std.range, std.typecons, std.concurrency;
auto hailstone(size_t n) {
return new Generator!size_t({
yield(n);
while (n > 1) {
n = (n & 1) ? (3 * n + 1) : (n / 2);
yield(n);
}
});
}
void main() {
enum M = 27;
const h = M.hailstone.array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);
enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.hailstone.walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

23
Task/Hailstone-sequence/DCL/hailstone-sequence-1.dcl Normal file
View file

@ -0,0 +1,23 @@
$ n = f$integer( p1 )
$ i = 1
$ loop:
$ if p2 .nes. "QUIET" then $ s'i = n
$ if n .eq. 1 then $ goto done
$ i = i + 1
$ if .not. n
$ then
$ n = n / 2
$ else
$ if n .gt. 715827882 then $ exit ! avoid overflowing
$ n = 3 * n + 1
$ endif
$ goto loop
$ done:
$ if p2 .nes. "QUIET"
$ then
$ penultimate_i = i - 1
$ antepenultimate_i = i - 2
$ preantepenultimate_i = i - 3
$ write sys$output "sequence has ", i, " elements starting with ", s1, ", ", s2, ", ", s3, ", ", s4, " and ending with ", s'preantepenultimate_i, ", ", s'antepenultimate_i, ", ", s'penultimate_i, ", ", s'i
$ endif
$ sequence_length == i

41
Task/Hailstone-sequence/DCL/hailstone-sequence-2.dcl Normal file
View file

@ -0,0 +1,41 @@
$ limit = f$integer( p1 )
$ i = 1
$ max_so_far = 0
$ loop:
$ call hailstone 'i quiet
$ if sequence_length .gt. max_so_far
$ then
$ max_so_far = sequence_length
$ current_record_holder = i
$ endif
$ i = i + 1
$ if i .lt. limit then $ goto loop
$ write sys$output current_record_holder, " is the number less than ", limit, " which has the longest hailstone sequence which is ", max_so_far, " in length"
$ exit
$
$ hailstone: subroutine
$ n = f$integer( p1 )
$ i = 1
$ loop:
$ if p2 .nes. "QUIET" then $ s'i = n
$ if n .eq. 1 then $ goto done
$ i = i + 1
$ if .not. n
$ then
$ n = n / 2
$ else
$ if n .gt. 715827882 then $ exit ! avoid overflowing
$ n = 3 * n + 1
$ endif
$ goto loop
$ done:
$ if p2 .nes. "QUIET"
$ then
$ penultimate_i = i - 1
$ antepenultimate_i = i - 2
$ preantepenultimate_i = i - 3
$ write sys$output "sequence has ", i, " elements starting with ", s1, ", ", s2, ", ", s3, ", ", s4, " and ending with ", s'preantepenultimate_i, ", ", s'antepenultimate_i, ", ", s'penultimate_i, ", ", s'i
$ endif
$ sequence_length == I
$ exit
$ endsubroutine

41
Task/Hailstone-sequence/Dart/hailstone-sequence.dart Normal file
View file

@ -0,0 +1,41 @@
import 'package:collection/collection.dart';
import 'dart:collection';
List<int> hailstone(int n) {
if(n <= 0) {
throw ArgumentError("start value must be >=1)");
}
var seq = Queue<int>();
seq.add(n);
while(n != 1) {
n = n%2 == 0 ? n ~/ 2 : 3 * n + 1;
seq.add(n);
}
return seq.toList();
}
main() {
for(int i = 1; i <= 10; i++) {
print("h($i) = ${hailstone(i)}");
}
var h27 = hailstone(27);
var first4 = h27.take(4).toList();
print("first 4 elements of h(27): $first4");
assert(ListEquality().equals([27, 82, 41, 124], first4));
var last4 = h27.skip(h27.length - 4).take(4).toList();
print("last 4 elements of h(27): $last4");
assert(ListEquality().equals([8, 4, 2, 1], last4));
print("length of sequence h(27): ${h27.length}");
assert(112 == h27.length);
int seq = 0, max = 0;
for(int i = 1; i <= 100000; i++) {
var 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)");
}

5
Task/Hailstone-sequence/Dc/hailstone-sequence-1.dc Normal file
View file

@ -0,0 +1,5 @@
27
[[--: ]nzpq]sq
[d 2/ p]se
[d 3*1+ p]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx

8
Task/Hailstone-sequence/Dc/hailstone-sequence-2.dc Normal file
View file

@ -0,0 +1,8 @@
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

57
Task/Hailstone-sequence/Delphi/hailstone-sequence-1.delphi Normal file
View file

@ -0,0 +1,57 @@
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.

51
Task/Hailstone-sequence/Delphi/hailstone-sequence-2.delphi Normal file
View file

@ -0,0 +1,51 @@
program ShowHailstoneSequence;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Types,
System.Threading,
System.SyncObjs,
Boost.Algorithm,
Boost.Int,
System.Diagnostics;
var
lList: TIntegerDynArray;
lMaxSequence, lMaxLength, i: Integer;
StopWatch: TStopwatch;
begin
lList := Hailstone(27);
Writeln(Format('27: %d elements', [lList.Count]));
Writeln(lList.toString(4), #10);
lMaxSequence := 0;
lMaxLength := 0;
StopWatch := TStopwatch.Create;
StopWatch.Start;
TParallel.for (1, 1, 100000,
procedure(idx: Integer)
var
lList: TIntegerDynArray;
begin
lList := Hailstone(idx);
if lList.Count > lMaxLength then
begin
TInterlocked.Exchange(lMaxSequence, idx);
TInterlocked.Exchange(lMaxLength, lList.Count);
end;
end);
StopWatch.Stop;
Write(Format('Longest sequence under 100,000: %d with %d elements', [lMaxSequence,
lMaxLength]));
Writeln(Format(' in %d ms', [StopWatch.ElapsedMilliseconds]));
Readln;
end.

260
Task/Hailstone-sequence/EDSAC-order-code/hailstone-sequence.edsac Normal file
View file

@ -0,0 +1,260 @@
[Hailstone (or Collatz) task for Rosetta Code.
EDSAC program, Initial Orders 2.]
[This program shows how subroutines can be called via the
phi, H, N, ..., V parameters, so that the code doesn't have
to be changed if the subroutines are moved about in store.
See Wilkes, Wheeler and Gill, 1951 edition, page 18.]
[Library subroutine P7, prints long strictly positive integer;
10 characters, right justified, padded left with spaces.
Input: 0D = integer to be printed.
Closed, even; 35 storage locations; working position 4D.]
T 55 K [call subroutine via V parameter]
P 56 F [address of subroutine]
E 25 K
T V
GKA3FT26@H28#@NDYFLDT4DS27@TFH8@S8@T1FV4DAFG31@SFLDUFOFFFSFL4F
T4DA1FA27@G11@XFT28#ZPFT27ZP1024FP610D@524D!FO30@SFL8FE22@
[Subroutine to print a string placed after the subroutine call.
One location per character, with character in top 5 bits.
Last character flagged by having bit 0 set.
17 locations, workspace 0F.]
T 54 K [call subroutine via C parameter]
P 91 F [address of subroutine]
E 25 K
T C
GKH16@A2FG4@A6@A2FT6@AFTFOFCFSFE3@A6@A3FT15@EFV2047F
[************ Rosetta Code task ************
Subroutine to generate and optionally store the hailstone
(Collatz) sequence for the passed-in initial term n.
Input: 4D = n, 35-bit positive integer
6F = start address of sequence if stored;
must be even; 0 = don't store
Output: 7F = number of terms in sequence, or -1 if error
Workspace: 0D (general), 8D (term of sequence)
Must be loaded at an even address.]
T 45 K [call subroutine via H parameter]
P 108 F [address of subroutine]
E 25 K
T H
G K
A 3 F
T 46 @
H 54#@ [mult reg := 1 to test odd/even]
A 4 D [load n passed in by caller]
T 8 D [term := n]
A 54 @ [load 1 (single)]
T 7 F [include initial term in count]
A 6 F [load address for store]
S 56 @ [test for 0; allow for pre-inc]
G 11 @ [skip next if storing not wanted]
A 12 @ [make 'T addr D' order]
[11] T 21 @ [plant T order, or -ve value if not storing
(note that a T order is +ve as an integer)]
[Loop: deal with current term in sequence
First store it, if user requested that]
[12] T D [clear acc; also serves to make 'T addr D' order]
A 21 @ [load T order to store term]
G 22 @ [jump if caller doesn't want store]
A 56 @ [pre-inc the address]
U 21 @ [update T order]
S 51 @ [check not gone beyond max EDSAC address]
E 47 @ [error exit if it has]
T F [clear acc]
A 8 D [load term]
[21] T D [store]
[22] T F [clear acc]
A 54#@ [load 1 (double)]
S 8 D [1 - term]
E 46 @ [if term = 1, jump out with acc = 0]
T F [clear acc]
C 8 D [acc := term AND 1]
S 54#@ [test whether 0 or 1]
G 38 @ [jump if term is even]
[Here if term is odd; acc = 0]
A 8 D [load term]
S 52#@ [guard against numeric overflow]
E 47 @ [jump if overflow]
A 52#@ [restore term after test]
L D [term*2]
A 8 D [term*3]
A 54#@ [plus 1]
E 41 @ [join common code]
[Here if term is even]
[38] T F [clear acc]
A 8 D [load term]
R D [term/2]
[Common code, acc = new term]
[41] T 8 D [store new term]
A 7 F [load count]
A 54 @ [add 1]
T 7 F [update count]
E 12 @ [loop back]
[Here when sequence has reached 1
Assume jump here with acc = 0]
[46] E F [return with acc = 0]
[47] T F [here on error]
S 54 F [acc := -1]
T 7 F [return that as count]
E 46 @
[Arrange the following to ensure even addresses for 35-bit values]
[51] T 1024 F [for checking valid address]
[52] H 682 DT 682 D [(2^34 - 1)/3]
[54] P DP F [1]
[56] P 2 F [to change addresses by 2]
[Program to demonstrate Rosetta Code subroutine]
T 180 K
G K
[Double constants]
[P 500 F P F] [maximum n = 1000"]
[0] & 848 F PF [maximum n = 100000]
[2] P 13 D PF [n = 27 as demo of sequence]
[4] P D PF [1]
[Double variables]
[6] P F P F [n, start of Collatz sequence]
[8] P F P F [n with maximum count]
[Single constants]
[10] P 400 F [where to store sequence]
[11] P 2 F [to change addresses by 2]
[12] @ F [carriage return]
[13] & F [line feed]
[14] K 4096 F [null char]
[15] A D [used for maiking 'A addr D' order]
[16] P 8 F [ used for adding 8 to address]
[Single variables]
[17] P F [maximum number of terms]
[18] P F [temporary store]
[19] P F [marks end of printing]
[Subroutine to print 4 numbers starting at address in 6F.
Prints new line (CR, LF) at end.]
[20] A 3 F [plant link for return]
T 40 @
A 6 F [load start address]
A 15 @ [make 'A addr D' order]
A 16 @ [inc address by 8 (4 double values)]
U 19 @ [store as test for end]
S 16 @ [restore 'A addr D' order for start]
[27] U 31 @ [plant 'A addr D' order in code]
S 19 @ [test for end]
E 38 @ [out if so]
T F [clear acc]
[31] A D [load number]
T D [to 0D for printing]
[33] A 33 @ [call print subroutine]
G V
A 31 @ [load 'A addr D' order]
A 11 @ [inc address to next double value]
G 27 @ [loop back]
[38] O 12 @ [here when done, print CR LF]
O 13 @
[40] E F [return]
[Enter with acc = 0]
[PART 1]
[41] A 2#@ [load demo value of n]
T 4 D [to 4D for subroutine]
A 10 @ [address to store sequence]
T 6 F [to 6F for subroutine]
[45] A 45 @ [call subroutine to generate sequence]
G H
A 7 F [load length of sequence]
G 198 @ [out if error]
T 18 @
[Print result]
[50] A 50 @ [print 'start' message]
G C
K2048F SF TF AF RF TF !F !F #D
A 2#@ [load demo value of n]
T D [to 0D for printing]
[63] A 63 @ [print demo n]
G V
[65] A 65 @ [print 'length' string]
G C
K2048F @F &F LF EF NF GF TF HF !F #D
T D [ensure 1F and sandwich bit are 0]
A 18 @ [load length]
T F [to 0F (effectively 0D) for printing]
[81] A 81 @
G V
[83] A 83 @ [print 'first and last four' string]
G C
K2048F @F &F FF IF RF SF TF !F AF NF DF !F LF AF SF TF !F FF OF UF RF @F &F #D
A 18 @ [load length of sequence]
L 1 F [times 4]
A 6 F [make address of last 4]
S 16 @
T 18 @ [store address of last 4]
[115] A 115 @ [print first 4 terms]
G 20 @
A 18 @ [retrieve address of last 4]
T 6 F [pass as parameter]
[119] A 119 @ [print last 4 terms]
G 20 @
[PART 2]
T F
T 17 @ [max count := 0]
T 6#@ [n := 0]
[Loop: update n, start new sequence]
[124] T F [clear acc]
A 6#@ [load n]
A 4#@ [add 1 (double)]
U 6#@ [update n]
T 4 D [n to 4D for subroutine]
T 6 F [say no store]
[130] A 130 @ [call subroutine to generate sequence]
G H
A 7 F [load count returned by subroutine]
G 198 @ [out if error]
S 17 @ [compare with max count so far]
G 140 @ [skip if less]
A 17 @ [restore count after test]
T 17 @ [update max count]
A 6#@ [load n]
T 8#@ [remember n that gave max count]
[140] T F [clear acc]
A 6#@ [load n just done]
S #@ [compare with max(n)]
G 124 @ [loop back if n < max(n)
else fall through with acc = 0]
[Here whan reached maximum n. Print result.]
[144] A 144 @ [print 'max n' message]
G C
K2048F MF AF XF !F NF !F !F #D
A #@ [load maximum n]
T D [to 0D for printing]
[157] A 157 @ [call print subroutine]
G V
[159] A 159 @ [print 'max len' message]
G C
K2048F @F &F MF AF XF !F LF EF NF #D
T D [clear 1F and sandwich bit]
A 17 @ [load max count (single)]
T F [to 0F, effectively to 0D]
[175] A 175 @ [call print subroutine]
G V
[177] A 177 @ [print 'at n =' message]
G C
K2048F @F &F AF TF !F NF !F #F VF !D
A 8#@ [load n for which max count occurred]
T D [to 0D for printing]
[192] A 192 @ [call print subroutine]
G V
[194] O 12 @ [print CR, LF]
O 13 @
O 14 @ [print null to flush teleprinter buffer]
Z F [stop]
[Here if term would overflow EDSAC 35-bit value.
With a maximum n of 100,000 this doesn't happen.]
[198] A 198 @ [print 'overflow' message]
G C
K2048F @F &F OF VF EF RF FF LF OF WD
E 194 @ [jump to exit]
E 41 Z [define entry point]
P F [acc = 0 on entry]

27
Task/Hailstone-sequence/EMal/hailstone-sequence.emal Normal file
View file

@ -0,0 +1,27 @@
fun hailstone = List by int n
List h = int[n]
while n != 1
n = when((n % 2 == 0), n / 2, 3 * n + 1)
h.append(n)
end
return h
end
int NUMBER = 27
int LESS_THAN = 100000
List sequence = hailstone(NUMBER)
writeLine("The hailstone sequence for the number " + NUMBER +
" has " + sequence.length + " elements")
writeLine("starting with " +
sequence.extractStart(4).join(", ") + " and ending with " +
sequence.extractEnd(4).join(", ") + ".")
int number = 0
sequence = int[]
for int i = 1; i < LESS_THAN; ++i
List current = hailstone(i)
if current.length > sequence.length
sequence = current
number = i
end
end
writeLine("The number less than 100000 with longest hailstone sequence is " +
number + ", with length of " + sequence.length + ".")

30
Task/Hailstone-sequence/ERRE/hailstone-sequence.erre Normal file
View file

@ -0,0 +1,30 @@
PROGRAM ULAM
!$DOUBLE
PROCEDURE HAILSTONE(X,PRT%->COUNT)
COUNT=1
IF PRT% THEN PRINT(X,) END IF
REPEAT
IF X/2<>INT(X/2) THEN
X=X*3+1
ELSE
X=X/2
END IF
IF PRT% THEN PRINT(X,) END IF
COUNT=COUNT+1
UNTIL X=1
IF PRT% THEN PRINT END IF
END PROCEDURE
BEGIN
HAILSTONE(27,TRUE->COUNT)
PRINT("Sequence length for 27:";COUNT)
MAX_COUNT=2
NMAX=2
FOR I=3 TO 100000 DO
HAILSTONE(I,FALSE->COUNT)
IF COUNT>MAX_COUNT THEN NMAX=I MAX_COUNT=COUNT END IF
END FOR
PRINT("Max. number is";NMAX;" with";MAX_COUNT;"elements")
END PROGRAM

28
Task/Hailstone-sequence/EchoLisp/hailstone-sequence-1.l Normal file
View file

@ -0,0 +1,28 @@
(lib 'hash)
(lib 'sequences)
(lib 'compile)
(define (hailstone n)
(when (> n 1)
(if (even? n) (/ n 2) (1+ (* n 3)))))
(define H (make-hash))
;; (iterator/f seed f) returns seed, (f seed) (f(f seed)) ...
(define (hlength seed)
(define collatz (iterator/f hailstone seed))
(or
(hash-ref H seed) ;; known ?
(hash-set H seed
(for ((i (in-naturals)) (h collatz))
;; add length of subsequence if already known
#:break (hash-ref H h) => (+ i (hash-ref H h))
(1+ i)))))
(define (task (nmax 100000))
(for ((n [1 .. nmax])) (hlength n)) ;; fill hash table
(define hmaxlength (apply max (hash-values H)))
(define hmaxseed (hash-get-key H hmaxlength))
(writeln 'maxlength= hmaxlength 'for hmaxseed))

32
Task/Hailstone-sequence/EchoLisp/hailstone-sequence-2.l Normal file
View file

@ -0,0 +1,32 @@
(define H27 (iterator/f hailstone 27))
(take H27 6)
→ (27 82 41 124 62 31)
(length H27)
→ 112
(list-tail (take H27 112) -6)
→ (5 16 8 4 2 1)
(task)
maxlength= 351 for 77031
;; more ...
(lib 'bigint)
(task 200000)
maxlength= 383 for 156159
(task 300000)
maxlength= 443 for 230631
(task 400000)
maxlength= 443 for 230631
(task 500000)
maxlength= 449 for 410011
(task 600000)
maxlength= 470 for 511935
(task 700000)
maxlength= 509 for 626331
(task 800000)
maxlength= 509 for 626331
(task 900000)
maxlength= 525 for 837799
(task 1000000)
maxlength= 525 for 837799

42
Task/Hailstone-sequence/Egel/hailstone-sequence.egel Normal file
View file

@ -0,0 +1,42 @@
import "prelude.eg"
namespace Hailstone (
using System
using List
def even = [ N -> (N%2) == 0 ]
def hailstone =
[ 1 -> {1}
| N -> if even N then cons N (hailstone (N/2))
else cons N (hailstone (N * 3 + 1)) ]
def hailpair =
[ N -> (N, length (hailstone N)) ]
def hailmax =
[ (N, NMAX), (M, MMAX) -> if (NMAX < MMAX) then (M, MMAX) else (N, NMAX) ]
def largest =
[ 1 -> (1, 1)
| N ->
let M0 = hailpair N in
let M1 = largest (N - 1) in
hailmax M0 M1 ]
)
using System
using List
using Hailstone
def task0 = let H27 = hailstone 27 in length H27
def task1 =
let H27 = hailstone 27 in
let L = length H27 in
(take 4 H27, drop (L - 4) H27)
def task2 = largest 100000
def main = (task0, task1, task2)

67
Task/Hailstone-sequence/Eiffel/hailstone-sequence.e Normal file
View file

@ -0,0 +1,67 @@
class
APPLICATION
create
make
feature
make
local
test: LINKED_LIST [INTEGER]
count, number, te: INTEGER
do
create test.make
test := hailstone_sequence (27)
io.put_string ("There are " + test.count.out + " elements in the sequence for the number 27.")
io.put_string ("%NThe first 4 elements are: ")
across
1 |..| 4 as t
loop
io.put_string (test [t.item].out + "%T")
end
io.put_string ("%NThe last 4 elements are: ")
across
(test.count - 3) |..| test.count as t
loop
io.put_string (test [t.item].out + "%T")
end
across
1 |..| 99999 as c
loop
test := hailstone_sequence (c.item)
te := test.count
if te > count then
count := te
number := c.item
end
end
io.put_string ("%NThe longest sequence for numbers below 100000 is " + count.out + " for the number " + number.out + ".")
end
hailstone_sequence (n: INTEGER): LINKED_LIST [INTEGER]
-- Members of the Hailstone Sequence starting from 'n'.
require
n_is_positive: n > 0
local
seq: INTEGER
do
create Result.make
from
seq := n
until
seq = 1
loop
Result.extend (seq)
if seq \\ 2 = 0 then
seq := seq // 2
else
seq := ((3 * seq) + 1)
end
end
Result.extend (seq)
ensure
sequence_terminated: Result.last = 1
end
end

50
Task/Hailstone-sequence/Elena/hailstone-sequence.elena Normal file
View file

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

23
Task/Hailstone-sequence/Elixir/hailstone-sequence.elixir Normal file
View file

@ -0,0 +1,23 @@
defmodule Hailstone do
require Integer
def step(1) , do: 0
def step(n) when Integer.is_even(n), do: div(n,2)
def step(n) , do: n*3 + 1
def sequence(n) do
Stream.iterate(n, &step/1) |> Stream.take_while(&(&1 > 0)) |> Enum.to_list
end
def run do
seq27 = sequence(27)
len27 = length(seq27)
repr = String.replace(inspect(seq27, limit: 4) <> inspect(Enum.drop(seq27,len27-4)), "][", ", ")
IO.puts "Hailstone(27) has #{len27} elements: #{repr}"
{len, start} = Enum.map(1..100_000, fn(n) -> {length(sequence(n)), n} end) |> Enum.max
IO.puts "Longest sequence starting under 100000 begins with #{start} and has #{len} elements."
end
end
Hailstone.run

24
Task/Hailstone-sequence/Erlang/hailstone-sequence-1.erl Normal file
View file

@ -0,0 +1,24 @@
-module(hailstone).
-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]).

28
Task/Hailstone-sequence/Erlang/hailstone-sequence-2.erl Normal file
View file

@ -0,0 +1,28 @@
-module(collatz).
-export([main/0,collatz/1,coll/1,max_atz_under/1]).
collatz(1) -> 1;
collatz(N) when N rem 2 == 0 -> 1 + collatz(N div 2);
collatz(N) when N rem 2 > 0 -> 1 + collatz(3 * N +1).
max_atz_under(N) ->
F = fun (X) -> {collatz(X), X} end,
{_, Index} = lists:max(lists:map(F, lists:seq(1, N))),
Index.
coll(1) -> [1];
coll(N) when N rem 2 == 0 -> [N|coll(N div 2)];
coll(N) -> [N|coll(3 * N + 1)].
main() ->
io:format("collatz(4) non-list total: ~w~n", [collatz(4)]),
io:format("coll(4) with lists ~w~n", [coll(4)] ),
Seq27 = coll(27),
Seq1000 = coll(max_atz_under(100000)),
io:format("coll(27) length: ~B~n", [length(Seq27)]),
io:format("coll(27) first 4: ~w~n", [lists:sublist(Seq27, 4)]),
io:format("collatz(27) last 4: ~w~n",
[lists:nthtail(length(Seq27) - 4, Seq27)]),
io:format("maximum N <= 100000..."),
io:format("Max: ~w~n", [max_atz_under(100000)]),
io:format("Total: ~w~n", [ length( Seq1000 ) ] ).

44
Task/Hailstone-sequence/Euler/hailstone-sequence.euler Normal file
View file

@ -0,0 +1,44 @@
>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

46
Task/Hailstone-sequence/Euphoria/hailstone-sequence.euphoria Normal file
View file

@ -0,0 +1,46 @@
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})

20
Task/Hailstone-sequence/Ezhil/hailstone-sequence.ezhil Normal file
View file

@ -0,0 +1,20 @@
நிரல்பாகம் hailstone ( எண் )
பதிப்பி "=> ",எண் #hailstone seq
@( எண் == 1 ) ஆனால்
பின்கொடு எண்
முடி
@( (எண்%2) == 1 ) ஆனால்
hailstone( 3*எண் + 1)
இல்லை
hailstone( எண்/2 )
முடி
முடி
எண்கள் = [5,17,19,23,37]
@(எண்கள் இல் இவ்வெண்) ஒவ்வொன்றாக
பதிப்பி "****** calculating hailstone seq for ",இவ்வெண்," *********"
hailstone( இவ்வெண் )
பதிப்பி "**********************************************"
முடி

14
Task/Hailstone-sequence/F-Sharp/hailstone-sequence.fs Normal file
View file

@ -0,0 +1,14 @@
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

8
Task/Hailstone-sequence/FALSE/hailstone-sequence.false Normal file
View file

@ -0,0 +1,8 @@
[$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;.

31
Task/Hailstone-sequence/Factor/hailstone-sequence.factor Normal file
View file

@ -0,0 +1,31 @@
! rosetta/hailstone/hailstone.factor
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

26
Task/Hailstone-sequence/Fermat/hailstone-sequence.fermat Normal file
View file

@ -0,0 +1,26 @@
Array g[2]
Func Collatz(n, d) =
{Runs the Collatz procedure for the number n and returns the number of steps.}
{If d is nonzero, prints the terms in the sequence.}
steps := 1;
while n>1 do
if n|2=0 then n:=n/2 else n:=3n+1 fi;
if d then !!n fi;
steps := steps + 1
od;
steps.
Function LongestTo(n) =
{Finds the number up to n for which the Collatz algorithm takes the most number of steps.}
{The result is stored in the array [g]: g[1] is the number, g[2] is how many steps it takes.}
champ:=0;
record:=0;
for i = 1, n do
q:=Collatz(i, 0);
if q > record then
champ:=i; record:=q; fi;
od;
g[1]:=champ;
g[2]:=record;
.

19
Task/Hailstone-sequence/Forth/hailstone-sequence.fth Normal file
View file

@ -0,0 +1,19 @@
: 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

49
Task/Hailstone-sequence/Fortran/hailstone-sequence.f Normal file
View file

@ -0,0 +1,49 @@
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

91
Task/Hailstone-sequence/FreeBASIC/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,91 @@
' version 17-06-2015
' compile with: fbc -s console
Function hailstone_fast(number As ULongInt) As ULongInt
' faster version
' only counts the sequence
Dim As ULongInt count = 1
While number <> 1
If (number And 1) = 1 Then
number += number Shr 1 + 1 ' 3*n+1 and n/2 in one
count += 2
Else
number Shr= 1 ' divide number by 2
count += 1
End If
Wend
Return count
End Function
Sub hailstone_print(number As ULongInt)
' print the number and sequence
Dim As ULongInt count = 1
Print "sequence for number "; number
Print Using "########"; number; 'starting number
While number <> 1
If (number And 1) = 1 Then
number = number * 3 + 1 ' n * 3 + 1
count += 1
Else
number = number \ 2 ' n \ 2
count += 1
End If
Print Using "########"; number;
Wend
Print : Print
Print "sequence length = "; count
Print
Print String(79,"-")
End Sub
Function hailstone(number As ULongInt) As ULongInt
' normal version
' only counts the sequence
Dim As ULongInt count = 1
While number <> 1
If (number And 1) = 1 Then
number = number * 3 + 1 ' n * 3 + 1
count += 1
End If
number = number \ 2 ' divide number by 2
count += 1
Wend
Return count
End Function
' ------=< MAIN >=------
Dim As ULongInt number
Dim As UInteger x, max_x, max_seq
hailstone_print(27)
Print
For x As UInteger = 1 To 100000
number = hailstone(x)
If number > max_seq Then
max_x = x
max_seq = number
End If
Next
Print "The longest sequence is for "; max_x; ", it has a sequence length of "; max_seq
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print : Print "hit any key to end program"
Sleep
End

20
Task/Hailstone-sequence/Frege/hailstone-sequence.frege Normal file
View file

@ -0,0 +1,20 @@
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 :: IO ()
main = do
let h27 = hailstone 27
putStrLn $ show $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
putStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
putStrLn $ show $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) [1..100000]

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"]

11
Task/Hailstone-sequence/FunL/hailstone-sequence.funl Normal file
View file

@ -0,0 +1,11 @@
def
hailstone( 1 ) = [1]
hailstone( n ) = n # hailstone( if 2|n then n/2 else n*3 + 1 )
if _name_ == '-main-'
h27 = hailstone( 27 )
assert( h27.length() == 112 and h27.startsWith([27, 82, 41, 124]) and h27.endsWith([8, 4, 2, 1]) )
val (n, len) = maxBy( snd, [(i, hailstone( i ).length()) | i <- 1:100000] )
println( n, len )

32
Task/Hailstone-sequence/Futhark/hailstone-sequence.futhark Normal file
View file

@ -0,0 +1,32 @@
fun hailstone_step(x: int): int =
if (x % 2) == 0
then x/2
else (3*x) + 1
fun hailstone_seq(x: int): []int =
let capacity = 100
let i = 1
let steps = replicate capacity (-1)
let steps[0] = x
loop ((capacity,i,steps,x)) = while x != 1 do
let (steps, capacity) =
if i == capacity then
(concat steps (replicate capacity (-1)),
capacity * 2)
else (steps, capacity)
let x = hailstone_step x
let steps[i] = x
in (capacity, i+1, steps, x)
in #1 (split i steps)
fun hailstone_len(x: int): int =
let i = 1
loop ((i,x)) = while x != 1 do
(i+1, hailstone_step x)
in i
fun max (x: int) (y: int): int = if x < y then y else x
fun main (x: int) (n: int): ([]int, int) =
(hailstone_seq x,
reduce max 0 (map hailstone_len (map (1+) (iota (n-1)))))

59
Task/Hailstone-sequence/FutureBasic/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,59 @@
local fn Hailstone( n as NSInteger ) as NSInteger
NSInteger count = 1
while ( n != 1 )
if ( n and 1 ) == 1
n = n * 3 + 1
count++
end if
n = n / 2
count++
wend
end fn = count
void local fn PrintHailstone( n as NSInteger )
NSInteger count = 1, col = 1
print "Sequence for number "; n; ":" : print
print using "########"; n;
col = 2
while ( n != 1 )
if ( n and 1 ) == 1
n = n * 3 + 1
count++
else
n = n / 2
count++
end if
print using "########"; n;
if col == 10 then print : col = 1 else col++
wend
print : print
print "Sequence length = "; count
end fn
window 1, @"Hailstone Sequence", ( 0, 0, 620, 400 )
NSInteger n, seq_num, x, max_x, max_seq
seq_num = 27
print
fn PrintHailstone( seq_num )
print
for x = 1 to 100000
n = fn Hailstone( x )
if n > max_seq
max_x = x
max_seq = n
end if
next
print "The longest sequence is for "; max_x; ", it has a sequence length of "; max_seq; "."
HandleEvents

60
Task/Hailstone-sequence/GAP/hailstone-sequence.gap Normal file
View file

@ -0,0 +1,60 @@
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 ]

18
Task/Hailstone-sequence/GW-BASIC/hailstone-sequence.basic Normal file
View file

@ -0,0 +1,18 @@
10 N# = 27
20 P = 1
30 GOSUB 130
40 PRINT "That took";C;"steps."
50 P = 0 : A = 0 : B = 0
60 FOR M = 1 TO 99999!
70 N# = M
80 GOSUB 130
90 IF C > B THEN B = C: A = M
100 NEXT M
110 PRINT "The longest sequence is for n=";A;" and is ";B;" steps long."
120 END
130 C = 1
140 IF P = 1 THEN PRINT N#
150 IF N# < 2 THEN RETURN
160 IF N#/2 = INT(N#/2) THEN N# = N#/2 ELSE N# = 3*N# + 1
170 C = C + 1
180 GOTO 140

35
Task/Hailstone-sequence/Go/hailstone-sequence-1.go Normal file
View file

@ -0,0 +1,35 @@
package main
import "fmt"
// 1st arg is the number to generate the sequence for.
// 2nd arg is a slice to recycle, to reduce garbage.
func hs(n int, recycle []int) []int {
s := append(recycle[:0], n)
for n > 1 {
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
s = append(s, n)
}
return s
}
func main() {
seq := hs(27, nil)
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++ {
seq = hs(n, seq)
if len(seq) > maxLen {
maxN = n
maxLen = len(seq)
}
}
fmt.Printf("hs(%d): %d elements\n", maxN, maxLen)
}

68
Task/Hailstone-sequence/Go/hailstone-sequence-2.go Normal file
View file

@ -0,0 +1,68 @@
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])
}

Some files were not shown because too many files have changed in this diff Show more