module Graphics.Diagrams.FunctionGraphs where
import Graphics.Diagrams
coords :: Point -> Point -> Diagram
coords (a1,a2) (b1,b2) = union
[ (a1,0) ~~ (b1,0)
, (b11,0.5) ~~ (b1,0)
, (b11,0.5) ~~ (b1,0)
, (0.5,b21) ~~ (0,b2)
, (0.5,b21) ~~ (0,b2)
, (0,a2) ~~ (0,b2)
, (1,0.5) ~~ (1,0.5)
]
withCoords :: Point -> Point -> Diagram -> Diagram
withCoords a b d
= clip a b
$ coords a b `stroke` gray
<|> d `stroke` black `strokeWidth` 0.15
displayDiscreteFun
:: (Integral a, Real b)
=> Point
-> Point
-> (a -> b)
-> Diagram
displayDiscreteFun a@(a1,a2) b@(b1,b2) f
= withCoords a b $ union
[ circle 0.1 `move` (fromIntegral x, y)
| x <- [ceiling a1 .. floor b1]
, let y = realToFrac (f x)
, y <= b2 && y >= a2 ]
displayFun
:: (RealFrac a, Real b)
=> Point
-> Point
-> (a -> b)
-> Diagram
displayFun a b f
= displayArc a b (fst a, fst b) $ \t -> (t, f t)
displayArc
:: (Fractional a, Real b, Real c)
=> Point
-> Point
-> (Double, Double)
-> (a -> (b, c))
-> Diagram
displayArc a b (k1,k2) f
= withCoords a b $ joinPoints
[ (realToFrac x, realToFrac y)
| t <- [k10.1, k1.. k2+0.1]
, let (x, y) = f (realToFrac t) ]
joinPoints :: [Point] -> Diagram
joinPoints points = union $ lines ++ dots
where
vectors = zipWith (\(a1,a2) (b1,b2) -> (b1a1, b2a2)) points (drop 1 points)
cont = zipWith f vectors (drop 1 vectors) where
(a1,a2) `f` (b1,b2)
= (a1*b1 + a2*b2) / sqrt ((a1*a1 + a2*a2)*(b1*b1 + b2*b2)) > 0.5
join = zipWith (||) cont (drop 1 cont)
lines = [ e ~~ f | (e, True, f) <- zip3 (drop 1 points) join (drop 2 points) ]
dots = [ circle 0.1 `move` z
| (i, z, j) <- zip3 join (drop 2 points) (drop 1 join)
, not (i && j)
]