Stern-Brocot sequence: Difference between revisions
m
→{{header|Wren}}: Minor tidy
(→OCaml: add) |
m (→{{header|Wren}}: Minor tidy) |
||
| (7 intermediate revisions by 4 users not shown) | |||
Line 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 2,483 ⟶ 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 3,945 ⟶ 4,094:
Task 5: PASS</pre>
=={{header|MACRO-11}}==
<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}}==
Line 4,025 ⟶ 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 5,350 ⟶ 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,497 ⟶ 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,650 ⟶ 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 6,060 ⟶ 6,624:
{{libheader|Wren-math}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="
import "./fmt" for Fmt
var sbs = [1, 1]
| |||