diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,21 @@ Changelog ========= +Version 0.1.1.0 +--------------- + +*Feb 6, 2018* + + + +* Added canonical strict tuple types with `Num` instances, in the module + *Numeric.Backprop.Tuple*. This is meant to be a band-aid for the problem + of orphan instances and potential mismatched tuple types. +* Fixed bug in `collectVar` that occurs if container sizes change +* Internal tweaks to the underlying automatic differentiation types that + decouple backpropagation from `Num`, internally. `Num` is now just used + externally as a part of the API, which might someday be made optional. + Version 0.1.0.0 --------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -272,12 +272,19 @@ addition, it's often useful to have anonymous products and tuples in general. - However, this can be resolved by using the orphan instances in the + This is bandaided-over by having *backprop* provide canonical + tuple-with-`Num` types for different libraries to use, but it's not a + perfect solution. + + This can be resolved by using the orphan instances in the *[NumInstances][]* package. Still, there might be some headache for application developers if different libraries using *backprop* accidentally pull in their orphan instances from different places. [NumInstances]: https://hackage.haskell.org/package/NumInstances + + Alternatively, one day we can get `Num` instances for tuples into + *base*! The extra complexity that would come from adding a custom typeclass just for `+` / `0` / `1`, though, I feel, might not be worth the benefit. The diff --git a/backprop.cabal b/backprop.cabal --- a/backprop.cabal +++ b/backprop.cabal @@ -2,14 +2,17 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 78d9facc552fa43f3b324fa4ffe1c526e33e67c5cf55fdde75b05f60f81e423c +-- hash: 910fed99cfe32b65c18c047c45e8694c914a2eb4f7bdceec90d9ab4e3eba535c name: backprop -version: 0.1.0.0 -synopsis: Heterogeneous automatic backpropagation in Haskell +version: 0.1.1.0 +synopsis: Heterogeneous automatic differentation (backpropagation) description: Write your functions to compute your result, and the library will automatically generate functions to compute your gradient. . + Implements heterogeneous reverse-mode automatic differentiation, commonly + known as "backpropagation". + . See category: Math homepage: https://github.com/mstksg/backprop#readme @@ -53,6 +56,7 @@ exposed-modules: Numeric.Backprop Numeric.Backprop.Op + Numeric.Backprop.Tuple other-modules: Numeric.Backprop.Internal Data.Type.Util diff --git a/renders/backprop-mnist.md b/renders/backprop-mnist.md --- a/renders/backprop-mnist.md +++ b/renders/backprop-mnist.md @@ -25,16 +25,14 @@ [rendered pdf version is available on github.]: https://github.com/mstksg/backprop/blob/master/renders/backprop-mnist.pdf [literate haskell version that you can run]: https://github.com/mstksg/backprop/blob/master/samples/backprop-mnist.lhs -The packages involved are: +The (extra) packages involved are: -- deepseq - hmatrix - lens - mnist-idx - mwc-random - one-liner-instances - split -- vector ``` {.sourceCode .literate .haskell} {-# LANGUAGE BangPatterns #-} diff --git a/renders/backprop-mnist.pdf b/renders/backprop-mnist.pdf Binary files a/renders/backprop-mnist.pdf and b/renders/backprop-mnist.pdf differ diff --git a/renders/extensible-neural.md b/renders/extensible-neural.md --- a/renders/extensible-neural.md +++ b/renders/extensible-neural.md @@ -13,9 +13,8 @@ [literate haskell file]: https://github.com/mstksg/backprop/blob/master/samples/extensible-neural.lhs [rendered as a pdf]: https://github.com/mstksg/backprop/blob/master/renders/extensible-neural.pdf -The packages involved are: +The (extra) packages involved are: -- deepseq - hmatrix - lens - mnist-idx @@ -23,7 +22,6 @@ - one-liner-instances - singletons - split -- vector ``` {.sourceCode .literate .haskell} {-# LANGUAGE BangPatterns #-} @@ -126,9 +124,10 @@ ``` Unfortunately, we can't automatically generate lenses for GADTs, so we -have to make them by hand.\[\^poly\] +have to make them by hand.[^1] -with type safety via paraemtric polymorphism. +[^1]: We write them originally as a polymorphic lens family to help us + with type safety via paraemtric polymorphism. ``` {.sourceCode .literate .haskell} _NO :: Lens (Net i '[] o) (Net i' '[] o') @@ -192,7 +191,7 @@ -> BVar s (R o) runNetwork n = \case SNil -> softMax . runLayer (n ^^. _NO) - SCons SNat hs -> withSingI hs (runNetwork (n ^^. _NIN) hs) + SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs . logistic . runLayer (n ^^. _NIL) {-# INLINE runNetwork #-} diff --git a/renders/extensible-neural.pdf b/renders/extensible-neural.pdf Binary files a/renders/extensible-neural.pdf and b/renders/extensible-neural.pdf differ diff --git a/samples/backprop-mnist.lhs b/samples/backprop-mnist.lhs --- a/samples/backprop-mnist.lhs +++ b/samples/backprop-mnist.lhs @@ -22,16 +22,14 @@ [rendered]: https://github.com/mstksg/backprop/blob/master/renders/backprop-mnist.pdf [lhs]: https://github.com/mstksg/backprop/blob/master/samples/backprop-mnist.lhs -The packages involved are: +The (extra) packages involved are: -* deepseq * hmatrix * lens * mnist-idx * mwc-random * one-liner-instances * split -* vector > {-# LANGUAGE BangPatterns #-} > {-# LANGUAGE DataKinds #-} diff --git a/samples/extensible-neural.lhs b/samples/extensible-neural.lhs --- a/samples/extensible-neural.lhs +++ b/samples/extensible-neural.lhs @@ -11,9 +11,8 @@ [rendered]: https://github.com/mstksg/backprop/blob/master/renders/extensible-neural.pdf [lhs]: https://github.com/mstksg/backprop/blob/master/samples/extensible-neural.lhs -The packages involved are: +The (extra) packages involved are: -* deepseq * hmatrix * lens * mnist-idx @@ -21,7 +20,6 @@ * one-liner-instances * singletons * split -* vector > {-# LANGUAGE BangPatterns #-} > {-# LANGUAGE DataKinds #-} @@ -122,7 +120,7 @@ Unfortunately, we can't automatically generate lenses for GADTs, so we have to make them by hand.[^poly] -[poly]: We write them originally as a polymorphic lens family to help us +[^poly]: We write them originally as a polymorphic lens family to help us with type safety via paraemtric polymorphism. > _NO :: Lens (Net i '[] o) (Net i' '[] o') @@ -182,7 +180,7 @@ > -> BVar s (R o) > runNetwork n = \case > SNil -> softMax . runLayer (n ^^. _NO) -> SCons SNat hs -> withSingI hs (runNetwork (n ^^. _NIN) hs) +> SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs > . logistic > . runLayer (n ^^. _NIL) > {-# INLINE runNetwork #-} diff --git a/src/Data/Type/Util.hs b/src/Data/Type/Util.hs --- a/src/Data/Type/Util.hs +++ b/src/Data/Type/Util.hs @@ -15,7 +15,7 @@ , vecLen , prodToVec' , lengthProd - , listToVec + , listToVecDef , fillProd ) where @@ -25,6 +25,7 @@ import Data.Type.Nat import Data.Type.Product import Data.Type.Vector +import Type.Class.Witness import Type.Family.Nat -- | @'Replicate' n a@ is a list of @a@s repeated @n@ times. @@ -103,15 +104,20 @@ LZ -> Ø LS l -> x :< lengthProd x l -listToVec - :: Nat n +listToVecDef + :: forall f a n. () + => f a + -> Nat n -> [f a] - -> Maybe (VecT n f a) -listToVec = \case - Z_ -> \_ -> Just ØV - S_ n -> \case - [] -> Nothing - x:xs -> (x :*) <$> listToVec n xs + -> VecT n f a +listToVecDef d = go + where + go :: Nat m -> [f a] -> VecT m f a + go = \case + Z_ -> const ØV + S_ n -> \case + [] -> d :* vrep d \\ n + x:xs -> x :* go n xs fillProd :: forall f g as c. () diff --git a/src/Numeric/Backprop.hs b/src/Numeric/Backprop.hs --- a/src/Numeric/Backprop.hs +++ b/src/Numeric/Backprop.hs @@ -156,10 +156,15 @@ -- See the for a more detailed -- discussion on this issue. -- --- If you need a 'Num' instance for tuples, consider the +-- If you need a 'Num' instance for tuples, you can use the canonical 2- +-- and 3-tuples for the library in "Numeric.Backprop.Tuple". If you need +-- one for larger tuples, consider making a custom product type instead +-- (making Num instances with something like +-- ). +-- You can also use the orphan instances in the -- package --- (in particular, "Data.NumInstances.Tuple"), or else using a named --- product type instead. +-- (in particular, "Data.NumInstances.Tuple") if you are writing an +-- application and do not have to worry about orphan instances. backprop :: forall a b. (Num a, Num b) => (forall s. Reifies s W => BVar s a -> BVar s b) @@ -219,11 +224,8 @@ -- | 'backprop' for a two-argument function. -- -- Not strictly necessary, because you can always uncurry a function by --- putting the arguments inside a data type, or using a tuple with --- . --- However, this can be convenient if you don't want to make a custom tuple --- type or pull in orphan instances. This could potentially also be more --- performant. +-- passing in all of the argument inside a data type, or use 'T2'. However, +-- this could potentially be more performant. -- -- For 3 and more arguments, consider using 'backpropN'. backprop2 @@ -352,10 +354,19 @@ -- -- Note that many automatically-generated prisms by the /lens/ package use -- tuples, which cannot normally be backpropagated (because they do not --- have a 'Num' instance). However, you can pull in orphan instances from --- , or also --- chain those prisms with functions to convert tuples to your own custom --- product types (or tuple types with 'Num' instances). +-- have a 'Num' instance). +-- +-- If you are writing an application or don't have to worry about orphan +-- instances, you can pull in the orphan instances from +-- . +-- Alternatively, you can chain those prisms with conversions to the +-- anonymous canonical strict tuple types in "Numeric.Backprop.Tuple", +-- which do have 'Num' instances. +-- +-- @ +-- myPrism :: 'Prism'' c (a, b) +-- myPrism . 'iso' 'tupT2' 't2Tup' :: 'Prism'' c ('T2' a b) +-- @ (^^?) :: forall b a s. (Num a, Reifies s W) => BVar s b diff --git a/src/Numeric/Backprop/Internal.hs b/src/Numeric/Backprop/Internal.hs --- a/src/Numeric/Backprop/Internal.hs +++ b/src/Numeric/Backprop/Internal.hs @@ -50,9 +50,9 @@ import Data.Proxy import Data.Reflection import Data.Type.Index -import Data.Type.Product hiding (toList) +import Data.Type.Product hiding (toList) import Data.Type.Util -import Data.Type.Vector hiding (itraverse, head') +import Data.Type.Vector hiding (itraverse) import GHC.Generics import Lens.Micro import Numeric.Backprop.Op @@ -60,8 +60,8 @@ import Type.Class.Higher import Type.Class.Witness import Unsafe.Coerce -import qualified Data.Vector as V -import qualified Data.Vector.Mutable as MV +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV -- | A @'BVar' s a@ is a value of type @a@ that can be "backpropagated". -- @@ -128,14 +128,14 @@ {-# INLINE forceBVar #-} data InpRef :: Type -> Type where - IR :: Num a - => { _irIx :: !(BVar s b) + IR :: { _irIx :: !(BVar s b) , _irUpd :: !(Lens' b a) + , _irAdd :: !(a -> a -> a) } -> InpRef a forceInpRef :: InpRef a -> () -forceInpRef (IR !v !_) = forceBVar v `seq` () +forceInpRef (IR !v !_ !_) = forceBVar v `seq` () {-# INLINE forceInpRef #-} -- | Debugging string for an 'InpRef'. @@ -182,7 +182,7 @@ -> a -> W -> IO (BVar s a) -insertNode !tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!(!n,!t)) -> +insertNode !tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) -> let n' = n + 1 t' = STN tn:t in forceTapeNode tn `seq` n' `seq` t' `seq` ((n', t'), n) @@ -210,7 +210,7 @@ , _tnGrad = g } go :: forall a. Index as a -> BVar s a -> InpRef a - go i !v = forceBVar v `seq` (IR v id \\ every @_ @Num i) + go i !v = forceBVar v `seq` (IR v id (+) \\ every @_ @Num i) {-# INLINE liftOp_ #-} -- | Lift an 'Op' with an arbitrary number of inputs to a function on the @@ -239,7 +239,7 @@ liftOp1_ o !v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s)) where (y,g) = runOpWith o (_bvVal v ::< Ø) - tn = TN { _tnInputs = IR v id :< Ø + tn = TN { _tnInputs = IR v id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp1_ #-} @@ -271,7 +271,7 @@ `seq` insertNode tn y (reflect (Proxy @s)) where (y,g) = runOpWith o (_bvVal v ::< _bvVal u ::< Ø) - tn = TN { _tnInputs = IR v id :< IR u id :< Ø + tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp2_ #-} @@ -307,7 +307,7 @@ `seq` insertNode tn y (reflect (Proxy @s)) where (y, g) = runOpWith o (_bvVal v ::< _bvVal u ::< _bvVal w ::< Ø) - tn = TN { _tnInputs = IR v id :< IR u id :< IR w id :< Ø + tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< IR w id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp3_ #-} @@ -337,7 +337,7 @@ viewVar_ l !v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s)) where y = _bvVal v ^. l - tn = TN { _tnInputs = IR v l :< Ø + tn = TN { _tnInputs = IR v l (+) :< Ø , _tnGrad = only_ } {-# INLINE viewVar_ #-} @@ -365,7 +365,7 @@ `seq` insertNode tn y (reflect (Proxy @s)) where y = _bvVal v & l .~ _bvVal w - tn = TN { _tnInputs = IR w id :< IR v id :< Ø + tn = TN { _tnInputs = IR w id (+) :< IR v id (+) :< Ø , _tnGrad = \d -> let (dw,dv) = l (,0) d in dw ::< dv ::< Ø } @@ -399,9 +399,9 @@ -> IO (BVar s (t a)) collectVar_ !vs = withV (toList vs) $ \(vVec :: Vec n (BVar s a)) -> do let tn :: TapeNode (t a) - tn = TN { _tnInputs = vecToProd (vmap ((`IR` id) . getI) vVec) - , _tnGrad = maybe (error "distributeVar") vecToProd - . listToVec (vecLen vVec) + tn = TN { _tnInputs = vecToProd (vmap ((\v -> IR v id (+)) . getI) vVec) + , _tnGrad = vecToProd + . listToVecDef 0 (vecLen vVec) . map I . toList } traverse_ (evaluate . forceBVar) vs @@ -429,7 +429,7 @@ go :: Int -> a -> IO (BVar s a) go i y = insertNode tn y (reflect (Proxy @s)) where - tn = TN { _tnInputs = IR v (ixt t i) :< Ø + tn = TN { _tnInputs = IR v (ixt t i) (+) :< Ø , _tnGrad = only_ } {-# INLINE traverseVar' #-} @@ -460,14 +460,8 @@ toListOfVar t !v = unsafePerformIO $ traverseVar' (toListOf t) t v {-# INLINE toListOfVar #-} -data SomeNum :: Type where - SN :: Num a - => Proxy a - -> a - -> SomeNum - -data Runner s = R { _rDelta :: MV.MVector s SomeNum - , _rInputs :: MV.MVector s SomeNum +data Runner s = R { _rDelta :: MV.MVector s (Some I) + , _rInputs :: MV.MVector s (Some I) } initRunner @@ -477,11 +471,11 @@ -> m (Runner s) initRunner (n, stns) (nx,xs) = do delts <- MV.new n - for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) -> do - MV.write delts i $ SN (Proxy @c) 0 + for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) -> + MV.write delts i $ Some @_ @_ @c (I 0) inps <- MV.new nx - for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) -> do - MV.write inps i $ SN (Proxy @c) 0 + for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) -> + MV.write inps i $ Some @_ @_ @c (I 0) return $ R delts inps {-# INLINE initRunner #-} @@ -493,22 +487,22 @@ -> m () gradRunner _ R{..} (n,stns) = do when (n > 0) $ - MV.write _rDelta (n - 1) (SN (Proxy @b) 1) + MV.write _rDelta (n - 1) (Some @_ @_ @b (I 1)) zipWithM_ go [n-1,n-2..] stns where go :: Int -> SomeTapeNode -> m () go i (STN TN{..}) = do - SN _ delt <- MV.read _rDelta i + Some (I delt) <- MV.read _rDelta i let gs = _tnGrad (unsafeCoerce delt) zipWithPM_ propagate _tnInputs gs propagate :: forall x. InpRef x -> I x -> m () - propagate (IR v ln) (I !d) = case _bvRef v of + propagate (IR v ln (+*)) (I !d) = case _bvRef v of BRInp !i -> flip (MV.modify _rInputs) i $ \case - SN p !y -> let y' = unsafeCoerce y & ln %~ (+d) - in y' `seq` SN p (unsafeCoerce y') + Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d) + in y' `seq` Some (I y') BRIx !i -> flip (MV.modify _rDelta) i $ \case - SN p !y -> let y' = unsafeCoerce y & ln %~ (+d) - in y' `seq` SN p (unsafeCoerce y') + Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d) + in y' `seq` Some (I y') BRC -> return () {-# INLINE gradRunner #-} @@ -517,11 +511,12 @@ -- -- Not strictly necessary, because you can always uncurry a function by -- passing in all of the inputs in a data type containing all of the --- arguments. You could also pass in a giant tuple with +-- arguments or a tuple from "Numeric.Backprop.Tuple". You could also +-- pass in a giant tuple with -- . --- However, this can be convenient if you don't want to make a custom tuple --- type or pull in orphan instances. This could potentially also be more --- performant. +-- However, this can be convenient if you don't want to make a custom +-- larger tuple type or pull in orphan instances. This could potentially +-- also be more performant. -- -- A @'Prod' ('BVar' s) '[Double, Float, Double]@, for instance, is a tuple -- of @'BVar' s 'Double'@, @'BVar' s 'Float'@, and @'BVar' s 'Double'@, and @@ -552,7 +547,7 @@ gradRunner (Proxy @b) r tp delts <- toList <$> V.freeze (_rInputs r) return . fromMaybe (error "backpropN") $ - fillProd (\_ (SN _ d) -> I (unsafeCoerce d)) xs delts + fillProd (\_ (Some (I d)) -> I (unsafeCoerce d)) xs delts where go :: forall a. Index as a -> I a -> (Sum Int, [Some (Wit1 Num)]) go i (I _) = (1, [Some (Wit1 :: Wit1 Num a)]) \\ every @_ @Num i diff --git a/src/Numeric/Backprop/Tuple.hs b/src/Numeric/Backprop/Tuple.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/Backprop/Tuple.hs @@ -0,0 +1,261 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +-- | +-- Module : Numeric.Backprop.Tuple +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- Canonical strict tuples with 'Num' instances for usage with /backprop/. +-- This is here to solve the problem of orphan instances in libraries and +-- potential mismatched tuple types. +-- +-- If you are writing a library that needs to export 'BVar's of tuples, +-- consider using the tuples in this module so that your library can have +-- easy interoperability with other libraries using /backprop/. +-- +-- Because of API decisions, 'backprop' and 'gradBP' only work with things +-- with 'Num' instances. However, this disallows default 'Prelude' tuples +-- (without orphan instances from packages like +-- ). +-- +-- Until tuples have 'Num' instances in /base/, this module is intended to +-- be a workaround for situations where: +-- +-- This comes up often in cases where: +-- +-- (1) A function wants to return more than one value (@'BVar' s ('T2' +-- a b)@ +-- (2) You want to uncurry a 'BVar' function to use with 'backprop' and +-- 'gradBP'. +-- (3) You want to use the useful 'Prism's automatically generated by +-- the lens library, which use tuples for multiple-constructor fields. +-- +-- Only 2-tuples and 3-tuples are provided. Any more and you should +-- probably be using your own custom product types, with instances +-- automatically generated from something like +-- . +-- +-- Lenses into the fields are provided, but they also work with '_1', '_2', +-- and '_3' from "Lens.Micro". However, note that these are incompatible +-- with '_1', '_2', and '_3' from "Control.Lens". +-- +-- @since 0.1.1.0 +-- + + +module Numeric.Backprop.Tuple ( + -- * Two-tuples + T2(..) + -- ** Conversions + -- $t2iso + , t2Tup, tupT2 + -- ** Lenses + , t2_1, t2_2 + -- * Three-tuples + , T3(..) + -- ** Conversions + -- $t3iso + , t3Tup, tupT3 + -- ** Lenses + , t3_1, t3_2, t3_3 + ) where + +import Control.DeepSeq +import Data.Bifunctor +import Data.Data +import Data.Semigroup +import GHC.Generics (Generic) +import Lens.Micro +import Lens.Micro.Internal + +-- | Strict 2-tuple with a 'Num' instance. +-- +-- @since 0.1.1.0 +data T2 a b = T2 !a !b + deriving (Show, Read, Eq, Ord, Generic, Functor, Data) + +-- | Strict 3-tuple with a 'Num' instance. +-- +-- @since 0.1.1.0 +data T3 a b c = T3 !a !b !c + deriving (Show, Read, Eq, Ord, Generic, Functor, Data) + +instance (NFData a, NFData b) => NFData (T2 a b) +instance (NFData a, NFData b, NFData c) => NFData (T3 a b c) + +instance Bifunctor T2 where + bimap f g (T2 x y) = T2 (f x) (g y) + +instance Bifunctor (T3 a) where + bimap f g (T3 x y z) = T3 x (f y) (g z) + +-- | Convert to a Haskell tuple. +-- +-- Forms an isomorphism with 'tupT2'. +-- @since 0.1.1.0 +t2Tup :: T2 a b -> (a, b) +t2Tup (T2 x y) = (x, y) + +-- | Convert from Haskell tuple. +-- +-- Forms an isomorphism with 't2Tup'. +-- +-- @since 0.1.1.0 +tupT2 :: (a, b) -> T2 a b +tupT2 (x, y) = T2 x y + +-- | Convert to a Haskell tuple. +-- +-- Forms an isomorphism with 'tupT3'. +t3Tup :: T3 a b c -> (a, b, c) +t3Tup (T3 x y z) = (x, y, z) + +-- | Convert from Haskell tuple. +-- +-- Forms an isomorphism with 't3Tup'. +tupT3 :: (a, b, c) -> T3 a b c +tupT3 (x, y, z) = T3 x y z + +instance Field1 (T2 a b) (T2 a' b) a a' where + _1 f (T2 x y) = (`T2` y) <$> f x + +instance Field2 (T2 a b) (T2 a b') b b' where + _2 f (T2 x y) = T2 x <$> f y + +instance Field1 (T3 a b c) (T3 a' b c) a a' where + _1 f (T3 x y z) = (\x' -> T3 x' y z) <$> f x + +instance Field2 (T3 a b c) (T3 a b' c) b b' where + _2 f (T3 x y z) = (\y' -> T3 x y' z) <$> f y + +instance Field3 (T3 a b c) (T3 a b c') c c' where + _3 f (T3 x y z) = T3 x y <$> f z + +-- | Lens into the first field of a 'T2'. Also exported as '_1' from +-- "Lens.Micro". +t2_1 :: Lens (T2 a b) (T2 a' b) a a' +t2_1 = _1 + +-- | Lens into the second field of a 'T2'. Also exported as '_2' from +-- "Lens.Micro". +t2_2 :: Lens (T2 a b) (T2 a b') b b' +t2_2 = _2 + +-- | Lens into the first field of a 'T3'. Also exported as '_1' from +-- "Lens.Micro". +t3_1 :: Lens (T3 a b c) (T3 a' b c) a a' +t3_1 = _1 + +-- | Lens into the second field of a 'T3'. Also exported as '_2' from +-- "Lens.Micro". +t3_2 :: Lens (T3 a b c) (T3 a b' c) b b' +t3_2 = _2 + +-- | Lens into the third field of a 'T3'. Also exported as '_3' from +-- "Lens.Micro". +t3_3 :: Lens (T3 a b c) (T3 a b c') c c' +t3_3 = _3 + +instance (Num a, Num b) => Num (T2 a b) where + T2 x1 y1 + T2 x2 y2 = T2 (x1 + x2) (y1 + y2) + T2 x1 y1 - T2 x2 y2 = T2 (x1 - x2) (y1 - y2) + T2 x1 y1 * T2 x2 y2 = T2 (x1 * x2) (y1 * y2) + negate (T2 x y) = T2 (negate x) (negate y) + abs (T2 x y) = T2 (abs x) (abs y) + signum (T2 x y) = T2 (signum x) (signum y) + fromInteger x = T2 (fromInteger x) (fromInteger x) + +instance (Fractional a, Fractional b) => Fractional (T2 a b) where + T2 x1 y1 / T2 x2 y2 = T2 (x1 / x2) (y1 / y2) + recip (T2 x y) = T2 (recip x) (recip y) + fromRational x = T2 (fromRational x) (fromRational x) + +instance (Floating a, Floating b) => Floating (T2 a b) where + pi = T2 pi pi + T2 x1 y1 ** T2 x2 y2 = T2 (x1 ** x2) (y1 ** y2) + logBase (T2 x1 y1) (T2 x2 y2) = T2 (logBase x1 x2) (logBase y1 y2) + exp (T2 x y) = T2 (exp x) (exp y) + log (T2 x y) = T2 (log x) (log y) + sqrt (T2 x y) = T2 (sqrt x) (sqrt y) + sin (T2 x y) = T2 (sin x) (sin y) + cos (T2 x y) = T2 (cos x) (cos y) + asin (T2 x y) = T2 (asin x) (asin y) + acos (T2 x y) = T2 (acos x) (acos y) + atan (T2 x y) = T2 (atan x) (atan y) + sinh (T2 x y) = T2 (sinh x) (sinh y) + cosh (T2 x y) = T2 (cosh x) (cosh y) + asinh (T2 x y) = T2 (asinh x) (asinh y) + acosh (T2 x y) = T2 (acosh x) (acosh y) + atanh (T2 x y) = T2 (atanh x) (atanh y) + +instance (Semigroup a, Semigroup b) => Semigroup (T2 a b) where + T2 x1 y1 <> T2 x2 y2 = T2 (x1 <> x2) (y1 <> y2) + +instance (Monoid a, Monoid b) => Monoid (T2 a b) where + mappend (T2 x1 y1) (T2 x2 y2) = T2 (mappend x1 x2) (mappend y1 y2) + mempty = T2 mempty mempty + +instance (Num a, Num b, Num c) => Num (T3 a b c) where + T3 x1 y1 z1 + T3 x2 y2 z2 = T3 (x1 + x2) (y1 + y2) (z1 + z2) + T3 x1 y1 z1 - T3 x2 y2 z2 = T3 (x1 - x2) (y1 - y2) (z1 + z2) + T3 x1 y1 z1 * T3 x2 y2 z2 = T3 (x1 * x2) (y1 * y2) (z1 + z2) + negate (T3 x y z) = T3 (negate x) (negate y) (negate z) + abs (T3 x y z) = T3 (abs x) (abs y) (abs z) + signum (T3 x y z) = T3 (signum x) (signum y) (signum z) + fromInteger x = T3 (fromInteger x) (fromInteger x) (fromInteger x) + +instance (Fractional a, Fractional b, Fractional c) => Fractional (T3 a b c) where + T3 x1 y1 z1 / T3 x2 y2 z2 = T3 (x1 / x2) (y1 / y2) (z1 / z2) + recip (T3 x y z) = T3 (recip x) (recip y) (recip z) + fromRational x = T3 (fromRational x) (fromRational x) (fromRational x) + +instance (Floating a, Floating b, Floating c) => Floating (T3 a b c) where + pi = T3 pi pi pi + T3 x1 y1 z1 ** T3 x2 y2 z2 = T3 (x1 ** x2) (y1 ** y2) (z1 ** z2) + logBase (T3 x1 y1 z1) (T3 x2 y2 z2) = T3 (logBase x1 x2) (logBase y1 y2) (logBase z1 z2) + exp (T3 x y z) = T3 (exp x) (exp y) (exp z) + log (T3 x y z) = T3 (log x) (log y) (log z) + sqrt (T3 x y z) = T3 (sqrt x) (sqrt y) (sqrt z) + sin (T3 x y z) = T3 (sin x) (sin y) (sin z) + cos (T3 x y z) = T3 (cos x) (cos y) (cos z) + asin (T3 x y z) = T3 (asin x) (asin y) (asin z) + acos (T3 x y z) = T3 (acos x) (acos y) (acos z) + atan (T3 x y z) = T3 (atan x) (atan y) (atan z) + sinh (T3 x y z) = T3 (sinh x) (sinh y) (sinh z) + cosh (T3 x y z) = T3 (cosh x) (cosh y) (cosh z) + asinh (T3 x y z) = T3 (asinh x) (asinh y) (asinh z) + acosh (T3 x y z) = T3 (acosh x) (acosh y) (acosh z) + atanh (T3 x y z) = T3 (atanh x) (atanh y) (atanh z) + +instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (T3 a b c) where + T3 x1 y1 z1 <> T3 x2 y2 z2 = T3 (x1 <> x2) (y1 <> y2) (z1 <> z2) + +instance (Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where + mappend (T3 x1 y1 z1) (T3 x2 y2 z2) = T3 (mappend x1 x2) (mappend y1 y2) (mappend z1 z2) + mempty = T3 mempty mempty mempty + +-- $t2iso +-- +-- If using /lens/, the two conversion functions can be chained with prisms +-- and traversals and other optics using: +-- +-- @ +-- 'iso' 'tupT2' 't2Tup' :: 'Iso'' (a, b) ('T2' a b) +-- @ + +-- $t3iso +-- +-- If using /lens/, the two conversion functions can be chained with prisms +-- and traversals and other optics using: +-- +-- @ +-- 'iso' 'tupT3' 't2Tup' :: 'Iso'' (a, b, c) ('T3' a b c) +-- @