module Main where import Graphics.Rendering.Diagrams import Data.Ratio import System.Random (<+>) :: Rational -> Rational -> Rational r1 <+> r2 = (numerator r1 + numerator r2) % (denominator r1 + denominator r2) farey :: Integer -> [Rational] farey 0 = [0%1, 1%1] farey n = filter ((<=n) . denominator) $ insertMediants (farey (n-1)) insertMediants :: [Rational] -> [Rational] insertMediants [] = [] insertMediants [x] = [x] insertMediants (x:y:zs) = x : (x <+> y) : insertMediants (y:zs) fordCircles :: Integer -> [Diagram] fordCircles n = map toCircle $ farey n toCircle r = translateX r' $ circle (1 / (2 * d'^2)) where r' = fromRational r d' = fromIntegral (denominator r) dia :: [Color] -> Diagram dia colors = view (0,0) (1,1/2) $ unionA hcenter bottom $ zipWith fc colors (fordCircles 20) randomColors :: [Double] -> [Color] randomColors (r:g:b:ds) = rgb r g b : randomColors ds main :: IO () main = do g <- newStdGen let rs = randoms g renderAs PNG "ford.png" (Width 500) (dia $ randomColors rs)