-- 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