38 lines
1.1 KiB
Haskell
38 lines
1.1 KiB
Haskell
-- Functions from the previous post (../1/index.qmd)
|
|
module Previous where
|
|
|
|
import Data.Tree
|
|
import Data.List (nubBy)
|
|
|
|
-- Breadth-first search on a tree
|
|
bfs (Node root children) = bfs' root children where
|
|
bfs' v [] = [v]
|
|
bfs' v ((Node y ys):xs) = v:bfs' y (xs ++ ys)
|
|
|
|
-- Tree of all binary (dyadic) fractions
|
|
binFracTree = unfoldTree make $ (1,1) where
|
|
make v@(vn, vd)
|
|
= (v, [
|
|
(2*vn - 1, 2*vd),
|
|
(2*vn + 1, 2*vd)
|
|
])
|
|
|
|
-- Stern-Brocot Tree, as (numerator, denominator) pairs
|
|
sternBrocot = unfoldTree make $ ((1,1), (0,1), (1,0)) where
|
|
make (v@(vn, vd), l@(ln, ld), r@(rn, rd))
|
|
= (v, [
|
|
(((ln + vn), (ld + vd)), l, v),
|
|
(((vn + rn), (vd + rd)), v, r)
|
|
])
|
|
|
|
-- Build a list of pairs which sum to n
|
|
listPairs n = [ (k, n - k) | k <- [0..n] ]
|
|
|
|
-- "Triangular" enumeration of all pairs of positive integers
|
|
allPairs = concat $ map listPairs [0..]
|
|
|
|
-- Equality for rational numbers expressed as pairs of positive integers
|
|
ratEqual (a, b) (c, d) = a * d == b * c
|
|
-- All positive rational numbers in least terms, as pairs of positive integers
|
|
allRationals = nubBy ratEqual $ map (\(a,b) -> (a+1, b+1)) allPairs
|