Yellowstone sequence: Difference between revisions

Added Forth
(Added solution for Action!)
(Added Forth)
Line 784:
</pre>
 
=={{header|Forth}}==
<lang>: array create cells allot ;
: th cells + ; \ some helper words
 
30 constant #yellow \ number of yellowstones
 
#yellow array y \ create array
( n1 n2 -- n3)
: gcd dup if tuck mod recurse exit then drop ;
: init 3 0 do i 1+ y i th ! loop ; ( --)
: show cr #yellow 0 do y i th ? loop ; ( --)
 
: loop1 ( i k -- i k')
begin
1+
over 2 - cells y + @ over gcd 1 = >r
over 1 - cells y + @ over gcd 1 > r> or 0=
until
;
( i k -- i k f)
: loop2 over true swap 0 ?do over y i th @ = if 0= leave then loop ;
 
: yellow ( --)
#yellow 3 do
i 3
begin loop1 loop2 dup if >r over over y rot th ! r> then until
drop drop
loop
;
 
: main init yellow show ;
 
main</lang>
{{out}}
<pre>main
1 2 3 4 9 8 15 14 5 6 25 12 35 16 7 10 21 20 27 22 39 11 13 33 26 45 28 51 32 17 ok</pre>
=={{header|FreeBASIC}}==
<lang freebasic>function gcd(a as uinteger, b as uinteger) as uinteger
374

edits