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

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

42
Task/Stern-Brocot-sequence/00-TASK.txt Normal file
View file

@ -0,0 +1,42 @@
For this task, the Stern-Brocot sequence is to be generated by an algorithm similar to that employed in generating the [[Fibonacci sequence]].
# The first and second members of the sequence are both 1:
#*     1, 1
# Start by considering the second member of the sequence
# Sum the considered member of the sequence and its precedent, (1 + 1) = 2, and append it to the end of the sequence:
#*     1, 1, 2
# Append the considered member of the sequence to the end of the sequence:
#*     1, 1, 2, 1
# Consider the next member of the series, (the third member i.e. 2)
# GOTO 3
#*
#*         ─── Expanding another loop we get: ───
#*
# Sum the considered member of the sequence and its precedent, (2 + 1) = 3, and append it to the end of the sequence:
#*     1, 1, 2, 1, 3
# Append the considered member of the sequence to the end of the sequence:
#*     1, 1, 2, 1, 3, 2
# Consider the next member of the series, (the fourth member i.e. 1)
;The task is to:
* Create a function/method/subroutine/procedure/... to generate the Stern-Brocot sequence of integers using the method outlined above.
* Show the first fifteen members of the sequence. (This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4)
* Show the (1-based) index of where the numbers 1-to-10 first appear in the sequence.
* Show the (1-based) index of where the number 100 first appears in the sequence.
* Check that the greatest common divisor of all the two consecutive members of the series up to the 1000<sup>th</sup> member, is always one.
<br>Show your output on this page.
;Related tasks:
:* &nbsp; [[Fusc sequence]].
:* &nbsp; [[Continued fraction/Arithmetic]]
;Ref:
* [https://www.youtube.com/watch?v=DpwUVExX27E Infinite Fractions - Numberphile] (Video).
* [http://www.ams.org/samplings/feature-column/fcarc-stern-brocot Trees, Teeth, and Time: The mathematics of clock making].
* [https://oeis.org/A002487 A002487] The On-Line Encyclopedia of Integer Sequences.
<br><br>

20
Task/Stern-Brocot-sequence/11l/stern-brocot-sequence.11l Normal file
View file

@ -0,0 +1,20 @@
F stern_brocot(predicate = series -> series.len < 20)
V sb = [1, 1]
V i = 0
L predicate(sb)
sb [+]= [sum(sb[i .< i + 2]), sb[i + 1]]
i++
R sb
V n_first = 15
print(("The first #. values:\n ".format(n_first))‘ ’stern_brocot(series -> series.len < :n_first)[0 .< n_first])
print()
V n_max = 10
L(n_occur) Array(1 .. n_max) [+] [100]
print((‘1-based index of the first occurrence of #3 in the series:’.format(n_occur))‘ ’(stern_brocot(series -> @n_occur !C series).index(n_occur) + 1))
print()
V n_gcd = 1000
V s = stern_brocot(series -> series.len < :n_gcd)[0 .< n_gcd]
assert(all(zip(s, s[1..]).map((prev, this) -> gcd(prev, this) == 1)), ‘A fraction from adjacent terms is reducible’)

72
Task/Stern-Brocot-sequence/360-Assembly/stern-brocot-sequence-1.360 Normal file
View file

@ -0,0 +1,72 @@
* Stern-Brocot sequence - 12/03/2019
STERNBR CSECT
USING STERNBR,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R4,SB+2 k=2; @sb(k)
LA R2,SB+2 i=1; @sb(k-i)
LA R3,SB+0 j=2; @sb(k-j)
LA R1,NN/2 loop counter
LOOP LA R4,2(R4) @sb(k)++
LH R0,0(R2) sb(k-i)
AH R0,0(R3) sb(k-i)+sb(k-j)
STH R0,0(R4) sb(k)=sb(k-i)+sb(k-j)
LA R3,2(R3) @sb(k-j)++
LA R4,2(R4) @sb(k)++
LH R0,0(R3) sb(k-j)
STH R0,0(R4) sb(k)=sb(k-j)
LA R2,2(R2) @sb(k-i)++
BCT R1,LOOP end loop
LA R9,15 n=15
MVC PG(5),=CL80'FIRST'
XDECO R9,XDEC edit n
MVC PG+5(3),XDEC+9 output n
XPRNT PG,L'PG print buffer
LA R10,PG @pg
LA R6,1 i=1
DO WHILE=(CR,R6,LE,R9) do i=1 to n
LR R1,R6 i
SLA R1,1 ~
LH R2,SB-2(R1) sb(i)
XDECO R2,XDEC edit sb(i)
MVC 0(4,R10),XDEC+8 output sb(i)
LA R10,4(R10) @pg+=4
LA R6,1(R6) i++
ENDDO , enddo i
XPRNT PG,L'PG print buffer
LA R7,1 j=1
DO WHILE=(C,R7,LE,=A(11)) do j=1 to 11
IF C,R7,EQ,=F'11' THEN if j=11 then
LA R7,100 j=100
ENDIF , endif
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A(NN)) do i=1 to nn
LR R1,R6 i
SLA R1,1 ~
LH R2,SB-2(R1) sb(i)
CR R2,R7 if sb(i)=j
BE EXITI then leave i
LA R6,1(R6) i++
ENDDO , enddo i
EXITI MVC PG,=CL80'FIRST INSTANCE OF'
XDECO R7,XDEC edit j
MVC PG+17(4),XDEC+8 output j
MVC PG+21(7),=C' IS AT '
XDECO R6,XDEC edit i
MVC PG+28(4),XDEC+8 output i
XPRNT PG,L'PG print buffer
LA R7,1(R7) j++
ENDDO , enddo j
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
LTORG
NN EQU 2400 nn
PG DC CL80' ' buffer
XDEC DS CL12 temp for xdeco
SB DC (NN)H'1' sb(nn)
REGEQU
END STERNBR

6
Task/Stern-Brocot-sequence/360-Assembly/stern-brocot-sequence-2.360 Normal file
View file

@ -0,0 +1,6 @@
k=2; i=1; j=2;
while(k<nn);
k++; sb[k]=sb[k-i]+sb[k-j];
k++; sb[k]=sb[k-j];
i++; j++;
}

14
Task/Stern-Brocot-sequence/360-Assembly/stern-brocot-sequence-3.360 Normal file
View file

@ -0,0 +1,14 @@
LA R4,SB+2 k=2; @sb(k)
LA R2,SB+2 i=1; @sb(k-i)
LA R3,SB+0 j=2; @sb(k-j)
LA R1,NN/2 k=nn/2 'loop counter
LOOP LA R4,2(R4) @sb(k)++
LH R0,0(R2) sb(k-i)
AH R0,0(R3) sb(k-i)+sb(k-j)
STH R0,0(R4) sb(k)=sb(k-i)+sb(k-j)
LA R3,2(R3) @sb(k-j)++
LA R4,2(R4) @sb(k)++
LH R0,0(R3) sb(k-j)
STH R0,0(R4) sb(k)=sb(k-j)
LA R2,2(R2) @sb(k-i)++
BCT R1,LOOP k--; if k>0 then goto loop

136
Task/Stern-Brocot-sequence/8080-Assembly/stern-brocot-sequence.8080 Normal file
View file

@ -0,0 +1,136 @@
puts: equ 9 ; CP/M syscall to print a string
org 100h
;;; Generate the first 1200 elements of the Stern-Brocot sequence
lxi b,600 ; 2 elements generated per loop
lxi h,seq
mov e,m ; Initialization
inx h
push h ; Save considered member pointer
inx h ; Insertion pointer
genseq: xthl ; Load considered member pointer
mov d,e ; D = predecessor
mov e,m ; E = considered member
inx h ; Point at next considered member
xthl ; Load insertion pointer
mov a,d ; A = sum of both members
add e
mov m,a ; Append the sum
inx h
mov m,e ; Append the considered member
inx h
dcx b ; Decrement counter
mov a,b ; Zero?
ora c
jnz genseq ; If not, generate next members of sequence
pop h ; Remove pointer from stack
;;; Print first 15 members of sequence
lxi d,seq
mvi b,15 ; 15 members
mvi h,0
p15: ldax d ; Get current member
mov l,a
call prhl ; Print member
inx d ; Increment pointer
dcr b ; Decrement counter
jnz p15 ; If not zero, print another one
lxi d,nl
mvi c,puts
call 5
;;; Print indices of first occurrence of 1..10
lxi b,010Ah ; B = number, C = counter
call fnext
;;; Print index of first occurrence of 100
lxi b,6401h
call fnext
;;; Check if the GCD of first 1000 consecutive elements is 0
xra a ; Zero out 1001th element as end marker
sta seq+1000
lxi h,seq ; Start of array
mov e,m
inx h
gcdchk: mov d,e ; (D,E) = next pair
mov e,m
inx h
mov a,e
mov b,d
ana a ; Reached the end?
jz done
call gcd ; If not, check GCD
dcr a ; Check that it is 1
jz gcdchk ; If so, check next pair
push h ; GCD not 1 - save pointer
lxi d,gcdn ; Print message
mvi c,puts
call 5
pop h ; Calculate offset in array
lxi d,-seq
dad d
jmp prhl ; Print offset of pair whose GCD is not 1
done: lxi d,gcdy ; Print OK message
mvi c,puts
jmp 5
;;; GCD(A,B)
gcd: cmp b
rz ; If A=B, result = A
jc b_le_a ; B>A?
sub b ; If A>B, subtract B
jmp gcd ; and loop
b_le_a: mov c,a
mov a,b
sub c
mov b,a
mov a,c
jmp gcd
;;; Print indices of occurrences of C numbers
;;; starting at B
fnext: lxi d,seq
fsrch: ldax d ; Get current member
cmp b ; Is it the number we are looking for?
inx d ; Increment number
jnz fsrch ; If no match, check next number
lxi h,-seq ; Match - subtract start of array
dad d
call prhl ; Print index
inr b ; Look for next number
dcr c ; If we need more numbers
jnz fnext
push d ; Save sequence pointer
lxi d,nl ; Print newline
mvi c,puts
call 5
pop d ; Restore sequence pointer
ret
;;; Print HL as ASCII number.
prhl: push h ; Save all registers
push d
push b
lxi b,pnum ; Store pointer to num string on stack
push b
lxi b,-10 ; Divisor
prdgt: lxi d,-1
prdgtl: inx d ; Divide by 10 through trial subtraction
dad b
jc prdgtl
mvi a,'0'+10
add l ; L = remainder - 10
pop h ; Get pointer from stack
dcx h ; Store digit
mov m,a
push h ; Put pointer back on stack
xchg ; Put quotient in HL
mov a,h ; Check if zero
ora l
jnz prdgt ; If not, next digit
pop d ; Get pointer and put in DE
mvi c,9 ; CP/M print string
call 5
pop b ; Restore registers
pop d
pop h
ret
db '*****' ; Placeholder for number
pnum: db ' $'
nl: db 13,10,'$'
gcdn: db 'GCD not 1 at: $'
gcdy: db 'GCD of all pairs of consecutive members is 1.$'
seq: db 1,1 ; Sequence stored here

101
Task/Stern-Brocot-sequence/8086-Assembly/stern-brocot-sequence.8086 Normal file
View file

@ -0,0 +1,101 @@
puts: equ 9
cpu 8086
bits 16
org 100h
section .text
;;; Generate the first 1200 elemets of the Stern-Brocot sequence
mov cx,600 ; 2 elements generated per loop
mov si,seq
mov di,seq+2
lodsb
mov ah,al ; AH = predecessor
genseq: lodsb ; AL = considered member
add ah,al ; AH = sum
xchg ah,al ; Swap them (AL = sum, AH = member)
stosw ; Write sum and current considered member
loop genseq ; Loop 600 times
;;; Print first 15 members of sequence
mov si,seq
mov cx,15
p15: lodsb ; Get member
cbw
call prax ; Print member
loop p15
call prnl
;;; Print first occurrences of [1..10]
mov al,1
mov cx,10
call find
call prnl
;;; Print first occurrence of 100
mov al,100
mov cx,1
call find
call prnl
;;; Check pairs of GCDs
mov cx,1000 ; 1000 times
mov si,seq
lodsb
gcdchk: mov ah,al ; AH = last member, AL = current member
lodsb
mov dx,ax ; Calculate GCD
call gcd
dec dl ; See if it is 1
jnz .fail ; If not, failure
loop gcdchk ; Otherwise, check next pair
mov dx,gcdy ; GCD of all pairs is 0
jmp pstr
.fail: mov dx,gcdn ; GCD of current pair is not 0
call pstr
mov ax,si
sub ax,seq+1
jmp prax
;;; DL = gcd(DL,DH)
gcd: cmp dl,dh
jl .lt ; DL < DH
jg .gt ; DL > DH
ret
.lt: sub dh,dl ; DL < DH
jmp gcd
.gt: sub dl,dh ; DL > DH
jmp gcd
;;; Print indices of CX consecutive numbers starting
;;; at AL.
find: mov di,seq
push cx ; Keep loop counter
mov cx,-1
repne scasb ; Find AL starting at [DI]
pop cx ; Restore loop counter
xchg si,ax ; Keep AL in SI
mov ax,di ; Calculate index in sequence
sub ax,seq
call prax ; Output
xchg si,ax ; Restore AL
inc ax ; Increment
loop find ; Keep going CX times
ret
;;; Print newline
prnl: mov dx,nl
jmp pstr
;;; Print number in AX
;;; Destroys AX, BX, DX, BP
prax: mov bp,10 ; Divisor
mov bx,numbuf
.loop: xor dx,dx ; DX = 0
div bp ; Divide DX:AX by 10; DX = remainder
dec bx ; Move string pointer back
add dl,'0' ; Make ASCII digit
mov [bx],dl ; Write digit
test ax,ax ; Any digits left?
jnz .loop
mov dx,bx
pstr: mov ah,puts ; Print number string
int 21h
ret
section .data
gcdn: db 'GCD not 1 at: $'
gcdy: db 'GCD of all pairs of consecutive members is 1.$'
db '*****'
numbuf: db ' $'
nl: db 13,10,'$'
seq: db 1,1

74
Task/Stern-Brocot-sequence/ALGOL-68/stern-brocot-sequence.alg Normal file
View file

@ -0,0 +1,74 @@
BEGIN # find members of the Stern-Brocot sequence: starting from 1, 1 the #
# subsequent members are the previous two members summed followed by #
# the previous #
# iterative Greatest Common Divisor routine, returns the gcd of m and n #
PROC gcd = ( INT m, n )INT:
BEGIN
INT a := ABS m, b := ABS n;
WHILE b /= 0 DO
INT new a = b;
b := a MOD b;
a := new a
OD;
a
END # gcd # ;
# returns an array of the Stern-Brocot sequence up to n #
OP STERNBROCOT = ( INT n )[]INT:
BEGIN
[ 1 : IF ODD n THEN n + 1 ELSE n FI ]INT result;
IF n > 0 THEN
result[ 1 ] := result[ 2 ] := 1;
INT next pos := 2;
FOR i FROM 3 WHILE next pos < n DO
INT p1 = result[ i - 1 ];
result[ next pos +:= 1 ] := p1 + result[ i - 2 ];
result[ next pos +:= 1 ] := p1
OD
FI;
result[ 1 : n ]
END # STERNPROCOT # ;
FLEX[ 1 : 0 ]INT sb := STERNBROCOT 1000; # start with 1000 elements #
# if that isn't enough, more will be added later #
# show the first 15 elements of the sequence #
print( ( "The first 15 elements of the Stern-Brocot sequence are:", newline ) );
FOR i TO 15 DO
print( ( whole( sb[ i ], -3 ) ) )
OD;
print( ( newline, newline ) );
# find where the numbers 1-10 first appear #
INT found 10 := 0;
[ 10 ]INT pos 10; FOR i TO UPB pos 10 DO pos 10[ i ] := 0 OD;
FOR i TO UPB sb WHILE found 10 < 10 DO
INT sb i = sb[ i ];
IF sb i <= UPB pos 10 THEN
IF pos 10[ sb i ] = 0 THEN
# first occurance of this number #
pos 10[ sb i ] := i;
found 10 +:= 1
FI
FI
OD;
print( ( "The first positions of 1..", whole( UPB pos 10, 0 ), " in the sequence are:", newline ) );
FOR i TO UPB pos 10 DO
print( ( whole( i, -2 ), ":", whole( pos 10[ i ], 0 ), " " ) )
OD;
print( ( newline, newline ) );
# find where the number 100 first appears #
BOOL found 100 := FALSE;
FOR i WHILE NOT found 100 DO
IF i > UPB sb THEN
# need more elements #
sb := STERNBROCOT ( UPB sb * 2 )
FI;
IF sb[ i ] = 100 THEN
print( ( "100 first appears at position ", whole( i, 0 ), newline, newline ) );
found 100 := TRUE
FI
OD;
# check that the pairs of elements up to 1000 are coprime #
BOOL all coprime := TRUE;
FOR i FROM 2 TO 1000 WHILE all coprime DO
all coprime := gcd( sb[ i ], sb[ i - 1 ] ) = 1
OD;
print( ( "Element pairs up to 1000 are ", IF all coprime THEN "" ELSE "NOT " FI, "coprime", newline ) )
END

49
Task/Stern-Brocot-sequence/ALGOL-M/stern-brocot-sequence.alg Normal file
View file

@ -0,0 +1,49 @@
begin
integer array S[1:1200];
integer i,ok;
integer function gcd(a,b);
integer a,b;
gcd :=
if a>b then gcd(a-b,b)
else if a<b then gcd(a,b-a)
else a;
integer function first(n);
integer n;
begin
integer i;
i := 1;
while S[i]<>n do i := i + 1;
first := i;
end;
S[1] := S[2] := 1;
for i := 2 step 1 until 600 do
begin
S[i*2-1] := S[i] + S[i-1];
S[i*2] := S[i];
end;
write("First 15 numbers:");
for i := 1 step 1 until 15 do
begin
if i-i/5*5=1 then write(S[i]) else writeon(S[i]);
end;
write("");
write("First occurrence:");
for i := 1 step 1 until 10 do write(i, " at", first(i));
write(100, " at", first(100));
ok := 1;
for i := 1 step 1 until 999 do
begin
if gcd(S[i], S[i+1]) <> 1 then
begin
write("gcd",S[i],",",S[i+1],"<> 1");
ok := 0;
end;
end;
if ok = 1 then write("The GCD of each pair of consecutive members is 1.");
end

11
Task/Stern-Brocot-sequence/APL/stern-brocot-sequence.apl Normal file
View file

@ -0,0 +1,11 @@
task←{
stern←{⍵{
⍺←0 ⋄ ⍺⍺≤⍴⍵:⍺⍺↑⍵
(⍺+1)∇⍵,(+/,2⊃⊣)2↑⍺↓⍵
}1 1}
seq←stern 1200 ⍝ Cache 1200 elements
⎕←'First 15 elements:',15↑seq
⎕←'Locations of 1..10:',seq⍳⍳10
⎕←'Location of 100:',seq⍳100
⎕←'All GCDs 1:','no' 'yes'[1+1∧.=2∨/1000↑seq]
}

76
Task/Stern-Brocot-sequence/Action-/stern-brocot-sequence.action Normal file
View file

@ -0,0 +1,76 @@
PROC Generate(BYTE ARRAY seq INT POINTER count INT minCount,maxVal)
INT i
seq(0)=1 seq(1)=1 count^=2 i=1
WHILE count^<minCount OR seq(count^-1)#maxVal AND seq(count^-2)#maxVal
DO
seq(count^)=seq(i-1)+seq(i)
seq(count^+1)=seq(i)
count^==+2 i==+1
OD
RETURN
PROC PrintSeq(BYTE ARRAY seq INT count)
INT i
PrintF("First %I items:%E",count)
FOR i=0 TO count-1
DO
PrintB(seq(i)) Put(32)
OD
PutE() PutE()
RETURN
PROC PrintLoc(BYTE ARRAY seq INT seqCount
BYTE ARRAY loc INT locCount)
INT i,j
BYTE value
FOR i=0 TO locCount-1
DO
j=0 value=loc(i)
WHILE seq(j)#value
DO
j==+1
OD
PrintF("%B appears at position %I%E",value,j+1)
OD
PutE()
RETURN
BYTE FUNC Gcd(BYTE a,b)
BYTE tmp
IF a<b THEN
tmp=a a=b b=tmp
FI
WHILE b#0
DO
tmp=a MOD b
a=b b=tmp
OD
RETURN (a)
PROC PrintGcd(BYTE ARRAY seq INT count)
INT i
FOR i=0 TO count-2
DO
IF Gcd(seq(i),seq(i+1))>1 THEN
PrintF("GCD between %I and %I item is greater than 1",i+1,i+2)
RETURN
FI
OD
Print("GCD between all two consecutive items of the sequence is equal 1")
RETURN
PROC Main()
BYTE ARRAY seq(2000),loc=[1 2 3 4 5 6 7 8 9 10 100]
INT count
Generate(seq,@count,1000,100)
PrintSeq(seq,15)
PrintLoc(seq,count,loc,11)
PrintGcd(seq,1000)
RETURN

94
Task/Stern-Brocot-sequence/Ada/stern-brocot-sequence.ada Normal file
View file

@ -0,0 +1,94 @@
with Ada.Text_IO, Ada.Containers.Vectors;
procedure Sequence is
package Vectors is new
Ada.Containers.Vectors(Index_Type => Positive, Element_Type => Positive);
use type Vectors.Vector;
type Sequence is record
List: Vectors.Vector;
Index: Positive;
-- This implements some form of "lazy evaluation":
-- + List holds the elements computed, so far, it is extended
-- if the user tries to "Get" an element not yet computed;
-- + Index is the location of the next element under consideration
end record;
function Initialize return Sequence is
(List => (Vectors.Empty_Vector & 1 & 1), Index => 2);
function Get(Seq: in out Sequence; Location: Positive) return Positive is
-- returns the Location'th element of the sequence
-- extends Seq.List (and then increases Seq.Index) if neccessary
That: Positive := Seq.List.Element(Seq.Index);
This: Positive := That + Seq.List.Element(Seq.Index-1);
begin
while Seq.List.Last_Index < Location loop
Seq.List := Seq.List & This & That;
Seq.Index := Seq.Index + 1;
end loop;
return Seq.List.Element(Location);
end Get;
S: Sequence := Initialize;
J: Positive;
use Ada.Text_IO;
begin
-- show first fifteen members
Put("First 15:");
for I in 1 .. 15 loop
Put(Integer'Image(Get(S, I)));
end loop;
New_Line;
-- show the index where 1, 2, 3, ... first appear in the sequence
for I in 1 .. 10 loop
J := 1;
while Get(S, J) /= I loop
J := J + 1;
end loop;
Put("First" & Integer'Image(I) & " at" & Integer'Image(J) & "; ");
if I mod 4 = 0 then
New_Line; -- otherwise, the output gets a bit too ugly
end if;
end loop;
-- show the index where 100 first appears in the sequence
J := 1;
while Get(S, J) /= 100 loop
J := J + 1;
end loop;
Put_Line("First 100 at" & Integer'Image(J) & ".");
-- check GCDs
declare
function GCD (A, B : Integer) return Integer is
M : Integer := A;
N : Integer := B;
T : Integer;
begin
while N /= 0 loop
T := M;
M := N;
N := T mod N;
end loop;
return M;
end GCD;
A, B: Positive;
begin
for I in 1 .. 999 loop
A := Get(S, I);
B := Get(S, I+1);
if GCD(A, B) /= 1 then
raise Constraint_Error;
end if;
end loop;
Put_Line("Correct: The first 999 consecutive pairs are relative prime!");
exception
when Constraint_Error => Put_Line("Some GCD > 1; this is wrong!!!") ;
end;
end Sequence;

37
Task/Stern-Brocot-sequence/Amazing-Hopper/stern-brocot-sequence.hopper Normal file
View file

@ -0,0 +1,37 @@
#include <flow.h>
#include <flow-flow.h>
DEF-MAIN(argv,argc)
CLR-SCR
SET( amount, 1200 )
DIM(amount) AS-ONES( Stern )
/* Generate Stern-Brocot sequence: */
GOSUB( Generate Sequence )
PRNL( "Find 15 first: ", [1:19] CGET(Stern) )
/* show Stern-Brocot sequence: */
SET( i, 1 ), ITERATE( ++i, LE?(i,10), \
PRN( "First ",i," at "), {i} GOSUB( Find First ), PRNL )
PRN( "First 100 at "), {100} GOSUB( Find First ), PRNL
/* check GCD: */
ODD-POS, CGET(Stern), EVEN-POS, CGET(Stern), COMP-GCD, GET-SUMMATORY, DIV-INTO( DIV(amount,2) )
IF ( IS-EQ?(1), PRNL("The GCD of every pair of adjacent elements is 1"),\
PRNL("Stern-Brocot Sequence is wrong!") )
END
RUTINES
DEF-FUN(Find First, n )
RET ( SCAN(1, n, Stern) )
DEF-FUN(Generate Sequence)
SET(i,2)
FOR( LE?(i, DIV(amount,2)), ++i )
[i] GET( Stern ), [ MINUS-ONE(i) ] GET( Stern ), ADD-IT
[ SUB(MUL(i,2),1) ] CPUT( Stern )
[i] GET( Stern ), [MUL(i,2)] CPUT( Stern )
NEXT
RET

541
Task/Stern-Brocot-sequence/AppleScript/stern-brocot-sequence.applescript Normal file
View file

@ -0,0 +1,541 @@
use AppleScript version "2.4"
use framework "Foundation"
use scripting additions
------------------ STERN-BROCOT SEQUENCE -----------------
-- sternBrocot :: Generator [Int]
on sternBrocot()
script go
on |λ|(xs)
set x to snd(xs)
tail(xs) & {fst(xs) + x, x}
end |λ|
end script
fmapGen(my head, iterate(go, {1, 1}))
end sternBrocot
--------------------------- TEST -------------------------
on run
set sbs to take(1200, sternBrocot())
set ixSB to zip(sbs, enumFrom(1))
script low
on |λ|(x)
12 ≠ fst(x)
end |λ|
end script
script sameFst
on |λ|(a, b)
fst(a) = fst(b)
end |λ|
end script
script asList
on |λ|(x)
{fst(x), snd(x)}
end |λ|
end script
script below100
on |λ|(x)
100 ≠ fst(x)
end |λ|
end script
script fullyReduced
on |λ|(ab)
1 = gcd(|1| of ab, |2| of ab)
end |λ|
end script
unlines(map(showJSON, ¬
{take(15, sbs), ¬
take(10, map(asList, ¬
nubBy(sameFst, ¬
sortBy(comparing(fst), ¬
takeWhile(low, ixSB))))), ¬
asList's |λ|(fst(take(1, dropWhile(below100, ixSB)))), ¬
all(fullyReduced, take(1000, zip(sbs, tail(sbs))))}))
end run
--> [1,1,2,1,3,2,3,1,4,3,5,2,5,3,4]
--> [[1,32],[2,24],[3,40],[4,36],[5,44],[6,33],[7,38],[8,42],[9,35],[10,39]]
--> [100,1179]
--> true
------------------------- GENERIC ------------------------
-- Absolute value.
-- abs :: Num -> Num
on abs(x)
if 0 > x then
-x
else
x
end if
end abs
-- Applied to a predicate and a list, `all` determines if all elements
-- of the list satisfy the predicate.
-- all :: (a -> Bool) -> [a] -> Bool
on all(p, xs)
tell mReturn(p)
set lng to length of xs
repeat with i from 1 to lng
if not |λ|(item i of xs, i, xs) then return false
end repeat
true
end tell
end all
-- comparing :: (a -> b) -> (a -> a -> Ordering)
on comparing(f)
script
on |λ|(a, b)
tell mReturn(f)
set fa to |λ|(a)
set fb to |λ|(b)
if fa < fb then
-1
else if fa > fb then
1
else
0
end if
end tell
end |λ|
end script
end comparing
-- drop :: Int -> [a] -> [a]
-- drop :: Int -> String -> String
on drop(n, xs)
set c to class of xs
if c is not script then
if c is not string then
if n < length of xs then
items (1 + n) thru -1 of xs
else
{}
end if
else
if n < length of xs then
text (1 + n) thru -1 of xs
else
""
end if
end if
else
take(n, xs) -- consumed
return xs
end if
end drop
-- dropWhile :: (a -> Bool) -> [a] -> [a]
-- dropWhile :: (Char -> Bool) -> String -> String
on dropWhile(p, xs)
set lng to length of xs
set i to 1
tell mReturn(p)
repeat while i ≤ lng and |λ|(item i of xs)
set i to i + 1
end repeat
end tell
drop(i - 1, xs)
end dropWhile
-- enumFrom :: a -> [a]
on enumFrom(x)
script
property v : missing value
property blnNum : class of x is not text
on |λ|()
if missing value is not v then
if blnNum then
set v to 1 + v
else
set v to succ(v)
end if
else
set v to x
end if
return v
end |λ|
end script
end enumFrom
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmapGen(f, gen)
script
property g : gen
property mf : mReturn(f)'s |λ|
on |λ|()
set v to g's |λ|()
if v is missing value then
v
else
mf(v)
end if
end |λ|
end script
end fmapGen
-- fst :: (a, b) -> a
on fst(tpl)
if class of tpl is record then
|1| of tpl
else
item 1 of tpl
end if
end fst
-- gcd :: Int -> Int -> Int
on gcd(a, b)
set x to abs(a)
set y to abs(b)
repeat until y = 0
if x > y then
set x to x - y
else
set y to y - x
end if
end repeat
return x
end gcd
-- head :: [a] -> a
on head(xs)
if xs = {} then
missing value
else
item 1 of xs
end if
end head
-- iterate :: (a -> a) -> a -> Gen [a]
on iterate(f, x)
script
property v : missing value
property g : mReturn(f)'s |λ|
on |λ|()
if missing value is v then
set v to x
else
set v to g(v)
end if
return v
end |λ|
end script
end iterate
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs
if list is c or string is c then
length of xs
else
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
end if
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- nubBy :: (a -> a -> Bool) -> [a] -> [a]
on nubBy(f, xs)
set g to mReturn(f)'s |λ|
script notEq
property fEq : g
on |λ|(a)
script
on |λ|(b)
not fEq(a, b)
end |λ|
end script
end |λ|
end script
script go
on |λ|(xs)
if (length of xs) > 1 then
set x to item 1 of xs
{x} & go's |λ|(filter(notEq's |λ|(x), items 2 thru -1 of xs))
else
xs
end if
end |λ|
end script
go's |λ|(xs)
end nubBy
-- partition :: predicate -> List -> (Matches, nonMatches)
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
on partition(f, xs)
tell mReturn(f)
set ys to {}
set zs to {}
repeat with x in xs
set v to contents of x
if |λ|(v) then
set end of ys to v
else
set end of zs to v
end if
end repeat
end tell
Tuple(ys, zs)
end partition
-- showJSON :: a -> String
on showJSON(x)
set c to class of x
if (c is list) or (c is record) then
set ca to current application
set {json, e} to ca's NSJSONSerialization's dataWithJSONObject:x options:0 |error|:(reference)
if json is missing value then
e's localizedDescription() as text
else
(ca's NSString's alloc()'s initWithData:json encoding:(ca's NSUTF8StringEncoding)) as text
end if
else if c is date then
"\"" & ((x - (time to GMT)) as «class isot» as string) & ".000Z" & "\""
else if c is text then
"\"" & x & "\""
else if (c is integer or c is real) then
x as text
else if c is class then
"null"
else
try
x as text
on error
("«" & c as text) & "»"
end try
end if
end showJSON
-- snd :: (a, b) -> b
on snd(tpl)
if class of tpl is record then
|2| of tpl
else
item 2 of tpl
end if
end snd
-- Enough for small scale sorts.
-- Use instead sortOn :: Ord b => (a -> b) -> [a] -> [a]
-- which is equivalent to the more flexible sortBy(comparing(f), xs)
-- and uses a much faster ObjC NSArray sort method
-- sortBy :: (a -> a -> Ordering) -> [a] -> [a]
on sortBy(f, xs)
if length of xs > 1 then
set h to item 1 of xs
set f to mReturn(f)
script
on |λ|(x)
f's |λ|(x, h) ≤ 0
end |λ|
end script
set lessMore to partition(result, rest of xs)
sortBy(f, |1| of lessMore) & {h} & ¬
sortBy(f, |2| of lessMore)
else
xs
end if
end sortBy
-- tail :: [a] -> [a]
on tail(xs)
set blnText to text is class of xs
if blnText then
set unit to ""
else
set unit to {}
end if
set lng to length of xs
if 1 > lng then
missing value
else if 2 > lng then
unit
else
if blnText then
text 2 thru -1 of xs
else
rest of xs
end if
end if
end tail
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs
if list is c then
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
else if string is c then
if 0 < n then
text 1 thru min(n, length of xs) of xs
else
""
end if
else if script is c then
set ys to {}
repeat with i from 1 to n
set v to xs's |λ|()
if missing value is v then
return ys
else
set end of ys to v
end if
end repeat
return ys
else
missing value
end if
end take
-- takeWhile :: (a -> Bool) -> [a] -> [a]
-- takeWhile :: (Char -> Bool) -> String -> String
on takeWhile(p, xs)
if script is class of xs then
takeWhileGen(p, xs)
else
tell mReturn(p)
repeat with i from 1 to length of xs
if not |λ|(item i of xs) then ¬
return take(i - 1, xs)
end repeat
end tell
return xs
end if
end takeWhile
-- takeWhileGen :: (a -> Bool) -> Gen [a] -> [a]
on takeWhileGen(p, xs)
set ys to {}
set v to |λ|() of xs
tell mReturn(p)
repeat while (|λ|(v))
set end of ys to v
set v to xs's |λ|()
end repeat
end tell
return ys
end takeWhileGen
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
-- unlines :: [String] -> String
on unlines(xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines
-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
zipWith(Tuple, xs, ys)
end zip
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
set lng to min(|length|(xs), |length|(ys))
if 1 > lng then return {}
set xs_ to take(lng, xs) -- Allow for non-finite
set ys_ to take(lng, ys) -- generators like cycle etc
set lst to {}
tell mReturn(f)
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs_, item i of ys_)
end repeat
return lst
end tell
end zipWith

50
Task/Stern-Brocot-sequence/Arturo/stern-brocot-sequence.arturo Normal file
View file

@ -0,0 +1,50 @@
sternBrocot: function [mx][
seq: [1 1]
result: [[1 1] [2 1]]
idx: 1
while [idx < mx][
'seq ++ seq\[idx] + seq\[idx - 1]
'result ++ @[@[size seq, last seq]]
'seq ++ seq\[idx]
'result ++ @[@[size seq, last seq]]
inc 'idx
]
return result
]
sbs: sternBrocot 1000
print ["First 15 terms:" join.with:", " first.n:15 map sbs 'sb -> to :string last sb]
print ""
indexes: array.of:101 0
toFind: 101
loop sbs 'sb [
[i, n]: sb
if and? -> contains? 1..100 n -> zero? indexes\[n][
indexes\[n]: i
dec 'toFind
if zero? toFind [
break
]
]
]
loop (@1..10) ++ 100 'n ->
print ["Index of first occurrence of number" n ":" indexes\[n]]
print ""
prev: 1
idx: 1
loop sbs 'sb [
[i, n]: sb
if not? one? gcd @[prev n] -> break
prev: n
inc 'idx
if idx > 1000 -> break
]
print (idx =< 1000)? -> ["Found two successive terms at index:" idx]
-> "All consecutive terms up to the 1000th member have a GCD equal to one."

77
Task/Stern-Brocot-sequence/AutoHotkey/stern-brocot-sequence.ahk Normal file
View file

@ -0,0 +1,77 @@
Found := FindOneToX(100), FoundList := ""
Loop, 10
FoundList .= "First " A_Index " found at " Found[A_Index] "`n"
MsgBox, 64, Stern-Brocot Sequence
, % "First 15: " FirstX(15) "`n"
. FoundList
. "First 100 found at " Found[100] "`n"
. "GCDs of all two consecutive members are " (GCDsUpToXAreOne(1000) ? "" : "not ") "one."
return
class SternBrocot
{
__New()
{
this[1] := 1
this[2] := 1
this.Consider := 2
}
InsertPair()
{
n := this.Consider
this.Push(this[n] + this[n - 1], this[n])
this.Consider++
}
}
; Show the first fifteen members of the sequence. (This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3,
; 5, 2, 5, 3, 4)
FirstX(x)
{
SB := new SternBrocot()
while SB.MaxIndex() < x
SB.InsertPair()
Loop, % x
Out .= SB[A_Index] ", "
return RTrim(Out, " ,")
}
; Show the (1-based) index of where the numbers 1-to-10 first appears in the sequence.
; Show the (1-based) index of where the number 100 first appears in the sequence.
FindOneToX(x)
{
SB := new SternBrocot(), xRequired := x, Found := []
while xRequired > 0 ; While the count of numbers yet to be found is > 0.
{
Loop, 2 ; Consider the second last member and then the last member.
{
n := SB[i := SB.MaxIndex() - 2 + A_Index]
; If number (n) has not been found yet, and it is less than the maximum number to
; find (x), record the index (i) and decrement the count of numbers yet to be found.
if (Found[n] = "" && n <= x)
Found[n] := i, xRequired--
}
SB.InsertPair() ; Insert the two members that will be checked next.
}
return Found
}
; Check that the greatest common divisor of all the two consecutive members of the series up to
; the 1000th member, is always one.
GCDsUpToXAreOne(x)
{
SB := new SternBrocot()
while SB.MaxIndex() < x
SB.InsertPair()
Loop, % x - 1
if GCD(SB[A_Index], SB[A_Index + 1]) > 1
return 0
return 1
}
GCD(a, b) {
while b
b := Mod(a | 0x0, a := b)
return a
}

22
Task/Stern-Brocot-sequence/BASIC/stern-brocot-sequence.basic Normal file
View file

@ -0,0 +1,22 @@
10 DEFINT A,B,I,J,S: DIM S(1200)
20 S(1)=1: S(2)=1
30 FOR I=2 TO 600
40 S(I*2-1)=S(I)+S(I-1)
50 S(I*2)=S(I)
60 NEXT I
70 PRINT "First 15 elements: ";
80 FOR I=1 TO 15: PRINT USING"# ";S(I);: NEXT I
85 PRINT
90 FOR I=1 TO 10
100 FOR J=1 TO 1200: IF S(J)<>I THEN NEXT J
110 PRINT "First";I;"at";J
120 NEXT I
130 FOR J=1 TO 1200: IF S(J)<>100 THEN NEXT J
140 PRINT "First 100 at";J
150 FOR I=2 TO 1000
160 A=S(I): B=S(I-1)
170 J=A: A=B: B=J MOD A: IF B THEN 170
180 IF A<>1 THEN PRINT "GCD <> 1 at ";I: STOP
190 NEXT I
200 PRINT "All GCDs are 1."
210 END

63
Task/Stern-Brocot-sequence/BASIC256/stern-brocot-sequence.basic Normal file
View file

@ -0,0 +1,63 @@
arraybase 1
max = 2000
global stern
dim stern(max+2)
subroutine SternBrocot()
stern[1] = 1
stern[2] = 1
i = 2 : n = 2 : ub = stern[?]
while i < ub
i += 1
stern[i] = stern[n] + stern[n-1]
i += 1
stern[i] = stern[n]
n += 1
end while
end subroutine
function gcd(x, y)
while y
t = y
y = x mod y
x = t
end while
gcd = x
end function
call SternBrocot()
print "The first 15 are: ";
for i = 1 to 15
print stern[i]; " ";
next i
print : print
print "Index First nr."
d = 1
for i = 1 to max
if stern[i] = d then
print i; chr(9); stern[i]
d += 1
if d = 11 then d = 100
if d = 101 then exit for
i = 0
end if
next i
print : print
d = 0
for i = 1 to 1000
if gcd(stern[i], stern[i+1]) <> 1 then
d = gcd(stern[i], stern[i+1])
exit for
end if
next i
if d = 0 then
print "GCD of two consecutive members of the series up to the 1000th member is 1"
else
print "The GCD for index "; i; " and "; i+1; " = "; d
end if

44
Task/Stern-Brocot-sequence/BCPL/stern-brocot-sequence.bcpl Normal file
View file

@ -0,0 +1,44 @@
get "libhdr"
manifest $( AMOUNT = 1200 $)
let gcd(a,b) =
a>b -> gcd(a-b, b),
a<b -> gcd(a, b-a),
a
let mkstern(s, n) be
$( s!1 := 1
s!2 := 1
for i=2 to n/2 do
$( s!(i*2-1) := s!i + s!(i-1)
s!(i*2) := s!i
$)
$)
let find(v, n, max) = valof
for i=1 to max
if v!i=n then resultis i
let findwrite(v, n, max) be
writef("%I3 at %I4*N", n, find(v, n, max))
let start() be
$( let stern = vec AMOUNT
mkstern(stern, AMOUNT)
writes("First 15 numbers: ")
for i=1 to 15 do writef("%N ", stern!i)
writes("*N*NFirst occurrence:*N")
for i=1 to 10 do findwrite(stern, i, AMOUNT)
findwrite(stern, 100, AMOUNT)
if valof
$( for i=2 to AMOUNT
unless gcd(stern!i, stern!(i-1)) = 1
resultis false
resultis true
$) then
writes("*NThe GCD of each pair of consecutive members is 1.*N")
$)

50
Task/Stern-Brocot-sequence/C++/stern-brocot-sequence.cpp Normal file
View file

@ -0,0 +1,50 @@
#include <iostream>
#include <iomanip>
#include <algorithm>
#include <vector>
unsigned gcd( unsigned i, unsigned j ) {
return i ? i < j ? gcd( j % i, i ) : gcd( i % j, j ) : j;
}
void createSequence( std::vector<unsigned>& seq, int c ) {
if( 1500 == seq.size() ) return;
unsigned t = seq.at( c ) + seq.at( c + 1 );
seq.push_back( t );
seq.push_back( seq.at( c + 1 ) );
createSequence( seq, c + 1 );
}
int main( int argc, char* argv[] ) {
std::vector<unsigned> seq( 2, 1 );
createSequence( seq, 0 );
std::cout << "First fifteen members of the sequence:\n ";
for( unsigned x = 0; x < 15; x++ ) {
std::cout << seq[x] << " ";
}
std::cout << "\n\n";
for( unsigned x = 1; x < 11; x++ ) {
std::vector<unsigned>::iterator i = std::find( seq.begin(), seq.end(), x );
if( i != seq.end() ) {
std::cout << std::setw( 3 ) << x << " is at pos. #" << 1 + distance( seq.begin(), i ) << "\n";
}
}
std::cout << "\n";
std::vector<unsigned>::iterator i = std::find( seq.begin(), seq.end(), 100 );
if( i != seq.end() ) {
std::cout << 100 << " is at pos. #" << 1 + distance( seq.begin(), i ) << "\n";
}
std::cout << "\n";
unsigned g;
bool f = false;
for( int x = 0, y = 1; x < 1000; x++, y++ ) {
g = gcd( seq[x], seq[y] );
if( g != 1 ) f = true;
std::cout << std::setw( 4 ) << x + 1 << ": GCD (" << seq[x] << ", "
<< seq[y] << ") = " << g << ( g != 1 ? " <-- ERROR\n" : "\n" );
}
std::cout << "\n" << ( f ? "THERE WERE ERRORS --- NOT ALL GCDs ARE '1'!" : "CORRECT: ALL GCDs ARE '1'!" ) << "\n\n";
return 0;
}

26
Task/Stern-Brocot-sequence/C-sharp/stern-brocot-sequence.cs Normal file
View file

@ -0,0 +1,26 @@
using System;
using System.Collections.Generic;
using System.Linq;
static class Program {
static List<int> l = new List<int>() { 1, 1 };
static int gcd(int a, int b) {
return a > 0 ? a < b ? gcd(b % a, a) : gcd(a % b, b) : b; }
static void Main(string[] args) {
int max = 1000; int take = 15; int i = 1;
int[] selection = new[] { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 100 };
do { l.AddRange(new List<int>() { l[i] + l[i - 1], l[i] }); i += 1; }
while (l.Count < max || l[l.Count - 2] != selection.Last());
Console.Write("The first {0} items In the Stern-Brocot sequence: ", take);
Console.WriteLine("{0}\n", string.Join(", ", l.Take(take)));
Console.WriteLine("The locations of where the selected numbers (1-to-10, & 100) first appear:");
foreach (int ii in selection) {
int j = l.FindIndex(x => x == ii) + 1; Console.WriteLine("{0,3}: {1:n0}", ii, j); }
Console.WriteLine(); bool good = true;
for (i = 1; i <= max; i++) { if (gcd(l[i], l[i - 1]) != 1) { good = false; break; } }
Console.WriteLine("The greatest common divisor of all the two consecutive items of the" +
" series up to the {0}th item is {1}always one.", max, good ? "" : "not ");
}
}

38
Task/Stern-Brocot-sequence/C/stern-brocot-sequence-1.c Normal file
View file

@ -0,0 +1,38 @@
#include <stdio.h>
typedef unsigned int uint;
/* the sequence, 0-th member is 0 */
uint f(uint n)
{
return n < 2 ? n : (n&1) ? f(n/2) + f(n/2 + 1) : f(n/2);
}
uint gcd(uint a, uint b)
{
return a ? a < b ? gcd(b%a, a) : gcd(a%b, b) : b;
}
void find(uint from, uint to)
{
do {
uint n;
for (n = 1; f(n) != from ; n++);
printf("%3u at Stern #%u.\n", from, n);
} while (++from <= to);
}
int main(void)
{
uint n;
for (n = 1; n < 16; n++) printf("%u ", f(n));
puts("are the first fifteen.");
find(1, 10);
find(100, 0);
for (n = 1; n < 1000 && gcd(f(n), f(n+1)) == 1; n++);
printf(n == 1000 ? "All GCDs are 1.\n" : "GCD of #%d and #%d is not 1", n, n+1);
return 0;
}

10
Task/Stern-Brocot-sequence/C/stern-brocot-sequence-2.c Normal file
View file

@ -0,0 +1,10 @@
uint f(uint n)
{
uint a = 1, b = 0;
while (n) {
if (n&1) b += a;
else a += b;
n >>= 1;
}
return b;
}

51
Task/Stern-Brocot-sequence/CLU/stern-brocot-sequence.clu Normal file
View file

@ -0,0 +1,51 @@
stern = proc (n: int) returns (array[int])
s: array[int] := array[int]$fill(1, n, 1)
for i: int in int$from_to(2, n/2) do
s[i*2-1] := s[i] + s[i-1]
s[i*2] := s[i]
end
return (s)
end stern
gcd = proc (a,b: int) returns (int)
while b ~= 0 do
a, b := b, a//b
end
return (a)
end gcd
find = proc [T: type] (a: array[T], val: T) returns (int) signals (not_found)
where T has equal: proctype (T,T) returns (bool)
for i: int in array[T]$indexes(a) do
if a[i] = val then return (i) end
end
signal not_found
end find
start_up = proc ()
po: stream := stream$primary_output()
s: array[int] := stern(1200)
stream$puts(po, "First 15 numbers:")
for i: int in int$from_to(1, 15) do
stream$puts(po, " " || int$unparse(s[i]))
end
stream$putl(po, "")
for i: int in int$from_to(1, 10) do
stream$putl(po, "First " || int$unparse(i) || " at " ||
int$unparse(find[int](s, i)))
end
stream$putl(po, "First 100 at " || int$unparse(find[int](s, 100)))
begin
for i: int in int$from_to(2, array[int]$high(s)) do
if gcd(s[i-1], s[i]) ~= 1 then
exit gcd_not_one(i)
end
end
stream$putl(po, "The GCD of every pair of adjacent elements is 1.")
end except when gcd_not_one(i: int):
stream$putl(po, "The GCD of the pair at " || int$unparse(i) || " is not 1.")
end
end start_up

34
Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-1.clj Normal file
View file

@ -0,0 +1,34 @@
;; each step adds two items
(defn sb-step [v]
(let [i (quot (count v) 2)]
(conj v (+ (v (dec i)) (v i)) (v i))))
;; A lazy, infinite sequence -- `take` what you want.
(def all-sbs (sequence (map peek) (iterate sb-step [1 1])))
;; zero-based
(defn first-appearance [n]
(first (keep-indexed (fn [i x] (when (= x n) i)) all-sbs)))
;; inlined abs; rem is slightly faster than mod, and the same result for positive values
(defn gcd [a b]
(loop [a (if (neg? a) (- a) a)
b (if (neg? b) (- b) b)]
(if (zero? b)
a
(recur b (rem a b)))))
(defn check-pairwise-gcd [cnt]
(let [sbs (take (inc cnt) all-sbs)]
(every? #(= 1 %) (map gcd sbs (rest sbs)))))
;; one-based index required by problem statement
(defn report-sb []
(println "First 15 Stern-Brocot members:" (take 15 all-sbs))
(println "First appearance of N at 1-based index:")
(doseq [n [1 2 3 4 5 6 7 8 9 10 100]]
(println " first" n "at" (inc (first-appearance n))))
(println "Check pairwise GCDs = 1 ..." (check-pairwise-gcd 1000))
true)
(report-sb)

32
Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-2.clj Normal file
View file

@ -0,0 +1,32 @@
(ns test-p.core)
(defn gcd
"(gcd a b) computes the greatest common divisor of a and b."
[a b]
(if (zero? b)
a
(recur b (mod a b))))
(defn stern-brocat-next [p]
" p is the block of the sequence we are using to compute the next block
This routine computes the next block "
(into [] (concat (rest p) [(+ (first p) (second p))] [(second p)])))
(defn seq-stern-brocat
([] (seq-stern-brocat [1 1]))
([p] (lazy-seq (cons (first p)
(seq-stern-brocat (stern-brocat-next p))))))
; First 15 elements
(println (take 15 (seq-stern-brocat)))
; Where numbers 1 to 10 first appear
(doseq [n (concat (range 1 11) [100])]
(println "The first appearnce of" n "is at index" (some (fn [[i k]] (when (= k n) (inc i)))
(map-indexed vector (seq-stern-brocat)))))
;; Check that gcd between 1st 1000 consecutive elements equals 1
; Create cosecutive pairs of 1st 1000 elements
(def one-thousand-pairs (take 1000 (partition 2 1 (seq-stern-brocat))))
; Check every pair has a gcd = 1
(println (every? (fn [[ith ith-plus-1]] (= (gcd ith ith-plus-1) 1))
one-thousand-pairs))

56
Task/Stern-Brocot-sequence/Common-Lisp/stern-brocot-sequence.lisp Normal file
View file

@ -0,0 +1,56 @@
(defun stern-brocot (numbers)
(declare ((or null (vector integer)) numbers))
(cond ((null numbers)
(setf numbers (make-array 2 :element-type 'integer :adjustable t :fill-pointer t
:initial-element 1)))
((zerop (length numbers))
(vector-push-extend 1 numbers)
(vector-push-extend 1 numbers))
(t
(assert (evenp (length numbers)))
(let* ((considered-index (/ (length numbers) 2))
(considered (aref numbers considered-index))
(precedent (aref numbers (1- considered-index))))
(vector-push-extend (+ considered precedent) numbers)
(vector-push-extend considered numbers))))
numbers)
(defun first-15 ()
(loop for input = nil then seq
for seq = (stern-brocot input)
while (< (length seq) 15)
finally (format t "First 15: ~{~A~^ ~}~%" (coerce (subseq seq 0 15) 'list))))
(defun first-1-to-10 ()
(loop with seq = (stern-brocot nil)
for i from 1 to 10
for index = (loop with start = 0
for pos = (position i seq :start start)
until pos
do (setf start (length seq)
seq (stern-brocot seq))
finally (return (1+ pos)))
do (format t "First ~D at ~D~%" i index)))
(defun first-100 ()
(loop for input = nil then seq
for start = (length input)
for seq = (stern-brocot input)
for pos = (position 100 seq :start start)
until pos
finally (format t "First 100 at ~D~%" (1+ pos))))
(defun check-gcd ()
(loop for input = nil then seq
for seq = (stern-brocot input)
while (< (length seq) 1000)
finally (if (loop for i from 0 below 999
always (= 1 (gcd (aref seq i) (aref seq (1+ i)))))
(write-line "Correct. The GCDs of all the two consecutive numbers are 1.")
(write-line "Wrong."))))
(defun main ()
(first-15)
(first-1-to-10)
(first-100)
(check-gcd))

77
Task/Stern-Brocot-sequence/Cowgol/stern-brocot-sequence.cowgol Normal file
View file

@ -0,0 +1,77 @@
include "cowgol.coh";
# Redefining these is enough to change the type and length everywhere,
# but arrays are 0-based so you need one extra element.
typedef Stern is uint8; # 8-bit math is enough for the numbers we need
var stern: Stern[1201]; # Array containing Stern-Brocot sequence
# Fill up the Stern-Brocot array
sub GenStern() is
stern[1] := 1;
stern[2] := 1;
var i: @indexof stern := 1;
var last: @indexof stern := @sizeof stern / 2;
while i <= last loop
stern[i*2-1] := stern[i] + stern[i-1];
stern[i*2] := stern[i];
i := i + 1;
end loop;
end sub;
# Find the first location of a given number
sub FindFirst(n: Stern): (i: @indexof stern) is
i := 1;
while i < @sizeof stern and stern[i] != n loop
i := i + 1;
end loop;
end sub;
GenStern(); # Generate sequence
# Print the first 15 numbers
var i: @indexof stern := 1;
while i <= 15 loop
print_i32(stern[i] as uint32);
print_char(' ');
i := i + 1;
end loop;
print_nl();
# Print the first occurrence of 1..10
var j: Stern := 1;
while j <= 10 loop
print_i32(FindFirst(j) as uint32);
print_char(' ');
j := j + 1;
end loop;
print_nl();
# Print the first occurrence of 100
print_i32(FindFirst(100) as uint32);
print_nl();
# Check that all GCDs of consecutive pairs are 1
sub gcd(a: Stern, b: Stern): (r: Stern) is
while a != b loop
if a > b then
a := a - b;
else
b := b - a;
end if;
end loop;
r := a;
end sub;
i := 1;
while i < @sizeof stern / 2 loop
if gcd(stern[i], stern[i+1]) != 1 then
print("GCD not 1 at: ");
print_i32(i as uint32);
print_nl();
ExitWithError();
end if;
i := i + 1;
end loop;
print("All GCDs are 1.\n");

29
Task/Stern-Brocot-sequence/D/stern-brocot-sequence-1.d Normal file
View file

@ -0,0 +1,29 @@
import std.stdio, std.numeric, std.range, std.algorithm;
/// Generates members of the stern-brocot series, in order,
/// returning them when the predicate becomes false.
uint[] sternBrocot(bool delegate(in uint[]) pure nothrow @safe @nogc pred=seq => seq.length < 20)
pure nothrow @safe {
typeof(return) sb = [1, 1];
size_t i = 0;
while (pred(sb)) {
sb ~= [sb[i .. i + 2].sum, sb[i + 1]];
i++;
}
return sb;
}
void main() {
enum nFirst = 15;
writefln("The first %d values:\n%s\n", nFirst,
sternBrocot(seq => seq.length < nFirst).take(nFirst));
foreach (immutable nOccur; iota(1, 10 + 1).chain(100.only))
writefln("1-based index of the first occurrence of %3d in the series: %d",
nOccur, sternBrocot(seq => nOccur != seq[$ - 2]).length - 1);
enum nGcd = 1_000;
auto s = sternBrocot(seq => seq.length < nGcd).take(nGcd);
assert(zip(s, s.dropOne).all!(ss => ss[].gcd == 1),
"A fraction from adjacent terms is reducible.");
}

18
Task/Stern-Brocot-sequence/D/stern-brocot-sequence-2.d Normal file
View file

@ -0,0 +1,18 @@
import std.stdio, std.algorithm, std.range, std.numeric, queue_usage2;
struct SternBrocot {
private auto sb = GrowableCircularQueue!uint(1, 1);
enum empty = false;
@property uint front() pure nothrow @safe @nogc {
return sb.front;
}
uint popFront() pure nothrow @safe {
sb.push(sb.front + sb[1]);
sb.push(sb[1]);
return sb.pop;
}
}
void main() {
SternBrocot().drop(50_000_000).front.writeln;
}

28
Task/Stern-Brocot-sequence/D/stern-brocot-sequence-3.d Normal file
View file

@ -0,0 +1,28 @@
void main() {
import std.stdio, std.numeric, std.range, std.algorithm, std.bigint, std.conv;
/// Stern-Brocot sequence, 0-th member is 0.
T sternBrocot(T)(T n) pure nothrow /*safe*/ {
T a = 1, b = 0;
while (n) {
if (n & 1) b += a;
else a += b;
n >>= 1;
}
return b;
}
alias sb = sternBrocot!uint;
enum nFirst = 15;
writefln("The first %d values:\n%s\n", nFirst, iota(1, nFirst + 1).map!sb);
foreach (immutable nOccur; iota(1, 10 + 1).chain(100.only))
writefln("1-based index of the first occurrence of %3d in the series: %d",
nOccur, sequence!q{n}.until!(n => sb(n) == nOccur).walkLength);
auto s = iota(1, 1_001).map!sb;
assert(s.zip(s.dropOne).all!(ss => ss[].gcd == 1),
"A fraction from adjacent terms is reducible.");
sternBrocot(10.BigInt ^^ 20_000).text.length.writeln;
}

9
Task/Stern-Brocot-sequence/EchoLisp/stern-brocot-sequence-1.l Normal file
View file

@ -0,0 +1,9 @@
;; stern (2n ) = stern (n)
;; stern(2n+1) = stern(n) + stern(n+1)
(define (stern n)
(cond
(( < n 3) 1)
((even? n) (stern (/ n 2)))
(else (let ((m (/ (1- n) 2))) (+ (stern m) (stern (1+ m)))))))
(remember 'stern)

20
Task/Stern-Brocot-sequence/EchoLisp/stern-brocot-sequence-2.l Normal file
View file

@ -0,0 +1,20 @@
; generate the sequence and check GCD
(for ((n 10000))
(unless (= (gcd (stern n) (stern (1+ n))) 1) (error "BAD GCD" n)))
→ #t
;; first items
(define sterns (cache 'stern))
(subvector sterns 1 16)
→ #( 1 1 2 1 3 2 3 1 4 3 5 2 5 3 4)
;; first occurences index
(for ((i (in-range 1 11))) (write (vector-index i sterns)))
→ 0 3 5 9 11 33 19 21 35 39
;; 100
(writeln (vector-index 100 sterns))
→ 1179
(stern 900000) → 446
(stern 900001) → 2479

13
Task/Stern-Brocot-sequence/EchoLisp/stern-brocot-sequence-3.l Normal file
View file

@ -0,0 +1,13 @@
;; grouping
(for ((i (in-range 2 40 2))) (write (/ (stern i)(stern (1+ i)))))
→ 1/2 1/3 2/3 1/4 3/5 2/5 3/4 1/5 4/7 3/8 5/7 2/7 5/8 3/7 4/5 1/6 5/9 4/11 7/10
;; computing f(1), f(f(1)), etc.
(define (f x)
(let [(a (/ (- (floor x) -1 (fract x))))]
(if (> a 1) (f a) (cons a a))))
(define T (make-stream f 1))
(for((i 19)) (write (stream-iterate T)))
→ 1/2 1/3 2/3 1/4 3/5 2/5 3/4 1/5 4/7 3/8 5/7 2/7 5/8 3/7 4/5 1/6 5/9 4/11 7/10

28
Task/Stern-Brocot-sequence/Elixir/stern-brocot-sequence.elixir Normal file
View file

@ -0,0 +1,28 @@
defmodule SternBrocot do
def sequence do
Stream.unfold({0,{1,1}}, fn {i,acc} ->
a = elem(acc, i)
b = elem(acc, i+1)
{a, {i+1, Tuple.append(acc, a+b) |> Tuple.append(b)}}
end)
end
def task do
IO.write "First fifteen members of the sequence:\n "
IO.inspect Enum.take(sequence, 15)
Enum.each(Enum.concat(1..10, [100]), fn n ->
i = Enum.find_index(sequence, &(&1==n)) + 1
IO.puts "#{n} first appears at #{i}"
end)
Enum.take(sequence, 1000)
|> Enum.chunk(2,1)
|> Enum.all?(fn [a,b] -> gcd(a,b) == 1 end)
|> if(do: "All GCD's are 1", else: "Whoops, not all GCD's are 1!")
|> IO.puts
end
defp gcd(a,0), do: abs(a)
defp gcd(a,b), do: gcd(b, rem(a,b))
end
SternBrocot.task

2
Task/Stern-Brocot-sequence/F-Sharp/stern-brocot-sequence-1.fs Normal file
View file

@ -0,0 +1,2 @@
// Generate Stern-Brocot Sequence. Nigel Galloway: October 11th., 2018
let sb=Seq.unfold(fun (n::g::t)->Some(n,[g]@t@[n+g;g]))[1;1]

4
Task/Stern-Brocot-sequence/F-Sharp/stern-brocot-sequence-2.fs Normal file
View file

@ -0,0 +1,4 @@
sb |> Seq.take 15 |> Seq.iter(printf "%d ");printfn ""
[1..10] |> List.map(fun n->(n,(sb|>Seq.findIndex(fun g->g=n))+1)) |> List.iter(printf "%A ");printfn ""
printfn "%d" ((sb|>Seq.findIndex(fun g->g=100))+1)
printfn "There are %d consecutive members, of the first thousand members, with GCD <> 1" (sb |> Seq.take 1000 |>Seq.pairwise |> Seq.filter(fun(n,g)->gcd n g <> 1) |> Seq.length)

31
Task/Stern-Brocot-sequence/Factor/stern-brocot-sequence.factor Normal file
View file

@ -0,0 +1,31 @@
USING: formatting io kernel lists lists.lazy locals math
math.ranges prettyprint sequences ;
IN: rosetta-code.stern-brocot
: fn ( n -- m )
[ 1 0 ] dip
[ dup zero? ] [
dup 1 bitand zero?
[ dupd [ + ] 2dip ]
[ [ dup ] [ + ] [ ] tri* ] if
-1 shift
] until drop nip ;
:: search ( n -- m )
1 0 lfrom [ fn n = ] lfilter ltake list>array first ;
: first15 ( -- )
15 [1,b] [ fn pprint bl ] each
"are the first fifteen." print ;
: first-appearances ( -- )
10 [1,b] 100 suffix
[ dup search "First %3u at Stern #%u.\n" printf ] each ;
: gcd-test ( -- )
1,000 [1,b] [ dup 1 + [ fn ] bi@ gcd nip 1 = not ] filter
empty? "" " not" ? "All GCDs are%s 1.\n" printf ;
: main ( -- ) first15 first-appearances gcd-test ;
MAIN: main

53
Task/Stern-Brocot-sequence/Forth/stern-brocot-sequence.fth Normal file
View file

@ -0,0 +1,53 @@
: stern ( n -- x : return N'th item of Stern-Brocot sequence)
dup 2 >= if
2 /mod swap if
dup 1+ recurse
swap recurse
+
else
recurse
then
then
;
: first ( n -- x : return X such that stern X = n )
1 begin over over stern <> while 1+ repeat
swap drop
;
: gcd ( a b -- a gcd b )
begin swap over mod dup 0= until drop
;
: task
( Print first 15 numbers )
." First 15: " 1 begin dup stern . 1+ dup 15 > until
drop cr
( Print first occurrence of 1..10 )
1 begin
." First " dup . ." at " dup first .
1+ cr
dup 10 > until
drop
( Print first occurrence of 100 )
." First 100 at " 100 first . cr
( Check that the GCD of each adjacent pair up to 1000 is 1 )
-1 2 begin
dup stern over 1- stern gcd 1 =
rot and swap
1+
dup 1000 > until
swap if
." All GCDs are 1."
drop
else
." GCD <> 1 at: " .
then
cr
;
task
bye

31
Task/Stern-Brocot-sequence/Fortran/stern-brocot-sequence-1.f Normal file
View file

@ -0,0 +1,31 @@
* STERN-BROCOT SEQUENCE - FORTRAN IV
DIMENSION ISB(2400)
NN=2400
ISB(1)=1
ISB(2)=1
I=1
J=2
K=2
1 IF(K.GE.NN) GOTO 2
K=K+1
ISB(K)=ISB(K-I)+ISB(K-J)
K=K+1
ISB(K)=ISB(K-J)
I=I+1
J=J+1
GOTO 1
2 N=15
WRITE(*,101) N
101 FORMAT(1X,'FIRST',I4)
WRITE(*,102) (ISB(I),I=1,15)
102 FORMAT(15I4)
DO 5 J=1,11
JJ=J
IF(J.EQ.11) JJ=100
DO 3 I=1,K
IF(ISB(I).EQ.JJ) GOTO 4
3 CONTINUE
4 WRITE(*,103) JJ,I
103 FORMAT(1X,'FIRST',I4,' AT ',I4)
5 CONTINUE
END

22
Task/Stern-Brocot-sequence/Fortran/stern-brocot-sequence-2.f Normal file
View file

@ -0,0 +1,22 @@
! Stern-Brocot sequence - Fortran 90
parameter (nn=2400)
dimension isb(nn)
isb(1)=1; isb(2)=1
i=1; j=2; k=2
do while(k.lt.nn)
k=k+1; isb(k)=isb(k-i)+isb(k-j)
k=k+1; isb(k)=isb(k-j)
i=i+1; j=j+1
end do
n=15
write(*,"(1x,'First',i4)") n
write(*,"(15i4)") (isb(i),i=1,15)
do j=1,11
jj=j
if(j==11) jj=100
do i=1,k
if(isb(i)==jj) exit
end do
write(*,"(1x,'First',i4,' at ',i4)") jj,i
end do
end

82
Task/Stern-Brocot-sequence/FreeBASIC/stern-brocot-sequence.basic Normal file
View file

@ -0,0 +1,82 @@
' version 02-03-2019
' compile with: fbc -s console
#Define max 2000
Dim Shared As UInteger stern(max +2)
Sub stern_brocot
stern(1) = 1
stern(2) = 1
Dim As UInteger i = 2 , n = 2, ub = UBound(stern)
Do While i < ub
i += 1
stern(i) = stern(n) + stern(n -1)
i += 1
stern(i) = stern(n)
n += 1
Loop
End Sub
Function gcd(x As UInteger, y As UInteger) As UInteger
Dim As UInteger t
While y
t = y
y = x Mod y
x = t
Wend
Return x
End Function
' ------=< MAIN >=------
Dim As UInteger i
stern_brocot
Print "The first 15 are: " ;
For i = 1 To 15
Print stern(i); " ";
Next
Print : Print
Print " Index First nr."
Dim As UInteger d = 1
For i = 1 To max
If stern(i) = d Then
Print Using " ######"; i; stern(i)
d += 1
If d = 11 Then d = 100
If d = 101 Then Exit For
i = 0
End If
Next
Print : Print
d = 0
For i = 1 To 1000
If gcd(stern(i), stern(i +1)) <> 1 Then
d = gcd(stern(i), stern(i +1))
Exit For
End If
Next
If d = 0 Then
Print "GCD of two consecutive members of the series up to the 1000th member is 1"
Else
Print "The GCD for index "; i; " and "; i +1; " = "; d
End If
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

48
Task/Stern-Brocot-sequence/Go/stern-brocot-sequence-1.go Normal file
View file

@ -0,0 +1,48 @@
package main
import (
"fmt"
"sternbrocot"
)
func main() {
// Task 1, using the conventional sort of generator that generates
// terms endlessly.
g := sb.Generator()
// Task 2, demonstrating the generator.
fmt.Println("First 15:")
for i := 1; i <= 15; i++ {
fmt.Printf("%2d: %d\n", i, g())
}
// Task 2 again, showing a simpler technique that might or might not be
// considered to "generate" terms.
s := sb.New()
fmt.Println("First 15:", s.FirstN(15))
// Tasks 3 and 4.
for _, x := range []int{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 100} {
fmt.Printf("%3d at 1-based index %d\n", x, 1+s.Find(x))
}
// Task 5.
fmt.Println("1-based indexes: gcd")
for n, f := range s.FirstN(1000)[:999] {
g := gcd(f, (*s)[n+1])
fmt.Printf("%d,%d: gcd(%d, %d) = %d\n", n+1, n+2, f, (*s)[n+1], g)
if g != 1 {
panic("oh no!")
return
}
}
}
// gcd copied from greatest common divisor task
func gcd(x, y int) int {
for y != 0 {
x, y = y, x%y
}
return x
}

74
Task/Stern-Brocot-sequence/Go/stern-brocot-sequence-2.go Normal file
View file

@ -0,0 +1,74 @@
// SB implements the Stern-Brocot sequence.
//
// Generator() satisfies RC Task 1. For remaining tasks, Generator could be
// used but FirstN(), and Find() are simpler methods for specific stopping
// criteria. FirstN and Find might also be considered to satisfy Task 1,
// in which case Generator would not really be needed. Anyway, there it is.
package sb
// Seq represents an even number of terms of a Stern-Brocot sequence.
//
// Terms are stored in a slice. Terms start with 1.
// (Specifically, the zeroth term, 0, given in OEIS A002487 is not represented.)
// Term 1 (== 1) is stored at slice index 0.
//
// Methods on Seq rely on Seq always containing an even number of terms.
type Seq []int
// New returns a Seq with the two base terms.
func New() *Seq {
return &Seq{1, 1} // Step 1 of the RC task.
}
// TwoMore appends two more terms to p.
// It's the body of the loop in the RC algorithm.
// Generate(), FirstN(), and Find() wrap this body in different ways.
func (p *Seq) TwoMore() {
s := *p
n := len(s) / 2 // Steps 2 and 5 of the RC task.
c := s[n]
*p = append(s, c+s[n-1], c) // Steps 3 and 4 of the RC task.
}
// Generator returns a generator function that returns successive terms
// (until overflow.)
func Generator() func() int {
n := 0
p := New()
return func() int {
if len(*p) == n {
p.TwoMore()
}
t := (*p)[n]
n++
return t
}
}
// FirstN lazily extends p as needed so that it has at least n terms.
// FirstN then returns a list of the first n terms.
func (p *Seq) FirstN(n int) []int {
for len(*p) < n {
p.TwoMore()
}
return []int((*p)[:n])
}
// Find lazily extends p as needed until it contains the value x
// Find then returns the slice index of x in p.
func (p *Seq) Find(x int) int {
for n, f := range *p {
if f == x {
return n
}
}
for {
p.TwoMore()
switch x {
case (*p)[len(*p)-2]:
return len(*p) - 2
case (*p)[len(*p)-1]:
return len(*p) - 1
}
}
}

17
Task/Stern-Brocot-sequence/Haskell/stern-brocot-sequence-1.hs Normal file
View file

@ -0,0 +1,17 @@
import Data.List (elemIndex)
sb :: [Int]
sb = 1 : 1 : f (tail sb) sb
where
f (a : aa) (b : bb) = a + b : a : f aa bb
main :: IO ()
main = do
print $ take 15 sb
print
[ (i, 1 + (\(Just i) -> i) (elemIndex i sb))
| i <- [1 .. 10] <> [100]
]
print $
all (\(a, b) -> 1 == gcd a b) $
take 1000 $ zip sb (tail sb)

28
Task/Stern-Brocot-sequence/Haskell/stern-brocot-sequence-2.hs Normal file
View file

@ -0,0 +1,28 @@
import Data.Function (on)
import Data.List (nubBy, sortOn)
import Data.Ord (comparing)
------------------ STERN-BROCOT SEQUENCE -----------------
sternBrocot :: [Int]
sternBrocot = head <$> iterate go [1, 1]
where
go (a : b : xs) = (b : xs) <> [a + b, b]
--------------------------- TEST -------------------------
main :: IO ()
main = do
print $ take 15 sternBrocot
print $
take 10 $
nubBy (on (==) fst) $
sortOn fst $
takeWhile ((110 >=) . fst) $
zip sternBrocot [1 ..]
print $
take 1 $
dropWhile ((100 /=) . fst) $
zip sternBrocot [1 ..]
print $
(all ((1 ==) . uncurry gcd) . (zip <*> tail)) $
take 1000 sternBrocot

8
Task/Stern-Brocot-sequence/J/stern-brocot-sequence-1.j Normal file
View file

@ -0,0 +1,8 @@
sternbrocot=:1 :0
ind=. 0
seq=. 1 1
while. -. u seq do.
ind=. ind+1
seq=. seq, +/\. seq {~ _1 0 +ind
end.
)

2
Task/Stern-Brocot-sequence/J/stern-brocot-sequence-2.j Normal file
View file

@ -0,0 +1,2 @@
15{.(15<:#) sternbrocot
1 1 2 1 3 2 3 1 4 3 5 2 5 3 4

2
Task/Stern-Brocot-sequence/J/stern-brocot-sequence-3.j Normal file
View file

@ -0,0 +1,2 @@
1+(10 e. ]) sternbrocot i.1+i.10
1 3 5 9 11 33 19 21 35 39

2
Task/Stern-Brocot-sequence/J/stern-brocot-sequence-4.j Normal file
View file

@ -0,0 +1,2 @@
1+(100 e. ]) sternbrocot i. 100
1179

2
Task/Stern-Brocot-sequence/J/stern-brocot-sequence-5.j Normal file
View file

@ -0,0 +1,2 @@
~.2 +./\ (1000<:#) sternbrocot
1

34
Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-1.java Normal file
View file

@ -0,0 +1,34 @@
import java.math.BigInteger;
import java.util.LinkedList;
public class SternBrocot {
static LinkedList<Integer> sequence = new LinkedList<Integer>(){{
add(1); add(1);
}};
private static void genSeq(int n){
for(int conIdx = 1; sequence.size() < n; conIdx++){
int consider = sequence.get(conIdx);
int pre = sequence.get(conIdx - 1);
sequence.add(consider + pre);
sequence.add(consider);
}
}
public static void main(String[] args){
genSeq(1200);
System.out.println("The first 15 elements are: " + sequence.subList(0, 15));
for(int i = 1; i <= 10; i++){
System.out.println("First occurrence of " + i + " is at " + (sequence.indexOf(i) + 1));
}
System.out.println("First occurrence of 100 is at " + (sequence.indexOf(100) + 1));
boolean failure = false;
for(int i = 0; i < 999; i++){
failure |= !BigInteger.valueOf(sequence.get(i)).gcd(BigInteger.valueOf(sequence.get(i + 1))).equals(BigInteger.ONE);
}
System.out.println("All GCDs are" + (failure ? " not" : "") + " 1");
}
}

63
Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-2.java Normal file
View file

@ -0,0 +1,63 @@
import java.awt.*;
import javax.swing.*;
public class SternBrocot extends JPanel {
public SternBrocot() {
setPreferredSize(new Dimension(800, 500));
setFont(new Font("Arial", Font.PLAIN, 18));
setBackground(Color.white);
}
private void drawTree(int n1, int d1, int n2, int d2,
int x, int y, int gap, int lvl, Graphics2D g) {
if (lvl == 0)
return;
// mediant
int numer = n1 + n2;
int denom = d1 + d2;
if (lvl > 1) {
g.drawLine(x + 5, y + 4, x - gap + 5, y + 124);
g.drawLine(x + 5, y + 4, x + gap + 5, y + 124);
}
g.setColor(getBackground());
g.fillRect(x - 10, y - 15, 35, 40);
g.setColor(getForeground());
g.drawString(String.valueOf(numer), x, y);
g.drawString("_", x, y + 2);
g.drawString(String.valueOf(denom), x, y + 22);
drawTree(n1, d1, numer, denom, x - gap, y + 120, gap / 2, lvl - 1, g);
drawTree(numer, denom, n2, d2, x + gap, y + 120, gap / 2, lvl - 1, g);
}
@Override
public void paintComponent(Graphics gg) {
super.paintComponent(gg);
Graphics2D g = (Graphics2D) gg;
g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
RenderingHints.VALUE_ANTIALIAS_ON);
int w = getWidth();
drawTree(0, 1, 1, 0, w / 2, 50, w / 4, 4, g);
}
public static void main(String[] args) {
SwingUtilities.invokeLater(() -> {
JFrame f = new JFrame();
f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
f.setTitle("Stern-Brocot Tree");
f.setResizable(false);
f.add(new SternBrocot(), BorderLayout.CENTER);
f.pack();
f.setLocationRelativeTo(null);
f.setVisible(true);
});
}
}

325
Task/Stern-Brocot-sequence/JavaScript/stern-brocot-sequence.js Normal file
View file

@ -0,0 +1,325 @@
(() => {
'use strict';
const main = () => {
// sternBrocot :: Generator [Int]
const sternBrocot = () => {
const go = xs => {
const x = snd(xs);
return tail(append(xs, [fst(xs) + x, x]));
};
return fmapGen(head, iterate(go, [1, 1]));
};
// TESTS ------------------------------------------
const
sbs = take(1200, sternBrocot()),
ixSB = zip(sbs, enumFrom(1));
return unlines(map(
JSON.stringify,
[
take(15, sbs),
take(10,
map(listFromTuple,
nubBy(
on(eq, fst),
sortBy(
comparing(fst),
takeWhile(x => 12 !== fst(x), ixSB)
)
)
)
),
listFromTuple(
take(1, dropWhile(x => 100 !== fst(x), ixSB))[0]
),
all(tpl => 1 === gcd(fst(tpl), snd(tpl)),
take(1000, zip(sbs, tail(sbs)))
)
]
));
};
// GENERIC ABSTRACTIONS -------------------------------
// Just :: a -> Maybe a
const Just = x => ({
type: 'Maybe',
Nothing: false,
Just: x
});
// Nothing :: Maybe a
const Nothing = () => ({
type: 'Maybe',
Nothing: true,
});
// Tuple (,) :: a -> b -> (a, b)
const Tuple = (a, b) => ({
type: 'Tuple',
'0': a,
'1': b,
length: 2
});
// | Absolute value.
// abs :: Num -> Num
const abs = Math.abs;
// Determines whether all elements of the structure
// satisfy the predicate.
// all :: (a -> Bool) -> [a] -> Bool
const all = (p, xs) => xs.every(p);
// append (++) :: [a] -> [a] -> [a]
// append (++) :: String -> String -> String
const append = (xs, ys) => xs.concat(ys);
// chr :: Int -> Char
const chr = String.fromCodePoint;
// comparing :: (a -> b) -> (a -> a -> Ordering)
const comparing = f =>
(x, y) => {
const
a = f(x),
b = f(y);
return a < b ? -1 : (a > b ? 1 : 0);
};
// dropWhile :: (a -> Bool) -> [a] -> [a]
// dropWhile :: (Char -> Bool) -> String -> String
const dropWhile = (p, xs) => {
const lng = xs.length;
return 0 < lng ? xs.slice(
until(
i => i === lng || !p(xs[i]),
i => 1 + i,
0
)
) : [];
};
// enumFrom :: a -> [a]
function* enumFrom(x) {
let v = x;
while (true) {
yield v;
v = succ(v);
}
}
// eq (==) :: Eq a => a -> a -> Bool
const eq = (a, b) => {
const t = typeof a;
return t !== typeof b ? (
false
) : 'object' !== t ? (
'function' !== t ? (
a === b
) : a.toString() === b.toString()
) : (() => {
const aks = Object.keys(a);
return aks.length !== Object.keys(b).length ? (
false
) : aks.every(k => eq(a[k], b[k]));
})();
};
// fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
function* fmapGen(f, gen) {
const g = gen;
let v = take(1, g)[0];
while (0 < v.length) {
yield(f(v))
v = take(1, g)[0]
}
}
// fst :: (a, b) -> a
const fst = tpl => tpl[0];
// gcd :: Int -> Int -> Int
const gcd = (x, y) => {
const
_gcd = (a, b) => (0 === b ? a : _gcd(b, a % b)),
abs = Math.abs;
return _gcd(abs(x), abs(y));
};
// head :: [a] -> a
const head = xs => xs.length ? xs[0] : undefined;
// isChar :: a -> Bool
const isChar = x =>
('string' === typeof x) && (1 === x.length);
// iterate :: (a -> a) -> a -> Gen [a]
function* iterate(f, x) {
let v = x;
while (true) {
yield(v);
v = f(v);
}
}
// Returns Infinity over objects without finite length
// this enables zip and zipWith to choose the shorter
// argument when one is non-finite, like cycle, repeat etc
// length :: [a] -> Int
const length = xs => xs.length || Infinity;
// listFromTuple :: (a, a ...) -> [a]
const listFromTuple = tpl =>
Array.from(tpl);
// map :: (a -> b) -> [a] -> [b]
const map = (f, xs) => xs.map(f);
// nubBy :: (a -> a -> Bool) -> [a] -> [a]
const nubBy = (p, xs) => {
const go = xs => 0 < xs.length ? (() => {
const x = xs[0];
return [x].concat(
go(xs.slice(1)
.filter(y => !p(x, y))
)
)
})() : [];
return go(xs);
};
// e.g. sortBy(on(compare,length), xs)
// on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
const on = (f, g) => (a, b) => f(g(a), g(b));
// ord :: Char -> Int
const ord = c => c.codePointAt(0);
// snd :: (a, b) -> b
const snd = tpl => tpl[1];
// sortBy :: (a -> a -> Ordering) -> [a] -> [a]
const sortBy = (f, xs) =>
xs.slice()
.sort(f);
// succ :: Enum a => a -> a
const succ = x =>
isChar(x) ? (
chr(1 + ord(x))
) : isNaN(x) ? (
undefined
) : 1 + x;
// tail :: [a] -> [a]
const tail = xs => 0 < xs.length ? xs.slice(1) : [];
// take :: Int -> [a] -> [a]
// take :: Int -> String -> String
const take = (n, xs) =>
xs.constructor.constructor.name !== 'GeneratorFunction' ? (
xs.slice(0, n)
) : [].concat.apply([], Array.from({
length: n
}, () => {
const x = xs.next();
return x.done ? [] : [x.value];
}));
// takeWhile :: (a -> Bool) -> [a] -> [a]
// takeWhile :: (Char -> Bool) -> String -> String
const takeWhile = (p, xs) =>
xs.constructor.constructor.name !==
'GeneratorFunction' ? (() => {
const lng = xs.length;
return 0 < lng ? xs.slice(
0,
until(
i => lng === i || !p(xs[i]),
i => 1 + i,
0
)
) : [];
})() : takeWhileGen(p, xs);
// takeWhileGen :: (a -> Bool) -> Gen [a] -> [a]
const takeWhileGen = (p, xs) => {
const ys = [];
let
nxt = xs.next(),
v = nxt.value;
while (!nxt.done && p(v)) {
ys.push(v);
nxt = xs.next();
v = nxt.value
}
return ys;
};
// uncons :: [a] -> Maybe (a, [a])
const uncons = xs => {
const lng = length(xs);
return (0 < lng) ? (
lng < Infinity ? (
Just(Tuple(xs[0], xs.slice(1))) // Finite list
) : (() => {
const nxt = take(1, xs);
return 0 < nxt.length ? (
Just(Tuple(nxt[0], xs))
) : Nothing();
})() // Lazy generator
) : Nothing();
};
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// until :: (a -> Bool) -> (a -> a) -> a -> a
const until = (p, f, x) => {
let v = x;
while (!p(v)) v = f(v);
return v;
};
// Use of `take` and `length` here allows for zipping with non-finite
// lists - i.e. generators like cycle, repeat, iterate.
// zip :: [a] -> [b] -> [(a, b)]
const zip = (xs, ys) => {
const lng = Math.min(length(xs), length(ys));
return Infinity !== lng ? (() => {
const bs = take(lng, ys);
return take(lng, xs).map((x, i) => Tuple(x, bs[i]));
})() : zipGen(xs, ys);
};
// zipGen :: Gen [a] -> Gen [b] -> Gen [(a, b)]
const zipGen = (ga, gb) => {
function* go(ma, mb) {
let
a = ma,
b = mb;
while (!a.Nothing && !b.Nothing) {
let
ta = a.Just,
tb = b.Just
yield(Tuple(fst(ta), fst(tb)));
a = uncons(snd(ta));
b = uncons(snd(tb));
}
}
return go(uncons(ga), uncons(gb));
};
// MAIN ---
return main();
})();

12
Task/Stern-Brocot-sequence/Jq/stern-brocot-sequence-1.jq Normal file
View file

@ -0,0 +1,12 @@
def until(cond; update):
def _until:
if cond then . else (update | _until) end;
try _until catch if .== "break" then empty else . end ;
def gcd(a; b):
# subfunction expects [a,b] as input
# i.e. a ~ .[0] and b ~ .[1]
def rgcd: if .[1] == 0 then .[0]
else [.[1], .[0] % .[1]] | rgcd
end;
[a,b] | rgcd ;

18
Task/Stern-Brocot-sequence/Jq/stern-brocot-sequence-2.jq Normal file
View file

@ -0,0 +1,18 @@
# If n is non-negative, then A002487(n)
# generates an array with at least n elements of
# the A002487 sequence;
# if n is negative, elements are added until (-n)
# is found.
def A002487(n):
[0,1]
| until(
length as $l
| if n >= 0 then $l >= n
else .[$l-1] == -n
end;
length as $l
| ($l / 2) as $n
| .[$l] = .[$n]
| if (.[$l-2] == -n) then .
else .[$l + 1] = .[$n] + .[$n+1]
end ) ;

31
Task/Stern-Brocot-sequence/Jq/stern-brocot-sequence-3.jq Normal file
View file

@ -0,0 +1,31 @@
# Generate a stream of n integers beginning with 1,1...
def stern_brocot(n): A002487(n+1) | .[1:n+1][];
# Return the index (counting from 1) of n in the
# sequence starting with 1,1,...
def stern_brocot_index(n):
A002487(-n) | length -1 ;
def index_task:
(range(1;11), 100) as $i
| "index of \($i) is \(stern_brocot_index($i))" ;
def gcd_task:
A002487(1000)
| . as $A
| reduce range(0; length-1) as $i
( [];
gcd( $A[$i]; $A[$i+1] ) as $gcd
| if $gcd == 1 then . else . + [$gcd] end)
| if length == 0 then "GCDs are all 1"
else "GCDs include \(.)" end ;
"First 15 integers of the Stern-Brocot sequence",
"as defined in the task description are:",
stern_brocot(15),
"",
"Using an index origin of 1:",
index_task,
"",
gcd_task

33
Task/Stern-Brocot-sequence/Jq/stern-brocot-sequence-4.jq Normal file
View file

@ -0,0 +1,33 @@
$ jq -r -n -f stern_brocot.jq
First 15 integers of the Stern-Brocot sequence
as defined in the task description are:
1
1
2
1
3
2
3
1
4
3
5
2
5
3
4
Using an index origin of 1:
index of 1 is 1
index of 2 is 3
index of 3 is 5
index of 4 is 9
index of 5 is 11
index of 6 is 33
index of 7 is 19
index of 8 is 21
index of 9 is 35
index of 10 is 39
index of 100 is 1179
GCDs are all 1

26
Task/Stern-Brocot-sequence/Julia/stern-brocot-sequence.julia Normal file
View file

@ -0,0 +1,26 @@
using Printf
function sternbrocot(f::Function=(x) -> length(x) ≥ 20)::Vector{Int}
rst = Int[1, 1]
i = 2
while !f(rst)
append!(rst, Int[rst[i] + rst[i-1], rst[i]])
i += 1
end
return rst
end
println("First 15 elements of Stern-Brocot series:\n", sternbrocot(x -> length(x) ≥ 15)[1:15], "\n")
for i in (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 100)
occurr = findfirst(x -> x == i, sternbrocot(x -> i ∈ x))
@printf("Index of first occurrence of %3i in the series: %4i\n", i, occurr)
end
print("\nAssertion: the greatest common divisor of all the two\nconsecutive members of the series up to the 1000th member, is always one: ")
sb = sternbrocot(x -> length(x) > 1000)
if all(gcd(prev, this) == 1 for (prev, this) in zip(sb[1:1000], sb[2:1000]))
println("Confirmed.")
else
println("Rejected.")
end

64
Task/Stern-Brocot-sequence/Kotlin/stern-brocot-sequence.kotlin Normal file
View file

@ -0,0 +1,64 @@
// version 1.1.0
val sbs = mutableListOf(1, 1)
fun sternBrocot(n: Int, fromStart: Boolean = true) {
if (n < 4 || (n % 2 != 0)) throw IllegalArgumentException("n must be >= 4 and even")
var consider = if (fromStart) 1 else n / 2 - 1
while (true) {
val sum = sbs[consider] + sbs[consider - 1]
sbs.add(sum)
sbs.add(sbs[consider])
if (sbs.size == n) break
consider++
}
}
fun gcd(a: Int, b: Int): Int = if (b == 0) a else gcd(b, a % b)
fun main(args: Array<String>) {
var n = 16 // needs to be even to ensure 'considered' number is added
println("First 15 members of the Stern-Brocot sequence")
sternBrocot(n)
println(sbs.take(15))
val firstFind = IntArray(11) // all zero by default
firstFind[0] = -1 // needs to be non-zero for subsequent test
for ((i, v) in sbs.withIndex())
if (v <= 10 && firstFind[v] == 0) firstFind[v] = i + 1
loop@ while (true) {
n += 2
sternBrocot(n, false)
val vv = sbs.takeLast(2)
var m = n - 1
for (v in vv) {
if (v <= 10 && firstFind[v] == 0) firstFind[v] = m
if (firstFind.all { it != 0 }) break@loop
m++
}
}
println("\nThe numbers 1 to 10 first appear at the following indices:")
for (i in 1..10) println("${"%2d".format(i)} -> ${firstFind[i]}")
print("\n100 first appears at index ")
while (true) {
n += 2
sternBrocot(n, false)
val vv = sbs.takeLast(2)
if (vv[0] == 100) {
println(n - 1); break
}
if (vv[1] == 100) {
println(n); break
}
}
print("\nThe GCDs of each pair of the series up to the 1000th member are ")
for (p in 0..998 step 2) {
if (gcd(sbs[p], sbs[p + 1]) != 1) {
println("not all one")
return
}
}
println("all one")
}

49
Task/Stern-Brocot-sequence/Lua/stern-brocot-sequence.lua Normal file
View file

@ -0,0 +1,49 @@
-- Task 1
function sternBrocot (n)
local sbList, pos, c = {1, 1}, 2
repeat
c = sbList[pos]
table.insert(sbList, c + sbList[pos - 1])
table.insert(sbList, c)
pos = pos + 1
until #sbList >= n
return sbList
end
-- Return index in table 't' of first value matching 'v'
function findFirst (t, v)
for key, value in pairs(t) do
if v then
if value == v then return key end
else
if value ~= 0 then return key end
end
end
return nil
end
-- Return greatest common divisor of 'x' and 'y'
function gcd (x, y)
if y == 0 then
return math.abs(x)
else
return gcd(y, x % y)
end
end
-- Check GCD of adjacent values in 't' up to 1000 is always 1
function task5 (t)
for pos = 1, 1000 do
if gcd(t[pos], t[pos + 1]) ~= 1 then return "FAIL" end
end
return "PASS"
end
-- Main procedure
local sb = sternBrocot(10000)
io.write("Task 2: ")
for n = 1, 15 do io.write(sb[n] .. " ") end
print("\n\nTask 3:")
for i = 1, 10 do print("\t" .. i, findFirst(sb, i)) end
print("\nTask 4: " .. findFirst(sb, 100))
print("\nTask 5: " .. task5(sb))

130
Task/Stern-Brocot-sequence/MACRO-11/stern-brocot-sequence.macro11 Normal file
View file

@ -0,0 +1,130 @@
.TITLE STNBRC
.MCALL .TTYOUT,.EXIT
AMOUNT = ^D1200
STNBRC::JSR PC,GENSEQ
; PRINT FIRST 15
MOV #FST15,R1
JSR PC,PRSTR
MOV #STERN+2,R3
MOV #^D15,R4
1$: MOV (R3)+,R0
JSR PC,PR0
SOB R4,1$
MOV #NEWLINE,R1
JSR PC,PRSTR
; PRINT FIRST OCCURRENCE OF 1..10 AND 100
MOV #FSTOCC,R1
JSR PC,PRSTR
MOV #1,R3
2$: JSR PC,PRFST
INC R3
CMP R3,#^D10
BLE 2$
MOV #^D100,R3
JSR PC,PRFST
MOV #NEWLIN,R1
JSR PC,PRSTR
; CHECK GCDS OF ADJACENT PAIRS UP TO 1000
MOV #CHKGCD,R1
JSR PC,PRSTR
MOV #STERN+2,R2
MOV #^D999,R5
MOV (R2)+,R3
3$: MOV R3,R4
MOV (R2)+,R3
MOV R3,R0
MOV R4,R1
JSR PC,GCD
DEC R0
BNE 4$
SOB R5,3$
MOV #ALL1,R1
BR 5$
4$: MOV #NOTAL1,R1
5$: JSR PC,PRSTR
.EXIT
FST15: .ASCIZ /FIRST 15: /
FSTOCC: .ASCIZ /FIRST OCCURRENCES:/<15><12>
ATWD: .ASCIZ /AT /
CHKGCD: .ASCIZ /CHECKING GCDS OF ADJACENT PAIRS... /
NOTAL1: .ASCII /NOT /
ALL1: .ASCIZ /ALL 1./
NEWLIN: .BYTE 15,12,0
.EVEN
; GENERATE STERN-BROCOT SEQUENCE
GENSEQ: MOV #1,R0
MOV R0,STERN+2
MOV R0,STERN+4
MOV #STERN+<2*AMOUNT>,R5
MOV #STERN+2,R0
MOV #STERN+6,R1
MOV (R0)+,R2
1$: MOV R2,R3
MOV (R0)+,R2
MOV R2,R4
ADD R3,R4
MOV R4,(R1)+
MOV R2,(R1)+
CMP R1,R5
BLT 1$
RTS PC
; LET R0 = FIRST OCCURRENCE OF R3 IN SEQUENCE
FNDFST: MOV #STERN,R0
1$: CMP (R0)+,R3
BNE 1$
SUB #STERN+2,R0
ASR R0
RTS PC
; PRINT FIRST OCC. OF <R3>
PRFST: MOV R3,R0
JSR PC,PR0
MOV #ATWD,R1
JSR PC,PRSTR
JSR PC,FNDFST
JSR PC,PR0
MOV #NEWLIN,R1
JMP PRSTR
; LET R0 = GCD(R0,R1)
GCD: CMP R0,R1
BLT 1$
BGT 2$
RTS PC
1$: SUB R0,R1
BR GCD
2$: SUB R1,R0
BR GCD
; PRINT NUMBER IN R0 AS DECIMAL
PR0: MOV #4$,R1
1$: MOV #-1,R2
2$: INC R2
SUB #12,R0
BCC 2$
ADD #72,R0
MOVB R0,-(R1)
MOV R2,R0
BNE 1$
3$: MOVB (R1)+,R0
.TTYOUT
BNE 3$
RTS PC
.ASCII /...../
4$: .ASCIZ / /
.EVEN
; PRINT STRING IN R1
PRSTR: MOVB (R1)+,R0
.TTYOUT
BNE PRSTR
RTS PC
; STERN-BROCOT BUFFER
STERN: .BLKW AMOUNT+1
.END STNBRC

31
Task/Stern-Brocot-sequence/MAD/stern-brocot-sequence.mad Normal file
View file

@ -0,0 +1,31 @@
NORMAL MODE IS INTEGER
VECTOR VALUES FRST15 = $20HFIRST 15 NUMBERS ARE*$
VECTOR VALUES FRSTAT = $6HFIRST ,I3,S1,11HAPPEARS AT ,I4*$
VECTOR VALUES NUMBER = $I4*$
DIMENSION STERN(1200)
STERN(1) = 1
STERN(2) = 1
R GENERATE FIRST 1200 MEMBERS OF THE STERN-BROCOT SEQUENCE
THROUGH GENSEQ, FOR I = 1, 1, I .GE. 600
STERN(I*2-1) = STERN(I) + STERN(I-1)
GENSEQ STERN(I*2) = STERN(I)
R PRINT FIRST 15 VALUES OF STERN-BROCOT SEQUENCE
PRINT FORMAT FRST15
THROUGH P15, FOR I = 1, 1, I .G. 15
P15 PRINT ON LINE FORMAT NUMBER, STERN(I)
R PRINT FIRST OCCURRENCE OF 1..10
THROUGH FRST10, FOR I = 1, 1, I .G. 10
FRST10 PRINT FORMAT FRSTAT, I, FIRST.(I)
PRINT FORMAT FRSTAT, 100, FIRST.(100)
R SEARCH FOR FIRST OCCURRENCE OF N IN SEQUENCE
INTERNAL FUNCTION(N)
ENTRY TO FIRST.
THROUGH SCAN, FOR K = 1, 1, I .G. 1200
SCAN WHENEVER N .E. STERN(K), FUNCTION RETURN K
END OF FUNCTION
END OF PROGRAM

10
Task/Stern-Brocot-sequence/Mathematica/stern-brocot-sequence.math Normal file
View file

@ -0,0 +1,10 @@
sb = {1, 1};
Do[
sb = sb~Join~{Total@sb[[i - 1 ;; i]], sb[[i]]}
,
{i, 2, 1000}
]
Take[sb, 15]
Flatten[FirstPosition[sb, #] & /@ Range[10]]
First@FirstPosition[sb, 100]
AllTrue[Partition[Take[sb, 1000], 2, 1], Apply[GCD] /* EqualTo[1]]

35
Task/Stern-Brocot-sequence/Miranda/stern-brocot-sequence.miranda Normal file
View file

@ -0,0 +1,35 @@
main :: [sys_message]
main = [Stdout (lay
["First 15: " ++ show first15,
"Indices of first 1..10: " ++ show idx10,
"Index of first 100: " ++ show idx100,
"The GCDs of the first 1000 pairs are all 1: " ++ show allgcd])]
first15 :: [num]
first15 = take 15 stern
idx10 :: [num]
idx10 = [find num stern | num<-[1..10]]
idx100 :: num
idx100 = find 100 stern
allgcd :: bool
allgcd = and [gcd a b = 1 | (a, b) <- take 1000 (zip2 stern (tl stern))]
|| Stern-Brocot sequence
stern :: [num]
stern = 1 : 1 : concat (map consider (zip2 stern (tl stern)))
where consider (prev,item) = [prev + item, item]
|| Supporting functions
gcd :: num->num->num
gcd a 0 = a
gcd a b = gcd b (a mod b)
find :: *->[*]->num
find item = find' 1
where find' idx [] = 0
find' idx (a:as) = idx, if a = item
= find' (idx + 1) as, otherwise

75
Task/Stern-Brocot-sequence/Modula-2/stern-brocot-sequence.mod2 Normal file
View file

@ -0,0 +1,75 @@
MODULE SternBrocot;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
CONST Amount = 1200;
VAR stern: ARRAY [1..Amount] OF CARDINAL;
i: CARDINAL;
PROCEDURE GCD(a,b: CARDINAL): CARDINAL;
VAR c: CARDINAL;
BEGIN
WHILE b # 0 DO
c := a MOD b;
a := b;
b := c;
END;
RETURN a;
END GCD;
PROCEDURE Generate;
VAR i: CARDINAL;
BEGIN
stern[1] := 1;
stern[2] := 1;
FOR i := 2 TO Amount DIV 2 DO
stern[i*2 - 1] := stern[i] + stern[i-1];
stern[i*2] := stern[i];
END;
END Generate;
PROCEDURE FindFirst(n: CARDINAL): CARDINAL;
VAR i: CARDINAL;
BEGIN
FOR i := 1 TO Amount DO
IF stern[i] = n THEN
RETURN i;
END;
END;
END FindFirst;
PROCEDURE ShowFirst(n: CARDINAL);
BEGIN
WriteString("First");
WriteCard(n,4);
WriteString(" at ");
WriteCard(FindFirst(n), 4);
WriteLn;
END ShowFirst;
BEGIN
Generate;
WriteString("First 15 numbers:");
FOR i := 1 TO 15 DO
WriteCard(stern[i], 2);
END;
WriteLn;
FOR i := 1 TO 10 DO
ShowFirst(i);
END;
ShowFirst(100);
WriteLn;
FOR i := 2 TO Amount DO
IF GCD(stern[i-1], stern[i]) # 1 THEN
WriteString("GCD of adjacent elements not 1 at: ");
WriteCard(i-1, 4);
WriteLn;
HALT;
END;
END;
WriteString("The GCD of every pair of adjacent elements is 1.");
WriteLn;
END SternBrocot.

57
Task/Stern-Brocot-sequence/Nim/stern-brocot-sequence.nim Normal file
View file

@ -0,0 +1,57 @@
import math, strformat, strutils
iterator sternBrocot(): (int, int) =
## Yield index and value of the terms of the sequence.
var sequence: seq[int]
sequence.add 1
sequence.add 1
var index = 1
yield (1, 1)
yield (2, 1)
while true:
sequence.add sequence[index] + sequence[index - 1]
yield (sequence.len, sequence[^1])
sequence.add sequence[index]
yield (sequence.len, sequence[^1])
inc index
# Fiind first 15 terms.
var res: seq[int]
for i, n in sternBrocot():
res.add n
if i == 15: break
echo "First 15 terms: ", res.join(" ")
echo()
# Find indexes for 1..10.
var indexes: array[1..10, int]
var toFind = 10
for i, n in sternBrocot():
if n in 1..10 and indexes[n] == 0:
indexes[n] = i
dec toFind
if toFind == 0: break
for n in 1..10:
echo &"Index of first occurrence of number {n:3}: {indexes[n]:4}"
# Find index for 100.
var index: int
for i, n in sternBrocot():
if n == 100:
index = i
break
echo &"Index of first occurrence of number 100: {index:4}"
echo()
# Check GCD.
var prev = 1
index = 1
for i, n in sternBrocot():
if gcd(prev, n) != 1: break
prev = n
inc index
if index > 1000: break
if index <= 1000:
echo "Found two successive terms at index: ", index
else:
echo "All consecutive terms up to the 1000th member have a GCD equal to one."

8
Task/Stern-Brocot-sequence/OCaml/stern-brocot-sequence-1.ocaml Normal file
View file

@ -0,0 +1,8 @@
let seq_stern_brocot =
let rec next x xs () =
match xs () with
| Seq.Nil -> assert false
| Cons (x', xs') -> Seq.Cons (x' + x, Seq.cons x' (next x' xs'))
in
let rec tail () = Seq.Cons (1, next 1 tail) in
Seq.cons 1 tail

27
Task/Stern-Brocot-sequence/OCaml/stern-brocot-sequence-2.ocaml Normal file
View file

@ -0,0 +1,27 @@
let rec gcd a = function
| 0 -> a
| b -> gcd b (a mod b)
let seq_index_of el =
let rec next i sq =
match sq () with
| Seq.Nil -> 0
| Cons (e, sq') -> if e = el then i else next (succ i) sq'
in
next 1
let seq_map_pairwise f sq =
match sq () with
| Seq.Nil -> Seq.empty
| Cons (_, sq') -> Seq.map2 f sq sq'
let () =
seq_stern_brocot |> Seq.take 15 |> Seq.iter (Printf.printf " %u") |> print_newline
and () =
List.iter
(fun n -> seq_stern_brocot |> seq_index_of n |> Printf.printf " %u@%u" n)
[1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 100]
|> print_newline
and () =
seq_stern_brocot |> Seq.take 1000 |> seq_map_pairwise gcd |> Seq.for_all ((=) 1)
|> Printf.printf " %B\n"

7
Task/Stern-Brocot-sequence/Oforth/stern-brocot-sequence.fth Normal file
View file

@ -0,0 +1,7 @@
: stern(n)
| l i |
ListBuffer new dup add(1) dup add(1) dup ->l
n 1- 2 / loop: i [ l at(i) l at(i 1+) tuck + l add l add ]
n 2 mod ifFalse: [ dup removeLast drop ] dup freeze ;
stern(10000) Constant new: Sterns

27
Task/Stern-Brocot-sequence/PARI-GP/stern-brocot-sequence.parigp Normal file
View file

@ -0,0 +1,27 @@
\\ Stern-Brocot sequence
\\ 5/27/16 aev
SternBrocot(n)={
my(L=List([1,1]),k=2); if(n<3,return(L));
for(i=2,n, listput(L,L[i]+L[i-1]); if(k++>=n, break); listput(L,L[i]);if(k++>=n, break));
return(Vec(L));
}
\\ Find the first item in any list starting with sind index (return 0 or index).
\\ 9/11/2015 aev
findinlist(list, item, sind=1)={
my(idx=0, ln=#list); if(ln==0 || sind<1 || sind>ln, return(0));
for(i=sind, ln, if(list[i]==item, idx=i; break;)); return(idx);
}
{
\\ Required tests:
my(v,j);
v=SternBrocot(15);
print1("The first 15: "); print(v);
v=SternBrocot(1200);
print1("The first i@n: "); \\print(v);
for(i=1,10, if(j=findinlist(v,i), print1(i,"@",j,", ")));
if(j=findinlist(v,100), print(100,"@",j));
v=SternBrocot(10000);
print1("All GCDs=1?: ");
j=1; for(i=2,10000, j*=gcd(v[i-1],v[i]));
if(j==1, print("Yes"), print("No"));
}

48
Task/Stern-Brocot-sequence/PL-I/stern-brocot-sequence.pli Normal file
View file

@ -0,0 +1,48 @@
sternBrocot: procedure options(main);
%replace MAX by 1200;
declare S(1:MAX) fixed;
/* find the first occurrence of N in S */
findFirst: procedure(n) returns(fixed);
declare (n, i) fixed;
do i=1 to MAX;
if S(i)=n then return(i);
end;
end findFirst;
/* find the greatest common divisor of A and B */
gcd: procedure(a, b) returns(fixed) recursive;
declare (a, b) fixed;
if b = 0 then return(a);
return(gcd(b, mod(a, b)));
end gcd;
/* calculate S(i) up to MAX */
declare i fixed;
S(1) = 1; S(2) = 1;
do i=2 to MAX/2;
S(i*2-1) = S(i) + S(i-1);
S(i*2) = S(i);
end;
/* print first 15 elements */
put skip list('First 15 elements: ');
do i=1 to 15;
put edit(S(i)) (F(2));
end;
/* find first occurrences of 1..10 and 100 */
do i=1 to 10;
put skip list('First',i,'at',findFirst(i));
end;
put skip list('First ',100,'at',findFirst(100));
/* check GCDs of adjacent pairs up to 1000th element */
do i=2 to 1000;
if gcd(S(i-1),S(i)) ^= 1 then do;
put skip list('GCD of adjacent pair not 1 at i=',i);
stop;
end;
end;
put skip list('All GCDs of adjacent pairs are 1.');
end sternBrocot;

88
Task/Stern-Brocot-sequence/PL-M/stern-brocot-sequence.plm Normal file
View file

@ -0,0 +1,88 @@
100H:
/* FIND LOCATION OF FIRST ELEMENT IN ARRAY */
FIND$FIRST: PROCEDURE (ARR, EL) ADDRESS;
DECLARE (ARR, N) ADDRESS, (EL, A BASED ARR) BYTE;
N = 0;
LOOP:
IF A(N) = EL THEN RETURN N;
ELSE N = N + 1;
GO TO LOOP;
END FIND$FIRST;
/* CP/M CALL */
BDOS: PROCEDURE (FN, ARG);
DECLARE FN BYTE, ARG ADDRESS;
GO TO 5;
END BDOS;
PRINT: PROCEDURE (STRING);
DECLARE STRING ADDRESS;
CALL BDOS(9, STRING);
END PRINT;
/* PRINT NUMBER */
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (6) BYTE INITIAL ('.....$');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
IF (N := N / 10) > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
/* GENERATE FIRST 1200 ELEMENTS OF STERN-BROCOT SEQUENCE */
DECLARE S (1201) BYTE, I ADDRESS;
S(1) = 1;
S(2) = 1;
DO I = 2 TO 600;
S(I*2-1) = S(I) + S(I-1);
S(I*2) = S(I);
END;
/* PRINT FIRST 15 ELEMENTS */
CALL PRINT(.'FIRST 15 ELEMENTS: $');
DO I = 1 TO 15;
CALL PRINT$NUMBER(S(I));
CALL PRINT(.' $');
END;
CALL PRINT(.(13,10,'$'));
/* PRINT FIRST OCCURRENCE OF N */
PRINT$FIRST: PROCEDURE (N);
DECLARE N BYTE;
CALL PRINT(.'FIRST $');
CALL PRINT$NUMBER(N);
CALL PRINT(.' AT $');
CALL PRINT$NUMBER(FIND$FIRST(.S, N));
CALL PRINT(.(13,10,'$'));
END PRINT$FIRST;
DO I = 1 TO 10;
CALL PRINT$FIRST(I);
END;
CALL PRINT$FIRST(100);
/* CHECK GCDS */
GCD: PROCEDURE (A, B) BYTE;
DECLARE (A, B, C) BYTE;
LOOP:
C = A;
A = B;
B = C MOD A;
IF B <> 0 THEN GO TO LOOP;
RETURN A;
END GCD;
DO I = 2 TO 1000;
IF GCD(S(I-1),S(I)) <> 1 THEN DO;
CALL PRINT(.'GCD NOT 1 AT: $');
CALL PRINT$NUMBER(I);
CALL BDOS(0,0);
END;
END;
CALL PRINT(.'ALL GCDS ARE 1$');
CALL BDOS(0,0);
EOF

87
Task/Stern-Brocot-sequence/Pascal/stern-brocot-sequence.pas Normal file
View file

@ -0,0 +1,87 @@
program StrnBrCt;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
const
MaxCnt = 10835282;{ seq[i] < 65536 = high(Word) }
//MaxCnt = 500*1000*1000;{ 2Gbyte -> real 0.85 s user 0.31 }
type
tSeqdata = word;//cardinal LongWord
pSeqdata = pWord;//pcardinal pLongWord
tseq = array of tSeqdata;
function SternBrocotCreate(size:NativeInt):tseq;
var
pSeq,pIns : pSeqdata;
PosIns : NativeInt;
sum : tSeqdata;
Begin
setlength(result,Size+1);
dec(Size); //== High(result)
pIns := @result[size];// set at end
PosIns := -size+2; // negative index campare to 0
pSeq := @result[0];
sum := 1;
pSeq[0]:= sum;pSeq[1]:= sum;
repeat
pIns[PosIns+1] := sum;//append copy of considered
inc(sum,pSeq[0]);
pIns[PosIns ] := sum;
inc(pSeq);
inc(PosIns,2);sum := pSeq[1];//aka considered
until PosIns>= 0;
setlength(result,length(result)-1);
end;
function FindIndex(const s:tSeq;value:tSeqdata):NativeInt;
Begin
result := 0;
while result <= High(s) do
Begin
if s[result] = value then
EXIT(result+1);
inc(result);
end;
end;
function gcd_iterative(u, v: NativeInt): NativeInt;
//http://rosettacode.org/wiki/Greatest_common_divisor#Pascal_.2F_Delphi_.2F_Free_Pascal
var
t: NativeInt;
begin
while v <> 0 do begin
t := u;u := v;v := t mod v;
end;
gcd_iterative := abs(u);
end;
var
seq : tSeq;
i : nativeInt;
Begin
seq:= SternBrocotCreate(MaxCnt);
// Show the first fifteen members of the sequence.
For i := 0 to 13 do write(seq[i],',');writeln(seq[14]);
//Show the (1-based) index of where the numbers 1-to-10 first appears in the
For i := 1 to 10 do
write(i,' @ ',FindIndex(seq,i),',');
writeln(#8#32);
//Show the (1-based) index of where the number 100 first appears in the sequence.
writeln(100,' @ ',FindIndex(seq,100));
//Check that the greatest common divisor of all the two consecutive members of the series up to the 1000th member, is always one.
i := 999;
if i > High(seq) then
i := High(seq);
Repeat
IF gcd_iterative(seq[i],seq[i+1]) <>1 then
Begin
writeln(' failure at ',i+1,' ',seq[i],' ',seq[i+1]);
BREAK;
end;
dec(i);
until i <0;
IF i< 0 then
writeln('GCD-test is O.K.');
setlength(seq,0);
end.

36
Task/Stern-Brocot-sequence/Perl/stern-brocot-sequence-1.pl Normal file
View file

@ -0,0 +1,36 @@
use strict;
use warnings;
sub stern_brocot {
my @list = (1, 1);
sub {
push @list, $list[0] + $list[1], $list[1];
shift @list;
}
}
{
my $generator = stern_brocot;
print join ' ', map &$generator, 1 .. 15;
print "\n";
}
for (1 .. 10, 100) {
my $index = 1;
my $generator = stern_brocot;
$index++ until $generator->() == $_;
print "first occurrence of $_ is at index $index\n";
}
{
sub gcd {
my ($u, $v) = @_;
$v ? gcd($v, $u % $v) : abs($u);
}
my $generator = stern_brocot;
my ($a, $b) = ($generator->(), $generator->());
for (1 .. 1000) {
die "unexpected GCD for $a and $b" unless gcd($a, $b) == 1;
($a, $b) = ($b, $generator->());
}
}

19
Task/Stern-Brocot-sequence/Perl/stern-brocot-sequence-2.pl Normal file
View file

@ -0,0 +1,19 @@
use ntheory qw/gcd vecsum vecfirst/;
sub stern_diatomic {
my ($p,$q,$i) = (0,1,shift);
while ($i) {
if ($i & 1) { $p += $q; } else { $q += $p; }
$i >>= 1;
}
$p;
}
my @s = map { stern_diatomic($_) } 1..15;
print "First fifteen: [@s]\n";
@s = map { my $n=$_; vecfirst { stern_diatomic($_) == $n } 1..10000 } 1..10;
print "Index of 1-10 first occurrence: [@s]\n";
print "Index of 100 first occurrence: ", (vecfirst { stern_diatomic($_) == 100 } 1..10000), "\n";
print "The first 999 consecutive pairs are ",
(vecsum( map { gcd(stern_diatomic($_),stern_diatomic($_+1)) } 1..999 ) == 999)
? "all coprime.\n" : "NOT all coprime!\n";

43
Task/Stern-Brocot-sequence/Phix/stern-brocot-sequence.phix Normal file
View file

@ -0,0 +1,43 @@
(phixonline)-->
<span style="color: #004080;">sequence</span> <span style="color: #000000;">sb</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">c</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">2</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">stern_brocot</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sb</span><span style="color: #0000FF;">)<</span><span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">sb</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">sb</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">]+</span><span style="color: #000000;">sb</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">sb</span><span style="color: #0000FF;">[</span><span style="color: #000000;">c</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">c</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">sb</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">stern_brocot</span><span style="color: #0000FF;">(</span><span style="color: #000000;">15</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"first 15:"</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">s</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">k</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">2</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">stern_brocot</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">idx</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">k</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"indexes of 1..10:"</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">idx</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"index of 100:"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">2</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">stern_brocot</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">k</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">stern_brocot</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1000</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">maxgcd</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">999</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">maxgcd</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">max</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gcd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]),</span><span style="color: #000000;">maxgcd</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"max gcd:%d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">maxgcd</span><span style="color: #0000FF;">})</span>
<!--

17
Task/Stern-Brocot-sequence/PicoLisp/stern-brocot-sequence.l Normal file
View file

@ -0,0 +1,17 @@
(de nmbr (N)
(let (A 1 B 0)
(while (gt0 N)
(if (bit? 1 N)
(inc 'B A)
(inc 'A B) )
(setq N (>> 1 N)) )
B ) )
(let Lst (mapcar nmbr (range 1 2000))
(println 'First-15: (head 15 Lst))
(for N 10
(println 'First N 'found 'at: (index N Lst)) )
(println 'First 100 'found 'at: (index 100 Lst))
(for (L Lst (cdr L) (cddr L))
(test 1 (gcd (car L) (cadr L))) )
(prinl "All consecutive pairs are relative prime!") )

28
Task/Stern-Brocot-sequence/PowerShell/stern-brocot-sequence.psh Normal file
View file

@ -0,0 +1,28 @@
# An iterative approach
function iter_sb($count = 2000)
{
# Taken from RosettaCode GCD challenge
function Get-GCD ($x, $y)
{
if ($y -eq 0) { $x } else { Get-GCD $y ($x%$y) }
}
$answer = @(1,1)
$index = 1
while ($answer.Length -le $count)
{
$answer += $answer[$index] + $answer[$index - 1]
$answer += $answer[$index]
$index++
}
0..14 | foreach {$answer[$_]}
1..10 | foreach {'Index of {0}: {1}' -f $_, ($answer.IndexOf($_) + 1)}
'Index of 100: {0}' -f ($answer.IndexOf(100) + 1)
[bool] $gcd = $true
1..999 | foreach {$gcd = $gcd -and ((Get-GCD $answer[$_] $answer[$_ - 1]) -eq 1)}
'GCD = 1 for first 1000 members: {0}' -f $gcd
}

51
Task/Stern-Brocot-sequence/PureBasic/stern-brocot-sequence.basic Normal file
View file

@ -0,0 +1,51 @@
EnableExplicit
Define.i i
If OpenConsole("")
PrintN("Stern-Brocot_sequence")
Else
End 1
EndIf
Procedure.i f(n.i)
If n<2
ProcedureReturn n
ElseIf n&1
ProcedureReturn f(n/2)+f(n/2+1)
Else
ProcedureReturn f(n/2)
EndIf
EndProcedure
Procedure.i gcd(a.i,b.i)
If b : ProcedureReturn gcd(b,a%b) : EndIf
ProcedureReturn a
EndProcedure
Procedure.i ind(m.i)
Define.i i=1
While f(i)<>m : i+1 : Wend
ProcedureReturn i
EndProcedure
Print("First 15 elements: ")
For i=1 To 15
Print(Str(f(i))+Space(3))
Next
PrintN(~"\n")
For i=1 To 10
PrintN(RSet(Str(i),3)+" is at pos. #"+Str(ind(i)))
Next
PrintN("100 is at pos. #"+Str(ind(100)))
PrintN("")
i=1
While i<1000 And gcd(f(i),f(i+1))=1 : i+1 : Wend
If i=1000
PrintN("All GCDs are 1.")
Else
PrintN("GCD of "+Str(i)+" and "+Str(i+1)+" is not 1")
EndIf
Input()

36
Task/Stern-Brocot-sequence/Python/stern-brocot-sequence-1.py Normal file
View file

@ -0,0 +1,36 @@
def stern_brocot(predicate=lambda series: len(series) < 20):
"""\
Generates members of the stern-brocot series, in order, returning them when the predicate becomes false
>>> print('The first 10 values:',
stern_brocot(lambda series: len(series) < 10)[:10])
The first 10 values: [1, 1, 2, 1, 3, 2, 3, 1, 4, 3]
>>>
"""
sb, i = [1, 1], 0
while predicate(sb):
sb += [sum(sb[i:i + 2]), sb[i + 1]]
i += 1
return sb
if __name__ == '__main__':
from fractions import gcd
n_first = 15
print('The first %i values:\n ' % n_first,
stern_brocot(lambda series: len(series) < n_first)[:n_first])
print()
n_max = 10
for n_occur in list(range(1, n_max + 1)) + [100]:
print('1-based index of the first occurrence of %3i in the series:' % n_occur,
stern_brocot(lambda series: n_occur not in series).index(n_occur) + 1)
# The following would be much faster. Note that new values always occur at odd indices
# len(stern_brocot(lambda series: n_occur != series[-2])) - 1)
print()
n_gcd = 1000
s = stern_brocot(lambda series: len(series) < n_gcd)[:n_gcd]
assert all(gcd(prev, this) == 1
for prev, this in zip(s, s[1:])), 'A fraction from adjacent terms is reducible'

22
Task/Stern-Brocot-sequence/Python/stern-brocot-sequence-2.py Normal file
View file

@ -0,0 +1,22 @@
>>> from itertools import takewhile, tee, islice
>>> from collections import deque
>>> from fractions import gcd
>>>
>>> def stern_brocot():
sb = deque([1, 1])
while True:
sb += [sb[0] + sb[1], sb[1]]
yield sb.popleft()
>>> [s for _, s in zip(range(15), stern_brocot())]
[1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4]
>>> [1 + sum(1 for i in takewhile(lambda x: x != occur, stern_brocot()))
for occur in (list(range(1, 11)) + [100])]
[1, 3, 5, 9, 11, 33, 19, 21, 35, 39, 1179]
>>> prev, this = tee(stern_brocot(), 2)
>>> next(this)
1
>>> all(gcd(p, t) == 1 for p, t in islice(zip(prev, this), 1000))
True
>>>

178
Task/Stern-Brocot-sequence/Python/stern-brocot-sequence-3.py Normal file
View file

@ -0,0 +1,178 @@
'''Stern-Brocot sequence'''
import math
import operator
from itertools import count, dropwhile, islice, takewhile
# sternBrocot :: Generator [Int]
def sternBrocot():
'''Non-finite list of the Stern-Brocot
sequence of integers.
'''
def go(xs):
[a, b] = xs[:2]
return (a, xs[1:] + [a + b, b])
return unfoldr(go)([1, 1])
# ------------------------ TESTS -------------------------
# main :: IO ()
def main():
'''Various tests'''
[eq, ne, gcd] = map(
curry,
[operator.eq, operator.ne, math.gcd]
)
sbs = take(1200)(sternBrocot())
ixSB = zip(sbs, enumFrom(1))
print(unlines(map(str, [
# First 15 members of the sequence.
take(15)(sbs),
# Indices of where the numbers [1..10] first appear.
take(10)(
nubBy(on(eq)(fst))(
sorted(
takewhile(
compose(ne(12))(fst),
ixSB
),
key=fst
)
)
),
# Index of where the number 100 first appears.
take(1)(dropwhile(compose(ne(100))(fst), ixSB)),
# Is the gcd of any two consecutive members,
# up to the 1000th member, always one ?
every(compose(eq(1)(gcd)))(
take(1000)(zip(sbs, tail(sbs)))
)
])))
# ----------------- GENERIC ABSTRACTIONS -----------------
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# curry :: ((a, b) -> c) -> a -> b -> c
def curry(f):
'''A curried function derived
from an uncurried function.'''
return lambda a: lambda b: f(a, b)
# enumFrom :: Enum a => a -> [a]
def enumFrom(x):
'''A non-finite stream of enumerable values,
starting from the given value.'''
return count(x) if isinstance(x, int) else (
map(chr, count(ord(x)))
)
# every :: (a -> Bool) -> [a] -> Bool
def every(p):
'''True if p(x) holds for every x in xs'''
return lambda xs: all(map(p, xs))
# fst :: (a, b) -> a
def fst(tpl):
'''First member of a pair.'''
return tpl[0]
# head :: [a] -> a
def head(xs):
'''The first element of a non-empty list.'''
return xs[0]
# nubBy :: (a -> a -> Bool) -> [a] -> [a]
def nubBy(p):
'''A sublist of xs from which all duplicates,
(as defined by the equality predicate p)
are excluded.
'''
def go(xs):
if not xs:
return []
x = xs[0]
return [x] + go(
list(filter(
lambda y: not p(x)(y),
xs[1:]
))
)
return go
# on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
def on(f):
'''A function returning the value of applying
the binary f to g(a) g(b)'''
return lambda g: lambda a: lambda b: f(g(a))(g(b))
# tail :: [a] -> [a]
# tail :: Gen [a] -> [a]
def tail(xs):
'''The elements following the head of a
(non-empty) list or generator stream.'''
if isinstance(xs, list):
return xs[1:]
else:
islice(xs, 1) # First item dropped.
return xs
# take :: Int -> [a] -> [a]
# take :: Int -> String -> String
def take(n):
'''The prefix of xs of length n,
or xs itself if n > length xs.'''
return lambda xs: (
xs[0:n]
if isinstance(xs, list)
else list(islice(xs, n))
)
# unfoldr :: (b -> Maybe (a, b)) -> b -> Gen [a]
def unfoldr(f):
'''A lazy (generator) list unfolded from a seed value
by repeated application of f until no residue remains.
Dual to fold/reduce.
f returns either None or just (value, residue).
For a strict output list, wrap the result with list()
'''
def go(x):
valueResidue = f(x)
while valueResidue:
yield valueResidue[0]
valueResidue = f(valueResidue[1])
return go
# unlines :: [String] -> String
def unlines(xs):
'''A single string derived by the intercalation
of a list of strings with the newline character.'''
return '\n'.join(xs)
# MAIN ---
if __name__ == '__main__':
main()

61
Task/Stern-Brocot-sequence/QBasic/stern-brocot-sequence.basic Normal file
View file

@ -0,0 +1,61 @@
CONST max = 2000
DIM SHARED stern(max + 2)
FUNCTION gcd (x, y)
WHILE y
t = y
y = x MOD y
x = t
WEND
gcd = x
END FUNCTION
SUB SternBrocot
stern(1) = 1
stern(2) = 1
i = 2: n = 2: ub = UBOUND(stern)
DO WHILE i < ub
i = i + 1
stern(i) = stern(n) + stern(n - 1)
i = i + 1
stern(i) = stern(n)
n = n + 1
LOOP
END SUB
SternBrocot
PRINT "The first 15 are: ";
FOR i = 1 TO 15
PRINT stern(i); " ";
NEXT i
PRINT : PRINT
PRINT " Index First nr."
d = 1
FOR i = 1 TO max
IF stern(i) = d THEN
PRINT USING " ######"; i; stern(i)
d = d + 1
IF d = 11 THEN d = 100
IF d = 101 THEN EXIT FOR
i = 0
END IF
NEXT i
PRINT : PRINT
d = 0
FOR i = 1 TO 1000
IF gcd(stern(i), stern(i + 1)) <> 1 THEN
d = gcd(stern(i), stern(i + 1))
EXIT FOR
END IF
NEXT i
IF d <> 0 THEN
PRINT "GCD of two consecutive members of the series up to the 1000th member is 1"
ELSE
PRINT "The GCD for index "; i; " and "; i + 1; " = "; d
END IF

27
Task/Stern-Brocot-sequence/Quackery/stern-brocot-sequence.quackery Normal file
View file

@ -0,0 +1,27 @@
[ [ dup while
tuck mod again ]
drop abs ] is gcd ( n n --> n )
[ 2dup peek
dip [ 1+ 2dup peek ]
over + swap join
swap dip join ] is two-terms ( [ n --> [ n )
' [ 1 1 ] 0
8 times two-terms
over 15 split drop
witheach [ echo sp ] cr
[ two-terms
over -2 peek 100 = until ]
drop
10 times
[ i^ 1+ over find 1+ echo sp ] cr
dup size 1 - echo cr
false swap
behead swap witheach
[ tuck gcd 1 != if
[ dip not conclude ] ]
drop iff
[ say "Reducible pair found." ]
else
[ say "No reducible pairs found." ]

22
Task/Stern-Brocot-sequence/R/stern-brocot-sequence-1.r Normal file
View file

@ -0,0 +1,22 @@
## Stern-Brocot sequence
## 12/19/16 aev
SternBrocot <- function(n){
V <- 1; k <- n/2;
for (i in 1:k)
{ V[2*i] = V[i]; V[2*i+1] = V[i] + V[i+1];}
return(V);
}
## Required tests:
require(pracma);
{
cat(" *** The first 15:",SternBrocot(15),"\n");
cat(" *** The first i@n:","\n");
V=SternBrocot(40);
for (i in 1:10) {j=match(i,V); cat(i,"@",j,",")}
V=SternBrocot(1200);
i=100; j=match(i,V); cat(i,"@",j,"\n");
V=SternBrocot(1000); j=1;
for (i in 2:1000) {j=j*gcd(V[i-1],V[i])}
if(j==1) {cat(" *** All GCDs=1!\n")} else {cat(" *** All GCDs!=1??\n")}
}

21
Task/Stern-Brocot-sequence/R/stern-brocot-sequence-2.r Normal file
View file

@ -0,0 +1,21 @@
genNStern <- function(n)
{
sternNums <- c(1, 1)
i <- 2
while((endIndex <- length(sternNums)) < n)
{
#To show off R's vectorization, the following line is deliberately terse.
#It assigns sternNums[i-1]+sternNums[i] to sternNums[endIndex+1]
#and it assigns sternNums[i], the "considered" number, to sternNums[endIndex+2], now the end of the sequence.
#Note that we do not have to initialize a big sternNums array to do this.
#True to the algorithm, the new entries are appended to the end of the old sequence.
sternNums[endIndex + c(1, 2)] <- c(sum(sternNums[c(i - 1, i)]), sternNums[i])
i <- i + 1
}
sternNums[seq_len(n)]
}
#N=5000 was picked arbitrarily. The code runs very fast regardless of this number being much more than we need.
firstFiveThousandTerms <- genNStern(5000)
match(1:10, firstFiveThousandTerms)
match(100, firstFiveThousandTerms)
all(sapply(1:999, function(i) gmp::gcd(firstFiveThousandTerms[i], firstFiveThousandTerms[i + 1])) == 1)

50
Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx Normal file
View file

@ -0,0 +1,50 @@
/*REXX program generates & displays a Stern─Brocot sequence; finds 1─based indices; GCDs*/
parse arg N idx fix chk . /*get optional arguments from the C.L. */
if N=='' | N=="," then N= 15 /*Not specified? Then use the default.*/
if idx=='' | idx=="," then idx= 10 /* " " " " " " */
if fix=='' | fix=="," then fix= 100 /* " " " " " " */
if chk=='' | chk=="," then chk= 1000 /* " " " " " " */
if N>0 then say center('the first' N "numbers in the Stern─Brocot sequence", 70, '═')
a= Stern_Brocot(N) /*invoke function to generate sequence.*/
say a /*display the sequence to the terminal.*/
say
say center('the 1─based index for the first' idx "integers", 70, '═')
a= Stern_Brocot(-idx) /*invoke function to generate sequence.*/
w= length(idx); do i=1 for idx
say 'for ' right(i, w)", the index is: " wordpos(i, a)
end /*i*/
say
say center('the 1─based index for' fix, 70, "═")
a= Stern_Brocot(-fix) /*invoke function to generate sequence.*/
say 'for ' fix", the index is: " wordpos(fix, a)
say
if chk<2 then exit 0
say center('checking if all two consecutive members have a GCD=1', 70, '═')
a= Stern_Brocot(chk) /*invoke function to generate sequence.*/
do c=1 for chk-1; if gcd(subword(a, c, 2))==1 then iterate
say 'GCD check failed at index' c; exit 13
end /*c*/
say
say '───── All ' chk " two consecutive members have a GCD of unity."
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gcd: procedure; $=; do i=1 for arg(); $= $ arg(i) /*get arg list. */
end /*i*/
parse var $ x z .; if x=0 then x= z /*is zero case? */
x=abs(x) /*use absolute x*/
do j=2 to words($); y=abs( word($, j) )
if y=0 then iterate /*ignore zeros. */
do until y==0; parse value x//y y with y x /* ◄──heavy work*/
end /*until*/
end /*j*/
return x /*return the GCD*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
Stern_Brocot: parse arg h 1 f; $= 1 1; if h<0 then h= 1e9
else f= 0
f= abs(f)
do k=2 until words($)>=h | wordpos(f, $)\==0
_= word($, k); $= $ (_ + word($, k-1) ) _
end /*k*/
if f==0 then return subword($, 1, h)
return $

38
Task/Stern-Brocot-sequence/Racket/stern-brocot-sequence.rkt Normal file
View file

@ -0,0 +1,38 @@
#lang racket
;; OEIS Definition
;; A002487
;; Stern's diatomic series
;; (or Stern-Brocot sequence):
;; a(0) = 0, a(1) = 1;
;; for n > 0:
;; a(2*n) = a(n),
;; a(2*n+1) = a(n) + a(n+1).
(define A002487
(let ((memo (make-hash '((0 . 0) (1 . 1)))))
(lambda (n)
(hash-ref! memo n
(lambda ()
(define n/2 (quotient n 2))
(+ (A002487 n/2) (if (even? n) 0 (A002487 (add1 n/2)))))))))
(define Stern-Brocot A002487)
(displayln "Show the first fifteen members of the sequence.
(This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4)")
(for/list ((i (in-range 1 (add1 15)))) (Stern-Brocot i))
(displayln "Show the (1-based) index of where the numbers 1-to-10 first appears in the sequence.")
(for ((n (in-range 1 (add1 10))))
(for/first ((i (in-naturals 1))
#:when (= n (Stern-Brocot i)))
(printf "~a first found at a(~a)~%" n i)))
(displayln "Show the (1-based) index of where the number 100 first appears in the sequence.")
(for/first ((i (in-naturals 1)) #:when (= 100 (Stern-Brocot i))) i)
(displayln "Check that the greatest common divisor of all the two consecutive members of the
series up to the 1000th member, is always one.")
(unless
(for/first ((i (in-range 1 1000))
#:unless (= 1 (gcd (Stern-Brocot i) (Stern-Brocot (add1 i))))) #t)
(display "\tdidn't find gcd > (or otherwise ≠) 1"))

9
Task/Stern-Brocot-sequence/Raku/stern-brocot-sequence.raku Normal file
View file

@ -0,0 +1,9 @@
constant @Stern-Brocot = 1, 1, { |(@_[$_ - 1] + @_[$_], @_[$_]) given ++$ } ... *;
 
put @Stern-Brocot[^15];
 
for flat 1..10, 100 -> $ix {
say "First occurrence of {$ix.fmt('%3d')} is at index: {(1+@Stern-Brocot.first($ix, :k)).fmt('%4d')}";
}
 
say so 1 == all map ^1000: { [gcd] @Stern-Brocot[$_, $_ + 1] }

53
Task/Stern-Brocot-sequence/Ring/stern-brocot-sequence.ring Normal file
View file

@ -0,0 +1,53 @@
# Project : Stern-Brocot sequence
limit = 1200
item = list(limit+1)
item[1] = 1
item[2] = 1
nr = 2
gcd = 1
gcdall = 1
for num = 3 to limit
item[num] = item[nr] + item[nr-1]
item[num+1] = item[nr]
nr = nr + 1
num = num + 1
next
showarray(item,15)
for x = 1 to 100
if x < 11 or x = 100
totalitem(x)
ok
next
for n = 1 to len(item) - 1
if gcd(item[n],item[n+1]) != 1
gcdall = gcd
ok
next
if gcdall = 1
see "Correct: The first 999 consecutive pairs are relative prime!" + nl
ok
func totalitem(p)
pos = find(item, p)
see string(x) + " at Stern #" + pos + "." + nl
func showarray(vect,ln)
svect = ""
for n = 1 to ln
svect = svect + vect[n] + ", "
next
svect = left(svect, len(svect) - 2)
see svect
see nl
func gcd(gcd,b)
while b
c = gcd
gcd = b
b = c % b
end
return gcd

20
Task/Stern-Brocot-sequence/Ruby/stern-brocot-sequence.rb Normal file
View file

@ -0,0 +1,20 @@
def sb
return enum_for :sb unless block_given?
a=[1,1]
0.step do |i|
yield a[i]
a << a[i]+a[i+1] << a[i+1]
end
end
puts "First 15: #{sb.first(15)}"
[*1..10,100].each do |n|
puts "#{n} first appears at #{sb.find_index(n)+1}."
end
if sb.take(1000).each_cons(2).all? { |a,b| a.gcd(b) == 1 }
puts "All GCD's are 1"
else
puts "Whoops, not all GCD's are 1!"
end

18
Task/Stern-Brocot-sequence/Scala/stern-brocot-sequence.scala Normal file
View file

@ -0,0 +1,18 @@
lazy val sbSeq: Stream[BigInt] = {
BigInt("1") #::
BigInt("1") #::
(sbSeq zip sbSeq.tail zip sbSeq.tail).
flatMap{ case ((a,b),c) => List(a+b,c) }
}
// Show the results
{
println( s"First 15 members: ${(for( n <- 0 until 15 ) yield sbSeq(n)) mkString( "," )}" )
println
for( n <- 1 to 10; pos = sbSeq.indexOf(n) + 1 ) println( s"Position of first $n is at $pos" )
println
println( s"Position of first 100 is at ${sbSeq.indexOf(100) + 1}" )
println
println( s"Greatest Common Divisor for first 1000 members is 1: " +
(sbSeq zip sbSeq.tail).take(1000).forall{ case (a,b) => a.gcd(b) == 1 } )
}

14
Task/Stern-Brocot-sequence/Scheme/stern-brocot-sequence-1.ss Normal file
View file

@ -0,0 +1,14 @@
; Recursive function to return the Nth Stern-Brocot sequence number.
(define stern-brocot
(lambda (n)
(cond
((<= n 0)
0)
((<= n 2)
1)
((even? n)
(stern-brocot (/ n 2)))
(else
(let ((earlier (/ (1+ n) 2)))
(+ (stern-brocot earlier) (stern-brocot (1- earlier))))))))

48
Task/Stern-Brocot-sequence/Scheme/stern-brocot-sequence-2.ss Normal file
View file

@ -0,0 +1,48 @@
; Show the first 15 Stern-Brocot sequence numbers.
(printf "First 15 Stern-Brocot numbers:")
(do ((index 1 (1+ index)))
((> index 15))
(printf " ~a" (stern-brocot index)))
(newline)
; Show the indices of where the numbers 1 to 10 first appear in the Stern-Brocot sequence.
(let ((indices (make-vector 11 #f))
(found 0))
(do ((index 1 (1+ index)))
((>= found 10))
(let ((number (stern-brocot index)))
(when (and (<= number 10) (not (vector-ref indices number)))
(vector-set! indices number index)
(set! found (1+ found)))))
(printf "Indices of where the numbers 1 to 10 first appear:")
(do ((index 1 (1+ index)))
((> index 10))
(printf " ~a" (vector-ref indices index))))
(newline)
; Show the index of where the number 100 first appears in the Stern-Brocot sequence.
(do ((index 1 (1+ index)) (found #f))
(found)
(let ((number (stern-brocot index)))
(when (= number 100)
(printf "Index where the number 100 first appears: ~a~%" index)
(set! found #t))))
; Check that the GCD of all two consecutive members up to the 1000th member is always one.
(let ((any-bad #f)
(gcd (lambda (a b)
(if (= b 0)
a
(gcd b (remainder a b))))))
(do ((index 1 (1+ index)))
((> index 1000))
(let ((sbgcd (gcd (stern-brocot index) (stern-brocot (1+ index)))))
(when (not (= 1 sbgcd))
(printf "GCD of Stern-Brocot ~a and ~a+1 is ~a -- Not 1~%" index index sbgcd)
(set! any-bad #t))))
(when (not any-bad)
(printf "GCDs of all Stern-Brocot consecutive pairs from 1 to 1000 are 1~%")))

34
Task/Stern-Brocot-sequence/Sidef/stern-brocot-sequence.sidef Normal file
View file

@ -0,0 +1,34 @@
# Declare a function to generate the Stern-Brocot sequence
func stern_brocot {
var list = [1, 1]
{
list.append(list[0]+list[1], list[1])
list.shift
}
}
# Show the first fifteen members of the sequence.
say 15.of(stern_brocot()).join(' ')
# Show the (1-based) index of where the numbers 1-to-10 first appears
# in the sequence, and where the number 100 first appears in the sequence.
for i (1..10, 100) {
var index = 1
var generator = stern_brocot()
while (generator() != i) {
++index
}
say "First occurrence of #{i} is at index #{index}"
}
# Check that the greatest common divisor of all the two consecutive
# members of the series up to the 1000th member, is always one.
var generator = stern_brocot()
var (a, b) = (generator(), generator())
{
assert_eq(gcd(a, b), 1)
a = b
b = generator()
} * 1000
say "All GCD's are 1"

45
Task/Stern-Brocot-sequence/Snobol/stern-brocot-sequence.sno Normal file
View file

@ -0,0 +1,45 @@
* GCD function
DEFINE('GCD(A,B)') :(GCD_END)
GCD GCD = A
EQ(B,0) :S(RETURN)
A = B
B = REMDR(GCD,B) :(GCD)
GCD_END
* Find first occurrence of element in array
DEFINE('IDX(ARR,ELM)') :(IDX_END)
IDX IDX = 1
ITEST EQ(ARR<IDX>,ELM) :S(RETURN)
IDX = IDX + 1 :(ITEST)
IDX_END
* Declare array
SEQ = ARRAY(1200,1)
* Fill array with Stern-Brocot sequence
IX = 1
FILL IX = IX + 1
SEQ<IX * 2 - 1> = SEQ<IX> + SEQ<IX - 1>
SEQ<IX * 2> = SEQ<IX> :S(FILL)
* Print first 15 elements
DONE IX = 1
S = "First 15 elements:"
P15 S = S " " SEQ<IX>
IX = IX + 1 LT(IX,15) :S(P15)
OUTPUT = S
* Print first occurrence of 1..10 and 100
N = 1
FIRSTN OUTPUT = "First " N " at " IDX(SEQ,N)
N = N + 1 LT(N,10) :S(FIRSTN)
OUTPUT = "First 100 at " IDX(SEQ,100)
* Test GCD between 1000 consecutive members
IX = 2
GCDTEST EQ(GCD(SEQ<IX - 1>,SEQ<IX>),1) :F(GCDFAIL)
IX = IX + 1 LT(IX,1000) :S(GCDTEST)
OUTPUT = "All GCDs are 1." :(END)
GCDFAIL OUTPUT = "GCD is not 1 at " IX "."
END

40
Task/Stern-Brocot-sequence/Swift/stern-brocot-sequence.swift Normal file
View file

@ -0,0 +1,40 @@
struct SternBrocot: Sequence, IteratorProtocol {
private var seq = [1, 1]
mutating func next() -> Int? {
seq += [seq[0] + seq[1], seq[1]]
return seq.removeFirst()
}
}
func gcd<T: BinaryInteger>(_ a: T, _ b: T) -> T {
guard a != 0 else {
return b
}
return a < b ? gcd(b % a, a) : gcd(a % b, b)
}
print("First 15: \(Array(SternBrocot().prefix(15)))")
var found = Set<Int>()
for (i, val) in SternBrocot().enumerated() {
switch val {
case 1...10 where !found.contains(val), 100 where !found.contains(val):
print("First \(val) at \(i + 1)")
found.insert(val)
case _:
continue
}
if found.count == 11 {
break
}
}
let firstThousand = SternBrocot().prefix(1000)
let gcdIsOne = zip(firstThousand, firstThousand.dropFirst()).allSatisfy({ gcd($0.0, $0.1) == 1 })
print("GCDs of all two consecutive members are \(gcdIsOne ? "" : "not")one")

104
Task/Stern-Brocot-sequence/Tcl/stern-brocot-sequence.tcl Normal file
View file

@ -0,0 +1,104 @@
#!/usr/bin/env tclsh
#
package require generator ;# from tcllib
namespace eval stern-brocot {
proc generate {{count 100}} {
set seq {1 1}
set n 0
while {[llength $seq] < $count} {
lassign [lrange $seq $n $n+1] a b
lappend seq [expr {$a + $b}] $b
incr n
}
return $seq
}
proc genr {} {
yield [info coroutine]
set seq {1 1}
while {1} {
set seq [lassign $seq a]
set b [lindex $seq 0]
set c [expr {$a + $b}]
lappend seq $c $b
yield $a
}
}
proc Step {a b args} {
set c [expr {$a + $b}]
list $a [list $b {*}$args $c $b]
}
generator define gen {} {
set cmd [list 1 1]
while {1} {
lassign [Step {*}$cmd] a cmd
generator yield $a
}
}
namespace export {[a-z]*}
namespace ensemble create
}
interp alias {} sb {} stern-brocot
# a simple adaptation of gcd from http://wiki.tcl.tk/2891
proc coprime {a args} {
set gcd $a
foreach arg $args {
while {$arg != 0} {
set t $arg
set arg [expr {$gcd % $arg}]
set gcd $t
if {$gcd == 1} {return true}
}
}
return false
}
proc main {} {
puts "#1. First 15 members of the Stern-Brocot sequence:"
puts \t[generator to list [generator take 16 [sb gen]]]
puts "#2. First occurrences of 1 through 10:"
set first {}
set got 0
set i 0
generator foreach x [sb gen] {
incr i
if {$x>10} continue
if {[dict exists $first $x]} continue
dict set first $x $i
if {[incr got] >= 10} break
}
foreach {a b} [lsort -integer -stride 2 $first] {
puts "\tFirst $a at $b"
}
puts "#3. First occurrence of 100:"
set i 0
generator foreach x [sb gen] {
incr i
if {$x eq 100} break
}
puts "\tFirst $x at $i"
puts "#4. Check first 1k elements for common divisors:"
set prev [expr {2*3*5*7*11*13*17*19+1}] ;# a handy prime
set i 0
generator foreach x [sb gen] {
if {[incr i] >= 1000} break
if {![coprime $x $prev]} {
error "Element $i, $x is not coprime with $prev!"
}
set prev $x
}
puts "\tFirst $i elements are all pairwise coprime"
}
main

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