September Morn Update
This commit is contained in:
Ingy döt Net
parent
4e2d22a71d
commit
aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
|
|
@ -29,12 +29,13 @@ For this task, the Stern-Brocot sequence is to be generated by an algorithm simi
|
|||
<br>Show your output on this page.
|
||||
|
||||
|
||||
;Related tasks:
|
||||
:* [[Fusc sequence]].
|
||||
:* [[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.
|
||||
|
||||
|
||||
;Related Tasks:
|
||||
* [[Continued fraction/Arithmetic]]
|
||||
<br><br>
|
||||
|
|
|
|||
1
Task/Stern-Brocot-sequence/00META.yaml
Normal file
1
Task/Stern-Brocot-sequence/00META.yaml
Normal file
|
|
@ -0,0 +1 @@
|
|||
--- {}
|
||||
|
|
@ -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
|
||||
|
|
@ -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++;
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,518 @@
|
|||
use AppleScript version "2.4"
|
||||
use framework "Foundation"
|
||||
use scripting additions
|
||||
|
||||
|
||||
-- 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 ABSTRACTIONS -------------------------------------------------------
|
||||
|
||||
|
||||
-- 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
|
||||
|
|
@ -1,18 +1,34 @@
|
|||
;; compute the Nth (1-based) Stern-Brocot number directly
|
||||
(defn nth-stern-brocot [n]
|
||||
(if (< n 2)
|
||||
n
|
||||
(let [h (quot n 2) h1 (inc h) hth (nth-stern-brocot h)]
|
||||
(if (zero? (mod n 2)) hth (+ hth (nth-stern-brocot h1))))))
|
||||
;; each step adds two items
|
||||
(defn sb-step [v]
|
||||
(let [i (quot (count v) 2)]
|
||||
(conj v (+ (v (dec i)) (v i)) (v i))))
|
||||
|
||||
;; return a lazy version of the entire Stern-Brocot sequence
|
||||
(defn stern-brocot
|
||||
([] (stern-brocot 1))
|
||||
([n] (cons (nth-stern-brocot n) (lazy-seq (stern-brocot (inc n))))))
|
||||
;; A lazy, infinite sequence -- `take` what you want.
|
||||
(def all-sbs (sequence (map peek) (iterate sb-step [1 1])))
|
||||
|
||||
(printf "Stern-Brocot numbers 1-15: %s%n"
|
||||
(clojure.string/join ", " (take 15 (stern-brocot))))
|
||||
;; zero-based
|
||||
(defn first-appearance [n]
|
||||
(first (keep-indexed (fn [i x] (when (= x n) i)) all-sbs)))
|
||||
|
||||
(dorun (for [n (concat (range 1 11) [100])]
|
||||
(printf "The first appearance of %3d is at index %4d.%n"
|
||||
n (inc (first (keep-indexed #(when (= %2 n) %1) (stern-brocot)))))))
|
||||
;; 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)
|
||||
|
|
|
|||
31
Task/Stern-Brocot-sequence/Fortran/stern-brocot-sequence-1.f
Normal file
31
Task/Stern-Brocot-sequence/Fortran/stern-brocot-sequence-1.f
Normal 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
22
Task/Stern-Brocot-sequence/Fortran/stern-brocot-sequence-2.f
Normal 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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
import Data.List (nubBy, sortBy)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Function (on)
|
||||
|
||||
sternBrocot :: [Int]
|
||||
sternBrocot =
|
||||
let go (a:b:xs) = (b : xs) <> [a + b, b]
|
||||
in head <$> iterate go [1, 1]
|
||||
|
||||
-- TEST -------------------------------------------------------------
|
||||
main :: IO ()
|
||||
main = do
|
||||
print $ take 15 sternBrocot
|
||||
print $
|
||||
take 10 $
|
||||
nubBy (on (==) fst) $
|
||||
sortBy (comparing 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
|
||||
325
Task/Stern-Brocot-sequence/JavaScript/stern-brocot-sequence.js
Normal file
325
Task/Stern-Brocot-sequence/JavaScript/stern-brocot-sequence.js
Normal 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();
|
||||
})();
|
||||
|
|
@ -1,5 +1,4 @@
|
|||
use List::Util qw/first/;
|
||||
use ntheory qw/gcd vecsum/;
|
||||
use ntheory qw/gcd vecsum vecfirst/;
|
||||
|
||||
sub stern_diatomic {
|
||||
my ($p,$q,$i) = (0,1,shift);
|
||||
|
|
@ -12,9 +11,9 @@ sub stern_diatomic {
|
|||
|
||||
my @s = map { stern_diatomic($_) } 1..15;
|
||||
print "First fifteen: [@s]\n";
|
||||
@s = map { my $n=$_; first { stern_diatomic($_) == $n } 1..10000 } 1..10;
|
||||
@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: ", (first { stern_diatomic($_) == 100 } 1..10000), "\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";
|
||||
|
|
|
|||
191
Task/Stern-Brocot-sequence/Python/stern-brocot-sequence-3.py
Normal file
191
Task/Stern-Brocot-sequence/Python/stern-brocot-sequence-3.py
Normal file
|
|
@ -0,0 +1,191 @@
|
|||
'''Stern-Brocot sequence'''
|
||||
|
||||
from itertools import (count, dropwhile, islice, takewhile)
|
||||
import operator
|
||||
import math
|
||||
|
||||
|
||||
# sternBrocot :: Generator [Int]
|
||||
def sternBrocot():
|
||||
'''Non-finite list of the Stern-Brocot
|
||||
sequence of integers.'''
|
||||
|
||||
def go(xs):
|
||||
x = xs[1]
|
||||
return (tail(xs) + [x + head(xs), x])
|
||||
return fmapGen(head)(
|
||||
iterate(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))
|
||||
|
||||
|
||||
# fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
|
||||
def fmapGen(f):
|
||||
'''A function f mapped over a
|
||||
non finite stream of values.'''
|
||||
def go(g):
|
||||
while True:
|
||||
v = next(g, None)
|
||||
if None is not v:
|
||||
yield f(v)
|
||||
else:
|
||||
return
|
||||
return lambda gen: go(gen)
|
||||
|
||||
|
||||
# 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]
|
||||
|
||||
|
||||
# iterate :: (a -> a) -> a -> Gen [a]
|
||||
def iterate(f):
|
||||
'''An infinite list of repeated
|
||||
applications of f to x.'''
|
||||
def go(x):
|
||||
v = x
|
||||
while True:
|
||||
yield v
|
||||
v = f(v)
|
||||
return lambda x: go(x)
|
||||
|
||||
|
||||
# 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 lambda xs: go(xs)
|
||||
|
||||
|
||||
# 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:
|
||||
list(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))
|
||||
)
|
||||
|
||||
|
||||
# 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()
|
||||
|
|
@ -13,7 +13,7 @@ puts "First 15: #{sb.first(15)}"
|
|||
puts "#{n} first appears at #{sb.find_index(n)+1}."
|
||||
end
|
||||
|
||||
if sb.take(1000).each_cons(2).map { |a,b| a.gcd(b) }.all? { |n| n==1 }
|
||||
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!"
|
||||
|
|
|
|||
40
Task/Stern-Brocot-sequence/Swift/stern-brocot-sequence.swift
Normal file
40
Task/Stern-Brocot-sequence/Swift/stern-brocot-sequence.swift
Normal 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")
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
Imports System
|
||||
Imports System.Collections.Generic
|
||||
Imports System.Linq
|
||||
|
||||
Module Module1
|
||||
Dim l As List(Of Integer) = {1, 1}.ToList()
|
||||
|
||||
Function gcd(ByVal a As Integer, ByVal b As Integer) As Integer
|
||||
Return If(a > 0, If(a < b, gcd(b Mod a, a), gcd(a Mod b, b)), b)
|
||||
End Function
|
||||
|
||||
Sub Main(ByVal args As String())
|
||||
Dim max As Integer = 1000, take As Integer = 15, i As Integer = 1,
|
||||
selection As Integer() = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 100}
|
||||
Do : l.AddRange({l(i) + l(i - 1), l(i)}.ToList) : i += 1
|
||||
Loop While l.Count < max OrElse l(l.Count - 2) <> selection.Last()
|
||||
Console.Write("The first {0} items In the Stern-Brocot sequence: ", take)
|
||||
Console.WriteLine("{0}" & vbLf, String.Join(", ", l.Take(take)))
|
||||
Console.WriteLine("The locations of where the selected numbers (1-to-10, & 100) first appear:")
|
||||
For Each ii As Integer In selection
|
||||
Dim j As Integer = l.FindIndex(Function(x) x = ii) + 1
|
||||
Console.WriteLine("{0,3}: {1:n0}", ii, j)
|
||||
Next : Console.WriteLine() : Dim good As Boolean = True : For i = 1 To max
|
||||
If gcd(l(i), l(i - 1)) <> 1 Then good = False : Exit For
|
||||
Next
|
||||
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, If(good, "", "not "))
|
||||
End Sub
|
||||
End Module
|
||||
Loading…
Add table
Add a link
Reference in a new issue