diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,34 @@ +## [v1.4](https://github.com/diagrams/diagrams-core/tree/v1.4) (2016-10-26) + +* **New features** + + - New `eachName` traversal, for traversing over parts of a `Name` + that match a given type + + - More documentation explaining `HasOrigin` and `Transformable` + instances for `Envelope` + +* **Dependency/version changes** + + - Allow `lens-4.15` + - Many other upper bounds bumped; see minor release changelogs below. + +* **New instances** + + - `Transformable` instance for `Measured` + + - A bunch more instances for `Query` (`Distributive`, + `Representable`, `Profunctor`, `Coseive`, `Closed`, `Costrong`, + `Corepresentable`) + +* **API changes** + + - Move some `Query`-related functions to `diagrams-lib` (`sample`, + `value`, `resetValue`, `clearValue`) + + - Remove some redundant constraints in type signatures (should not + actually affect API) + ## [v1.3.0.8](https://github.com/diagrams/diagrams-core/tree/v1.3.0.8) (2016-06-05) - allow `base-4.9` @@ -94,7 +125,7 @@ - `Style`'s internal representation now uses a hashmap of the `TypeRep`. - + **Merged pull requests:** - Pre 1.3 [\#82](https://github.com/diagrams/diagrams-core/pull/82) ([cchalmers](https://github.com/cchalmers)) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -4,15 +4,19 @@ Christopher Chalmers Tad Doxsee Conal Elliott + Ben Gamari + Allan Gardner Sam Griffin + Niklas Haas Chris Mears Jeffrey Rosenbluth Carlos Scheidegger + Ryan Scott Vilhelm Sjöberg Michael Sloan Scott Walck Ryan Yates - Brent Yorgey + Brent Yorgey All rights reserved. diff --git a/diagrams-core.cabal b/diagrams-core.cabal --- a/diagrams-core.cabal +++ b/diagrams-core.cabal @@ -1,5 +1,5 @@ Name: diagrams-core -Version: 1.3.0.8 +Version: 1.4 Synopsis: Core libraries for diagrams EDSL Description: The core modules underlying diagrams, an embedded domain-specific language @@ -15,7 +15,7 @@ Cabal-version: >=1.10 Extra-source-files: CHANGELOG.md, README.markdown, diagrams/*.svg extra-doc-files: diagrams/*.svg -Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1 +Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 Source-repository head type: git location: git://github.com/diagrams/diagrams-core.git @@ -42,10 +42,11 @@ semigroups >= 0.8.4 && < 0.19, monoid-extras >= 0.3 && < 0.5, dual-tree >= 0.2 && < 0.3, - lens >= 4.0 && < 4.15, + lens >= 4.0 && < 4.16, linear >= 1.11.3 && < 1.21, adjunctions >= 4.0 && < 5.0, distributive >=0.2.2 && < 1.0, + profunctors >= 5.0 && < 6.0, mtl hs-source-dirs: src diff --git a/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg --- a/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg --- a/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg --- a/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg --- a/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg --- a/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg --- a/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_traceEx.svg b/diagrams/src_Diagrams_Core_Trace_traceEx.svg --- a/diagrams/src_Diagrams_Core_Trace_traceEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_traceEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_tracePEx.svg b/diagrams/src_Diagrams_Core_Trace_tracePEx.svg --- a/diagrams/src_Diagrams_Core_Trace_tracePEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_tracePEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/diagrams/src_Diagrams_Core_Trace_traceVEx.svg b/diagrams/src_Diagrams_Core_Trace_traceVEx.svg --- a/diagrams/src_Diagrams_Core_Trace_traceVEx.svg +++ b/diagrams/src_Diagrams_Core_Trace_traceVEx.svg @@ -1,3 +1,1 @@ - - + diff --git a/src/Diagrams/Core.hs b/src/Diagrams/Core.hs --- a/src/Diagrams/Core.hs +++ b/src/Diagrams/Core.hs @@ -137,6 +137,7 @@ , AName , Name, IsName(..) , Qualifiable(..), (.>) + , eachName -- ** Subdiagram maps @@ -194,8 +195,7 @@ -- * Diagrams , QDiagram, Diagram, mkQD, pointDiagram - , envelope, trace, subMap, names, query, sample - , value, resetValue, clearValue + , envelope, trace, subMap, names, query , nameSub , withName diff --git a/src/Diagrams/Core/Envelope.hs b/src/Diagrams/Core/Envelope.hs --- a/src/Diagrams/Core/Envelope.hs +++ b/src/Diagrams/Core/Envelope.hs @@ -139,19 +139,9 @@ -- 'Monoid' instance. deriving instance Ord n => Monoid (Envelope v n) - --- XXX add some diagrams here to illustrate! Note that Haddock supports --- inline images, using a \<\\> syntax. - type instance V (Envelope v n) = v type instance N (Envelope v n) = n --- | The local origin of an envelope is the point with respect to --- which bounding queries are made, /i.e./ the point from which the --- input vectors are taken to originate. -instance (Metric v, Fractional n) => HasOrigin (Envelope v n) where - moveOriginTo (P u) = onEnvelope $ \f v -> f v - ((u ^/ (v `dot` v)) `dot` v) - instance Show (Envelope v n) where show _ = "" @@ -159,14 +149,97 @@ -- Transforming envelopes -------------------------------- ------------------------------------------------------------ +-- | The local origin of an envelope is the point with respect to +-- which bounding queries are made, /i.e./ the point from which the +-- input vectors are taken to originate. +instance (Metric v, Fractional n) => HasOrigin (Envelope v n) where + moveOriginTo (P u) = onEnvelope $ \oldEnv v -> oldEnv v - ((u ^/ (v `dot` v)) `dot` v) + -- For a detailed explanation of this code, see note + -- [Transforming Envelopes] below. + instance (Metric v, Floating n) => Transformable (Envelope v n) where transform t = moveOriginTo (P . negated . transl $ t) . onEnvelope g where - -- XXX add lots of comments explaining this! + + -- For a detailed explanation of this code, see note + -- [Transforming Envelopes] below. g f v = f v' / (v' `dot` vi) where v' = signorm $ lapp (transp t) v vi = apply (inv t) v + +{- + +Note [Transforming Envelopes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We are given an envelope for some object, and want to apply an affine +transformation, such that the new envelope will be the envelope for +the transformed object. The HasOrigin instance handles the +translational component; the rest of the code in the Transformable +instance handles the linear component. + +See <>. + +To implement moveOriginTo, we need to move the "base point" from which +envelope queries are made. We are given the old envelope @oldEnv@ (a +function from vectors to scalars), a vector @u@ from the old origin to +the new origin, and a query vector @v@ which we imagine to emanate +from the new origin. If we query the old envelope with v, it will +find the correct perpendicular hyperplane, but the reported distance +may be wrong (it will only be correct if the origin was moved in a +direction perpendicular to v). The part that needs to be subtracted +is just the projection of u onto v, which is given by (u.v)/(v.v) *^ +v. In fact envelopes return not a distance or vector, but a scalar +which is taken to be a multiple of the query vector, so the scalar we +need to subtract is just (u.v)/(v.v). + +We now consider how to apply a linear transformation to an envelope. +Recall that an envelope is a function that takes a vector and returns +a scaling factor s such that scaling the vector by s will produce a +vector to the minimum separating hyperplane. (So if given a unit +vector as input, the output will be simply the distance to the minimum +separating hyperplane.) + +We are given a linear transformation t and must produce a new envelope +function. Given an input vector v, the "obvious" thing to do is to +transform v back into the original coordinate system using the inverse +of t, apply the original envelope, and then adjust the resulting +scalar according to how much the transformation scales v. + +However, this does not work, since linear transformations do not +preserve angles. Thus, in particular, given the query vector v and +the perpendicular separating hyperplane H which we wish to find, t^-1 +v and t^-1 H are not necessarily perpendicular anymore. So if we +query the envelope with t^-1 v we will get information about the +distance to some separating hyperplane, which when mapped forward +through t will no longer be perpendicular to v. + +However, it turns out that if v and w are perpendicular, then t^-1 v +will be perpendicular to t^T w, that is, the *transpose* of t (when +considered as a matrix) applied to w. The proof is simple: if vand w +are perpendicular then v . w = v^T w = 0. Thus, + + (t^-1 v) . (t^T w) = (t^-1 v)^T (t^T w) = v^T t^-T t^T w = v^T w = 0. + +Now to explain this code: + + g f v = f v' / (v' `dot` vi) + where + v' = signorm $ lapp (transp t) v + vi = apply (inv t) v + +In our case, our new envelope function (transformed by t) will be +given a query vector v, and we suppose v is perpendicular to the +separating hyperplane H. Instead of querying the old envelope +function f with t^-1 v, we query it with t^T v (after normalizing), +since that vector will be perpendicular to t^-1 H. + +Finally, to scale the resulting value correctly, we divide by (t^T v +. t^-1 v); I forget why. Perhaps I will come back later and complete +this explanation. + +-} ------------------------------------------------------------ -- Enveloped class diff --git a/src/Diagrams/Core/Names.hs b/src/Diagrams/Core/Names.hs --- a/src/Diagrams/Core/Names.hs +++ b/src/Diagrams/Core/Names.hs @@ -25,7 +25,10 @@ , _AName -- ** Names - , Name(..), IsName(..), (.>) + , Name(..) + , IsName(..) + , (.>) + , eachName -- ** Qualifiable , Qualifiable(..) @@ -95,13 +98,13 @@ toName = Name . (:[]) instance Eq AName where - (AName a1) == (AName a2) = + AName a1 == AName a2 = case cast a2 of Nothing -> False Just a2' -> a1 == a2' instance Ord AName where - (AName a1) `compare` (AName a2) = + AName a1 `compare` AName a2 = case cast a2 of Just a2' -> a1 `compare` a2' Nothing -> typeOf a1 `compare` typeOf a2 @@ -123,9 +126,33 @@ type Unwrapped Name = [AName] _Wrapped' = iso (\(Name ns) -> ns) Name +instance Each Name Name AName AName where + each = _Wrapped . traversed + {-# INLINE each #-} + +-- | Traversal over each name in a 'Name' that matches the target type. +-- +-- @ +-- >>> toListOf eachName ('a' .> False .> 'b') :: String +-- "ab" +-- >>> 'a' .> True .> 'b' & eachName %~ not +-- 'a' .> False .> 'b' +-- @ +-- +-- Note that the type of the name is very important. +-- +-- @ +-- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Int +-- 4 +-- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Integer +-- 2 +-- @ +eachName :: (Typeable a, Ord a, Show a) => Traversal' Name a +eachName = each . _AName + instance Show Name where showsPrec d (Name xs) = case xs of - [] -> showParen (d > 10) $ showString "Name []" + [] -> showParen (d > 10) $ showString "toName []" [n] -> showParen (d > 10) $ showString "toName " . showsName 11 n (n:ns) -> showParen (d > 5) $ showsName 6 n . go ns where diff --git a/src/Diagrams/Core/Query.hs b/src/Diagrams/Core/Query.hs --- a/src/Diagrams/Core/Query.hs +++ b/src/Diagrams/Core/Query.hs @@ -20,8 +20,14 @@ ) where import Control.Applicative -import Control.Lens (Rewrapped, Wrapped (..), iso) +import Control.Lens import Data.Semigroup +import Data.Distributive +import Data.Functor.Rep +import Data.Profunctor +import Data.Profunctor.Sieve +import Data.Profunctor.Closed +import qualified Data.Profunctor.Rep as P import Linear.Affine import Linear.Vector @@ -30,19 +36,52 @@ import Diagrams.Core.Transform import Diagrams.Core.V ------------------------------------------------------------- --- Queries ----------------------------------------------- ------------------------------------------------------------- +------------------------------------------------------------------------ +-- Queries +------------------------------------------------------------------------ -- | A query is a function that maps points in a vector space to -- values in some monoid. Queries naturally form a monoid, with -- two queries being combined pointwise. -- -- The idea for annotating diagrams with monoidal queries came from --- the graphics-drawingcombinators package, . +-- the graphics-drawingcombinators package, +-- . newtype Query v n m = Query { runQuery :: Point v n -> m } - deriving (Functor, Applicative, Semigroup, Monoid) + deriving (Functor, Applicative, Monad, Semigroup, Monoid) +instance Distributive (Query v n) where + distribute a = Query $ \p -> fmap (\(Query q) -> q p) a + +instance Representable (Query v n) where + type Rep (Query v n) = Point v n + tabulate = Query + index = runQuery + +instance Functor v => Profunctor (Query v) where + lmap f (Query q) = Query $ \p -> q (fmap f p) + rmap = fmap + +instance Functor v => Cosieve (Query v) (Point v) where + cosieve = runQuery + +instance Functor v => Closed (Query v) where + closed (Query fab) = Query $ \fxa x -> fab (fmap ($ x) fxa) + +instance Functor v => Costrong (Query v) where + unfirst (Query f) = Query f' + where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa) + unsecond (Query f) = Query f' + where f' fa = b where (d, b) = f ((,) d <$> fa) + +instance Functor v => P.Corepresentable (Query v) where + type Corep (Query v) = Point v + cotabulate = Query + +-- | Setter over the input point of a query. +queryPoint :: Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n') +queryPoint = sets $ \f (Query q) -> Query $ q . f + instance Wrapped (Query v n m) where type Unwrapped (Query v n m) = Point v n -> m _Wrapped' = iso runQuery Query @@ -53,7 +92,8 @@ type instance N (Query v n m) = n instance (Additive v, Num n) => HasOrigin (Query v n m) where - moveOriginTo (P u) (Query f) = Query $ \p -> f (p .+^ u) + moveOriginTo (P u) = queryPoint %~ (.+^ u) instance (Additive v, Num n) => Transformable (Query v n m) where - transform t (Query f) = Query $ f . papply (inv t) + transform t = queryPoint %~ papply (inv t) + diff --git a/src/Diagrams/Core/Transform.hs b/src/Diagrams/Core/Transform.hs --- a/src/Diagrams/Core/Transform.hs +++ b/src/Diagrams/Core/Transform.hs @@ -87,6 +87,7 @@ import Data.Functor.Rep import Diagrams.Core.HasOrigin +import Diagrams.Core.Measure import Diagrams.Core.Points () import Diagrams.Core.V @@ -394,6 +395,13 @@ instance (Num (N t), Additive (V t), Transformable t) => Transformable (TransInv t) where transform (Transformation a a' _) (TransInv t) = TransInv (transform (Transformation a a' zero) t) + +instance (InSpace v n t, Transformable t, HasLinearMap v, Floating n) + => Transformable (Measured n t) where + transform t = scaleLocal n . fmap (transform t') + where + t' = t <> scaling (1 / avgScale t) + n = avgScale t ------------------------------------------------------------ -- Generic transformations ------------------------------- diff --git a/src/Diagrams/Core/Types.hs b/src/Diagrams/Core/Types.hs --- a/src/Diagrams/Core/Types.hs +++ b/src/Diagrams/Core/Types.hs @@ -61,8 +61,7 @@ , mkQD, mkQD', pointDiagram -- ** Extracting information - , envelope, trace, subMap, names, query, sample - , value, resetValue, clearValue + , envelope, trace, subMap, names, query -- ** Combining diagrams @@ -450,29 +449,6 @@ -- | Get the query function associated with a diagram. query :: Monoid m => QDiagram b v n m -> Query v n m query = getU' . view _Wrapped' - --- | Sample a diagram's query function at a given point. -sample :: Monoid m => QDiagram b v n m -> Point v n -> m -sample = runQuery . query - --- | Set the query value for 'True' points in a diagram (/i.e./ points --- \"inside\" the diagram); 'False' points will be set to 'mempty'. -value :: Monoid m => m -> QDiagram b v n Any -> QDiagram b v n m -value m = fmap fromAny - where fromAny (Any True) = m - fromAny (Any False) = mempty - --- | Reset the query values of a diagram to @True@/@False@: any values --- equal to 'mempty' are set to 'False'; any other values are set to --- 'True'. -resetValue :: (Eq m, Monoid m) => QDiagram b v n m -> QDiagram b v n Any -resetValue = fmap toAny - where toAny m | m == mempty = Any False - | otherwise = Any True - --- | Set all the query values of a diagram to 'False'. -clearValue :: QDiagram b v n m -> QDiagram b v n Any -clearValue = fmap (const (Any False)) -- | Create a diagram from a single primitive, along with an envelope, -- trace, subdiagram map, and query function.