lp-diagrams 2.1.0 → 2.1.1

raw patch · 5 files changed

+62/−41 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Graphics/Diagrams/Core.hs +12/−9
• Graphics/Diagrams/DerivationTrees.hs +16/−9
• Graphics/Diagrams/Object.hs +16/−8
• Graphics/Diagrams/Plot.hs +17/−14
• lp-diagrams.cabal +1/−1

@@ -2,7 +2,7 @@  module Graphics.Diagrams.Core (   module Graphics.Diagrams.Types,-  Expr, constant, absE, newVars,+  Expr, constant, absE, newVar,   minimize, maximize,   (===), (>==), (<==), (=~=),   Diagram(..), runDiagram,@@ -11,14 +11,14 @@   registerNonOverlap   ) where -import Prelude hiding (sum,mapM_,mapM,concatMap,Num(..),(/),fromRational,recip,(/))+import Prelude hiding (sum,mapM_,mapM,concatMap,Num(..),(/),fromRational,recip,(/),fail) import qualified Prelude-import Control.Monad.RWS hiding (forM,forM_,mapM_,mapM)+import Control.Monad.RWS hiding (forM,forM_,mapM_,mapM,fail)+import Control.Monad.Fail import Algebra.Classes as AC import Data.Map (Map) import qualified Data.Map.Strict as M import Control.Lens hiding (element)-import Data.Traversable import Data.Foldable import System.IO.Unsafe import Graphics.Diagrams.Types@@ -120,6 +120,9 @@ newtype Diagram lab m a = Dia {fromDia :: (RWST (Env lab m) [Freeze m] DiagramState m a)}   deriving (Monad, Applicative, Functor, MonadReader (Env lab m), MonadWriter [Freeze m], MonadState DiagramState) +instance MonadFail m => MonadFail (Diagram lab m) where+  fail msg = Dia (fail msg)+ -- | @freeze x f@ performs @f@ on the frozen value of @x@. freeze :: (Functor t, Monad m) => t Expr -> (t Constant -> m ()) -> Diagram lab m () freeze x f = tell [Freeze (\y -> (f y)) x]@@ -170,9 +173,9 @@ -------------- -- Variables -newVars :: Monad m => [String] -> Diagram lab m [Expr]-newVars kinds = forM kinds $ \name -> do-  v <- rawNewVar name+newVar :: Monad m => String -> Diagram lab m Expr+newVar nm = do+  v <- rawNewVar nm   return $ variable v  where rawNewVar :: Monad m => String -> Diagram lab m Var        rawNewVar name = Dia $ do@@ -198,7 +201,7 @@  satAll :: Monad m => String -> (Expr -> a -> Diagram lab m b) -> [a] -> Diagram lab m Expr satAll name p xs = do-  [m] <- newVars [name]+  m <- newVar name   mapM_ (p m) xs   return m @@ -227,7 +230,7 @@ maximize = minimize . negate minimize f = do   tightness <- view diaTightness-  diaObjective %= \o -> tightness *^ f + o+  diaObjective %= \o -> (tightness *^ f) + o   drawText :: Monad m => Point' Expr -> lab -> Diagram lab m BoxSpec

@@ -71,7 +71,7 @@  derivationTreeDiag :: Monad m => Derivation lab -> Diagram lab m () derivationTreeDiag d = do-  [h] <- newVars ["height"] -- the height of a layer in the tree.+  h <- newVar "height" -- the height of a layer in the tree.   minimize h   h >== constant 1   tree@(T.Node (_,n,_) _) <- toDiagram h d@@ -83,12 +83,12 @@   let leftFringe = map head nonNilLevs       rightFringe = map last nonNilLevs       nonNilLevs = filter (not . null) $ T.levels tree-  [leftMost,rightMost] <- newVars ["leftMost","rightMost"]+  leftMost <- newVar "leftMost"; rightMost <- newVar "rightMost"    forM_ leftFringe $ \(p,_,_) ->     leftMost <== xpart p   forM_ rightFringe $ \(_,_,p) ->     xpart p <== rightMost-  minimize $ 10 *- (rightMost - leftMost)+  tighten 10 $ minimize $ (rightMost - leftMost)   n # Center .=. zero  toDiagPart :: Monad m => Expr -> Premise lab -> Diagram lab m (T.Tree (Point,Object,Point))@@ -130,12 +130,16 @@   D.align xpart [grp # E,last ls # E]   return (grp,avg dxs) +debug :: Monad m => m a -> m ()+debug x = return () +-- debug x = x >> return ()+ -- | Put object in a box of the same vertical extent, and baseline, -- but whose height can be bigger. relaxHeight :: (Monad m) => Object -> Diagram lab m Object relaxHeight o = do   b <- box "relaxed"-  -- using (outline "green")$ traceBounds o+  debug $ traceBox "green" o   D.align xpart [b#W,o#W]   D.align xpart [b#E,o#E]   D.align ypart [b#Base,o#Base]@@ -146,13 +150,15 @@ toDiagram layerHeight (Node Rule{..} premises) = do   ps <- mapM (toDiagPart layerHeight) premises   concl <- relaxHeight =<< extend (constant 1.5) <$> rawLabel "concl" conclusion-  -- using (outline "red")$ traceBounds concl+  debug $ traceBox "red" concl   lab <- rawLabel "rulename" ruleLabel    -- Grouping   (psGrp,premisesDist) <- chainBases (constant 10) [p | T.Node (_,p,_) _ <- ps]-  -- using (outline "blue" . denselyDotted) $ traceBounds psGrp-  height psGrp === layerHeight+  debug $ using denselyDotted $ traceBox "blue" psGrp+  height psGrp === case ps of+                     [] -> zero+                     _ -> layerHeight    -- Separation rule   separ <- hrule "separation"@@ -160,7 +166,7 @@   align ypart [concl # N,separ # S]   minimize $ width separ   psGrp `fitsHorizontallyIn` separ-  concl `fitsHorizontallyIn` separ+  concl `sloppyFitsHorizontallyIn` separ    -- rule label   lab # BaseW .=. separ # E + Point (constant 3) (constant (negate 1))@@ -171,7 +177,8 @@   xd   === xdiff (psGrp # E) (separ # E)   relax 2 $ (2 *- xd) =~= premisesDist   -- centering of conclusion-  relax 3 $ minimize $ orthonorm $ (separ # Center) - (concl # Center)+  (xpart (separ # Center) - xpart (concl # Center)) === zero+  -- minimize (xpart (separ # Center) - xpart (concl # Center)) -- does not produce the expected results with current z3 version    -- draw the rule.   using ruleStyle $ path $ polyline [separ # W,separ # E]

@@ -79,7 +79,7 @@ -- | A free point point :: Monad m => String -> Diagram lab m Object point name = do-  [x,y] <- newVars [(name++".x"),(name++".y")]+  x <- newVar (name++".x"); y <- newVar (name++".y")   return $ Object name EmptyPath (\_ -> Point x y)  -- -- | A free point@@ -89,8 +89,8 @@ -- | A box. Anchors are aligned along a grid. box :: Monad m => String -> Diagram lab m Object box objectName = do-  [n,s,e,w,base,midx,midy] <- newVars $-     (map (\suff -> objectName++"."++suff) ["north","south","east","west","base","midx","midy"])+  let nv suff = newVar (objectName++"."++suff)+  n <- nv "north" ; s <- nv "south"; e <- nv "east"; w <- nv "west"; base <- nv "base"; midx <- nv "midx"; midy <- nv "midy"   n >== base   base >== s   w <== e@@ -134,6 +134,14 @@ ascent o = ypart (o # N - o # Base) descent o = ypart (o # Base - o # S) ++sloppyFitsHorizontallyIn :: Monad m => Object -> Object -> Diagram lab m ()+o `sloppyFitsHorizontallyIn` o' = do+  let dyW = xpart $ o # W - o' # W+      dyE = xpart $ o' # E - o # E+  dyW >== zero+  dyE >== zero+ -- | Make one object fit (snugly) in the other. fitsIn, fitsHorizontallyIn, fitsVerticallyIn   :: (Monad m) => Object -> Object -> Diagram lab m ()@@ -232,8 +240,8 @@ -- vector. autoLabelObj :: Monad m => Box -> OVector -> Diagram lab m () autoLabelObj lab (OVector pt v) = do-  let normalVector :: Point' Expr-      normalVector = v+  -- let normalVector :: Point' Expr+  --     normalVector = v   -- label must touch the point   tighten 10 $ pt `insideBox` lab   minimize (orthonorm (pt+v- lab#Center))@@ -261,11 +269,11 @@ nodeDistance :: Expr nodeDistance = constant 5 -leftOf :: Monad m => Object -> Object -> Diagram lab m ()-a `leftOf` b = spread hdist nodeDistance [a,b]+leftOf, topOf, rightOf :: Monad m => Object -> Object -> Diagram lab m () -topOf :: Monad m => Object -> Object -> Diagram lab m ()+a `leftOf` b = spread hdist nodeDistance [a,b] a `topOf` b =  spread vdist nodeDistance [b,a]+rightOf = flip leftOf  -- | Spread a number of objects by *minimum* a given distance. example: @spread -- hdist 30 ps@

@@ -5,7 +5,7 @@ import Graphics.Diagrams.Path import Graphics.Diagrams.Object import Graphics.Diagrams.Point-import Control.Monad (forM_,when)+import Control.Monad (forM_,forM,when) import Algebra.Classes import Prelude hiding (Num(..),(/)) @@ -15,16 +15,18 @@ -- | Generic axis rendering. @axisGen origin target anchor labels@ -- traces an axis from origin to target, attaching the labels at -- anchor.-axisGen :: Monad m => Point -> Point -> Anchor -> [(Constant,lab)] -> Diagram lab m ()+axisGen :: Monad m => Point -> Point -> Anchor -> [(Constant,lab)] -> Diagram lab m [Box] axisGen origin target anch labels = do   draw {- using (set endTip ToTip) -} $ path $ polyline [origin,target]-  when (not $ null $ labels) $ do-    forM_ labels $ \(p,txt) -> do+  if null labels+    then return []+    else forM labels $ \(p,txt) -> do       l0 <- label "axis" txt       let l = extend (constant 3) l0       draw $ path $ polyline [l0 # anch, l # anch]       l # anch .=. Point (lint p (xpart origin) (xpart target))                          (lint p (ypart origin) (ypart target))+      return l0  -- | @scale minx maxx@ maps the interval [minx,maxx] to [0,1] scale :: forall b. Field b => b -> b -> Iso b b@@ -36,26 +38,26 @@ mkSteps tx showFct xs = zip (map (forward tx) xs) (map showFct xs)  -- | render an horizontal axis on the given box-hAxis :: Monad m => Box -> [(Constant, lab)] -> Diagram lab m ()+hAxis :: Monad m => Box -> [(Constant, lab)] -> Diagram lab m [Box] hAxis bx = axisGen (bx # SW) (bx # SE) N  -- | render a vertical axis on the given box-vAxis :: Monad m => Box -> [(Constant, lab)] -> Diagram lab m ()+vAxis :: Monad m => Box -> [(Constant, lab)] -> Diagram lab m [Box] vAxis bx = axisGen (bx # SW) (bx # NW) E  -- | Draw axes. Coordinates in the [0,1] fit the box.-axes :: Monad m => Box -> Vec2 [(Constant, lab)] -> Diagram lab m ()-axes bx zs = d1 >> d2+axes :: Monad m => Box -> Vec2 [(Constant, lab)] -> Diagram lab m [Box]+axes bx zs = (++) <$> d1 <*> d2   where Point d1 d2 = (Point hAxis vAxis) <*> pure bx <*> zs --- | Multiply the vector (origin --> target) by p.+-- | Multiply the vector (origin --> target) by p. (Linear interpolation) lint :: Constant -> Expr -> Expr -> Expr lint p origin target = (p*-(target-origin)) + origin  -- | Draw a scatterplot in the given box. -- Input data in the [0,1] interval fits the box. scatterPlot :: Monad m => PlotCanvas a -> [Vec2 a] -> Diagram lab m ()-scatterPlot (bx,xform) input = forM_ (map (forward <$> xform <*>) input) $ \z -> do+scatterPlot (bx,_outerBox,xform) input = forM_ (map (forward <$> xform <*>) input) $ \z -> do   pt <- using (fill "black") $ circle "plotMark"   width pt === constant 3   pt # Center .=. interpBox bx z@@ -67,7 +69,7 @@ -- Plot the function @f@ on the canvas @c@, using @n@ steps (precision).  functionPlot :: Monad m => Show a => PlotCanvas a -> Int -> (a -> a) -> Diagram lab m ()-functionPlot (bx,Point tx ty) nsteps f = draw $ path $ polyline points+functionPlot (bx,_outerBox,Point tx ty) nsteps f = draw $ path $ polyline points   where points = do            step <- [0..nsteps]            let xi :: Double@@ -110,13 +112,14 @@         mrks (_,x,_) = x         hi (_,_,x) = x -type PlotCanvas a = (Box, Vec2 (Transform a))+type PlotCanvas a = (Box, Box, Vec2 (Transform a))  preparePlot :: Monad m => Vec2 (ShowFct lab a) -> Vec2 (Transform a) -> Vec2 a -> Vec2 a -> Diagram lab m (PlotCanvas a) preparePlot showFct axesXform lo hi = do   bx <- box "plotFrame"-  axes bx marks-  return (bx,xform)+  labelBoxes <- axes bx marks+  outerbox <- boundingBox (bx:labelBoxes)+  return (bx,outerbox,xform)   where marks = mkSteps <$> xform <*> showFct <*> marks0         (marks0,xform) = mkAxes axesXform lo hi 

@@ -1,5 +1,5 @@ name:                lp-diagrams-version:             2.1.0+version:             2.1.1 synopsis:            An EDSL for diagrams based based on linear constraints license:             AGPL-3 license-file:        LICENSE