Stern-Brocot sequence: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
m (→{{header|Wren}}: Minor tidy) |
||
| (8 intermediate revisions by 5 users not shown) | |||
Line 11:
#* 1, 1, 2, 1
# Consider the next member of the series, (the third member i.e. 2)
# GOTO 3
#*
#* ─── Expanding another loop we get: ───
#*
Line 25:
* 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
* 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.
Line 39:
;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>
Line 199:
=={{header|8080 Assembly}}==
<syntaxhighlight lang="8080asm">puts: equ 9 ; CP/M syscall to print a string
org 100h
Line 345 ⟶ 344:
=={{header|8086 Assembly}}==
<syntaxhighlight lang="asm">puts: equ 9
cpu 8086
Line 454 ⟶ 452:
1179
GCD of all pairs of consecutive members is 1.</pre>
=={{header|Action!}}==
Line 556 ⟶ 552:
=={{header|Ada}}==
<syntaxhighlight lang="ada">with Ada.Text_IO, Ada.Containers.Vectors;
Line 876 ⟶ 871:
=={{header|APL}}==
<syntaxhighlight lang="apl">task←{
stern←{⍵{
Line 1,443 ⟶ 1,437:
[100,1179]
true</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">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."</syntaxhighlight>
{{out}}
<pre>First 15 terms: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4
Index of first occurrence of number 1 : 1
Index of first occurrence of number 2 : 3
Index of first occurrence of number 3 : 5
Index of first occurrence of number 4 : 9
Index of first occurrence of number 5 : 11
Index of first occurrence of number 6 : 33
Index of first occurrence of number 7 : 19
Index of first occurrence of number 8 : 21
Index of first occurrence of number 9 : 35
Index of first occurrence of number 10 : 39
Index of first occurrence of number 100 : 1179
All consecutive terms up to the 1000th member have a GCD equal to one.</pre>
=={{header|AutoHotkey}}==
Line 1,538 ⟶ 1,603:
=={{header|BASIC}}==
<syntaxhighlight lang="basic">10 DEFINT A,B,I,J,S: DIM S(1200)
20 S(1)=1: S(2)=1
Line 1,837 ⟶ 1,901:
The GCD of each pair of consecutive members is 1.</pre>
=={{header|C}}==
Recursive function.
Line 2,489 ⟶ 2,554:
1-based index of the first occurrence of 100 in the series: 1179
7984</pre>
=={{header|EasyLang}}==
{{trans|Lua}}
<syntaxhighlight>
global sb[] .
proc sternbrocot n . .
sb[] = [ 1 1 ]
pos = 2
repeat
c = sb[pos]
sb[] &= c + sb[pos - 1]
sb[] &= c
pos += 1
until len sb[] >= n
.
.
func first v .
for i to len sb[]
if v <> 0
if sb[i] = v
return i
.
else
if sb[i] <> 0
return i
.
.
.
return 0
.
func gcd x y .
if y = 0
return x
.
return gcd y (x mod y)
.
func$ task5 .
for i to 1000
if gcd sb[i] sb[i + 1] <> 1
return "FAIL"
.
.
return "PASS"
.
sternbrocot 10000
write "Task 2: "
for i to 15
write sb[i] & " "
.
print "\n\nTask 3:"
for i to 10
print "\t" & i & " " & first i
.
print "\nTask 4: " & first 100
print "\nTask 5: " & task5
</syntaxhighlight>
{{out}}
<pre>
Task 2: 1 1 2 1 3 2 3 1 4 3 5 2 5 3 4
Task 3:
1 1
2 3
3 5
4 9
5 11
6 33
7 19
8 21
9 35
10 39
Task 4: 1179
Task 5: PASS
</pre>
=={{header|EchoLisp}}==
Line 2,667 ⟶ 2,810:
=={{header|Forth}}==
<syntaxhighlight lang="forth">: stern ( n -- x : return N'th item of Stern-Brocot sequence)
dup 2 >= if
Line 3,154 ⟶ 3,296:
=={{header|J}}==
We have two different kinds of list specifications here (length of the sequence, and the presence of certain values in the sequence). Also the underlying list generation mechanism is somewhat arbitrary. So let's generate the sequence iteratively and provide a truth valued function of the intermediate sequences to determine when we have generated one which is adequately long:
Line 3,954 ⟶ 4,095:
Task 5: PASS</pre>
=={{header|
<syntaxhighlight lang="macro11"> .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</syntaxhighlight>
{{out}}
<pre>FIRST 15: 1 1 2 1 3 2 3 1 4 3 5 2 5 3 4
FIRST OCCURRENCES:
1 AT 1
2 AT 3
3 AT 5
4 AT 9
5 AT 11
6 AT 33
7 AT 19
8 AT 21
9 AT 35
10 AT 39
100 AT 1179
CHECKING GCDS OF ADJACENT PAIRS... ALL 1.</pre>
=={{header|MAD}}==
<syntaxhighlight lang="mad"> NORMAL MODE IS INTEGER
VECTOR VALUES FRST15 = $20HFIRST 15 NUMBERS ARE*$
Line 4,034 ⟶ 4,322:
1179
True</pre>
=={{header|Miranda}}==
<syntaxhighlight lang="miranda">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</syntaxhighlight>
{{out}}
<pre>First 15: [1,1,2,1,3,2,3,1,4,3,5,2,5,3,4]
Indices of first 1..10: [1,3,5,9,11,33,19,21,35,39]
Index of first 100: 1179
The GCDs of the first 1000 pairs are all 1: True</pre>
=={{header|Modula-2}}==
Line 4,205 ⟶ 4,535:
All consecutive terms up to the 1000th member have a GCD equal to one.</pre>
=={{header|
<syntaxhighlight lang="ocaml">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</syntaxhighlight>
;<nowiki>Tests:</nowiki>
<syntaxhighlight lang="ocaml">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"</syntaxhighlight>
{{out}}
<pre>
1 1 2 1 3 2 3 1 4 3 5 2 5 3 4
1@1 2@3 3@5 4@9 5@11 6@33 7@19 8@21 9@35 10@39 100@1179
true
</pre>
=={{header|Oforth}}==
<syntaxhighlight lang="oforth">: stern(n)
| l i |
Line 5,115 ⟶ 5,488:
=={{header|Quackery}}==
<syntaxhighlight lang="quackery"> [ [ dup while
tuck mod again ]
Line 5,230 ⟶ 5,602:
=={{header|Racket}}==
<syntaxhighlight lang="racket">#lang racket
;; OEIS Definition
Line 5,318 ⟶ 5,689:
True</pre>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, <Stern 1300>: e.Seq
= <Prout 'First 15: ' <Take 15 e.Seq>>
<ForEach (<Iota 1 10>) ShowFirst e.Seq>
<ShowFirst 100 e.Seq>
<Prout <GcdPairCheck <Take 1000 e.Seq>>>;
};
Stern {
s.N = <Stern <- s.N 2> (1) 1>;
0 (e.X) e.Y = e.X e.Y;
s.N (e.X s.P) s.C e.Y,
<- s.N 1>: s.Rem,
<+ s.P s.C>: s.CSum
= <Stern s.Rem (e.X s.P s.C) e.Y s.CSum s.C>;
};
Take {
0 e.X = ;
s.N s.I e.X = s.I <Take <- s.N 1> e.X>;
};
FindFirst {
s.I e.X = <FindFirst (1) s.I e.X>;
(s.L) s.I s.I e.X = s.L;
(s.L) s.I s.J e.X = <FindFirst (<+ s.L 1>) s.I e.X>;
};
ShowFirst {
s.I e.X, <FindFirst s.I e.X>: s.N = <Prout 'First ' s.I 'at ' s.N>;
};
ForEach {
() s.F e.Arg = ;
(s.I e.X) s.F e.Arg = <Mu s.F s.I e.Arg> <ForEach (e.X) s.F e.Arg>;
};
Iota {
s.From s.To = <Iota s.From s.To s.From>;
s.From s.To s.To = s.To;
s.From s.To s.Cur = s.Cur <Iota s.From s.To <+ s.Cur 1>>;
};
Gcd {
s.N 0 = s.N;
s.N s.M = <Gcd s.M <Mod s.N s.M>>;
};
GcdPairCheck {
s.A s.B e.X, <Gcd s.A s.B>: 1
= <GcdPairCheck s.B e.X>;
s.A s.B e.X, <Gcd s.A s.B>: s.N
= 'The GCD of ' <Symb s.A> ' and ' <Symb s.B> ' is ' <Symb s.N>;
e.X = 'The GCDs of all adjacent pairs are 1.';
};</syntaxhighlight>
{{out}}
<pre>First 15: 1 1 2 1 3 2 3 1 4 3 5 2 5 3 4
First 1 at 1
First 2 at 3
First 3 at 5
First 4 at 9
First 5 at 11
First 6 at 33
First 7 at 19
First 8 at 21
First 9 at 35
First 10 at 39
First 100 at 1179
The GCDs of all adjacent pairs are 1.</pre>
=={{header|REXX}}==
<syntaxhighlight lang="rexx">/*REXX program generates & displays a Stern─Brocot sequence; finds 1─based indices; GCDs*/
Line 5,465 ⟶ 5,906:
Correct: The first 999 consecutive pairs are relative prime!
</pre>
=={{header|RPL}}==
Task 1 is done by applying the algorithm explained above.
Other requirements are based on Mike Stay's formula for OEIS AA002487:
a(n) = a(n-2) + a(n-1) - 2*(a(n-2) mod a(n-1))
which avoids keeping a huge subset of the sequence in memory
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪
{ 1 1 } 1
'''WHILE''' OVER SIZE 4 PICK < '''REPEAT'''
GETI ROT ROT DUP2 GET 4 ROLL +
ROT SWAP + SWAP
DUP2 GET ROT SWAP + SWAP
'''END''' ROT DROP2
≫ ‘'''TASK1'''’ STO
≪
0 1
2 4 ROLL '''START'''
DUP2 + LAST MOD 2 * - ROT DROP '''NEXT'''
SWAP DROP
≫ ‘'''STERN'''’ STO
≪ 1
'''WHILE''' DUP '''STERN''' 3 PICK ≠ '''REPEAT''' 1 + '''END''' R→C
≫ ‘'''WHEN'''’ STO
|
'''TASK1''' ''( n -- {SB(1)..SB(n) )''
initialize stack with SB(1), SB(2) and pointer i
loop until SB(n) reached
get SB(i)+SB(i+1)
add to list
add SB(i+1) to list
clean stack
'''STERN''' ''( n -- SB(n) )''
initialize stack with SB(0), SB(1)
loop n-2 times
SB(i)=SB(i-1)+SB(i-2)-2*(SB(i-2) mod SB(i-1))
clean stack
'''WHEN''' ''( m -- (n,SB(n)) )'' with SB(n) = m
loop until found
|}
{{in}}
<pre>
15 TASK1
{ } 1 10 FOR n n WHEN + NEXT
100 WHEN
</pre>
{{out}}
<pre>
3: { 1 1 2 1 3 2 3 1 4 3 5 2 5 3 4 1 }
2: { (1,1) (2,3) (3,5) (4,9) (5,11) (6,33) (7,19) (8,21) (9,35) (10,39) }
1: (100,1179)
</pre>
===Faster version for big values of n===
We use here the fact that
SB(2^k) = 1 and SB(2^k + 1) = k+1 for any k>0
which can be easily demonstrated by using the definition of the fusc sequence, identical to the Stern-Brocot sequence (OEIS AA002487).
{| class="wikitable"
! RPL code
! Comment
|-
|
≪
'''IF''' DUP 4 < '''THEN''' 0 1
'''ELSE'''
DUP LN 2 LN / IP 2 OVER ^
ROT SWAP - 1 ROT 1 +
'''END'''
≫ ‘'''Offset'''’ STO
≪
'''Offset'''
2 4 ROLL '''START'''
DUP2 + LAST MOD 2 * - ROT DROP '''NEXT'''
SWAP DROP
≫ ‘'''STERN'''’ STO
|
'''Offset''' ''( n -- 1 k+1 offset )''
start at the beginning for small n values
otherwise
get k with 2^k ≤ n
initialize stack to 1, k+1, n-2^k
'''STERN''' ''( n -- SB(n) )''
initialize stack
loop n-2 times
SB(i)=SB(i-1)+SB(i-2)-2*(SB(i-2) mod SB(i-1))
clean stack
|}
2147484950 '''STERN'''
1: 1385
=={{header|Ruby}}==
Line 5,545 ⟶ 6,091:
Greatest Common Divisor for first 1000 members is 1: true
</pre>
=={{header|Scheme}}==
{{works with|Chez Scheme}}
Line 5,617 ⟶ 6,164:
GCDs of all Stern-Brocot consecutive pairs from 1 to 1000 are 1</pre>
=={{header|SETL}}==
<syntaxhighlight lang="setl">program stern_brocot_sequence;
s := stern(1200);
print("First 15 elements:", s(1..15));
loop for n in [1..10] with 100 do
if exists k = s(i) | k = n then
print("First", n, "at", i);
end if;
end loop;
gcds := [gcd(s(i-1), s(i)) : i in [2..1000]];
if exists g = gcds(i) | g /= 1 then
print("The GCD of the pair at", i, "is not 1.");
else
print("All GCDs of consecutive pairs up to 1000 are 1.");
end if;
proc stern(n);
s := [1, 1];
loop for i in [2..n div 2] do
s(i*2-1) := s(i) + s(i-1);
s(i*2) := s(i);
end loop;
return s;
end proc;
proc gcd(a,b);
loop while b/=0 do
[a, b] := [b, a mod b];
end loop;
return a;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>First 15 elements: [1 1 2 1 3 2 3 1 4 3 5 2 5 3 4]
First 1 at 1
First 2 at 3
First 3 at 5
First 4 at 9
First 5 at 11
First 6 at 33
First 7 at 19
First 8 at 21
First 9 at 35
First 10 at 39
First 100 at 1179
All GCDs of consecutive pairs up to 1000 are 1.</pre>
=={{header|Sidef}}==
{{trans|Perl}}
Line 5,671 ⟶ 6,268:
=={{header|Snobol}}==
<syntaxhighlight lang="snobol">* GCD function
DEFINE('GCD(A,B)') :(GCD_END)
Line 5,733 ⟶ 6,329:
First 100 at 1179
All GCDs are 1.</pre>
=={{header|Swift}}==
<syntaxhighlight lang="swift">struct SternBrocot: Sequence, IteratorProtocol {
private var seq = [1, 1]
Line 6,030 ⟶ 6,624:
{{libheader|Wren-math}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
import "./fmt" for Fmt
var sbs = [1, 1]
| |||