factorization diagrams with happstack (http://diagrams.alpmestan.com)

root / Factorization.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
module Factorization where
 
import Math.NumberTheory.Primes.Factorisation (factorise)

import Diagrams.Prelude
import Diagrams.Backend.SVG
import Diagrams.Backend.SVG.CmdLine

type Picture = Diagram SVG R2

primeLayout :: Integer -> Picture -> Picture
primeLayout 2 d
  | width d > height d = d === strutY (height d / 2) === d
  | otherwise          = d ||| strutX (width d / 2)  ||| d
primeLayout p d = decoratePath pts (repeat d)
  where pts = polygon with { polyType   = PolyRegular (fromIntegral p) r
                           , polyOrient = OrientH
                           }
        w = max (width d) (height d)
        r = w * c / sin (tau / (2 * fromIntegral p))
        c = 0.75

factorDiagram' :: [Integer] -> Diagram SVG R2
factorDiagram' []     = circle 1 # fc black
factorDiagram' (p:ps) = primeLayout p (factorDiagram' ps) # centerXY

factorDiagram :: Integer -> Diagram SVG R2
factorDiagram = factorDiagram'
              . reverse
              . concatMap (uncurry $ flip replicate)
              . factorise