{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Downhill.Linear.Expr
(
Expr (..),
Term (..),
BasicVector (..),
FullVector (..),
SparseVector (..),
DenseVector (..),
DenseBuilder (..),
toDenseBuilder,
maybeToMonoid,
)
where
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Sum (Sum, getSum))
import Data.VectorSpace (AdditiveGroup (..), VectorSpace (..))
data Term a v where
Term :: (v -> VecBuilder u) -> Expr a u -> Term a v
data Expr a v where
ExprVar :: Expr a a
ExprSum :: BasicVector v => [Term a v] -> Expr a v
class Monoid (VecBuilder v) => BasicVector v where
type VecBuilder v :: Type
sumBuilder :: VecBuilder v -> v
maybeToMonoid :: Monoid m => Maybe m -> m
maybeToMonoid :: Maybe m -> m
maybeToMonoid = m -> Maybe m -> m
forall a. a -> Maybe a -> a
fromMaybe m
forall a. Monoid a => a
mempty
instance BasicVector Integer where
type VecBuilder Integer = Sum Integer
sumBuilder :: VecBuilder Integer -> Integer
sumBuilder = VecBuilder Integer -> Integer
forall a. Sum a -> a
getSum
instance (BasicVector a, BasicVector b) => BasicVector (a, b) where
type VecBuilder (a, b) = Maybe (VecBuilder a, VecBuilder b)
sumBuilder :: VecBuilder (a, b) -> (a, b)
sumBuilder = (VecBuilder a, VecBuilder b) -> (a, b)
forall a b.
(BasicVector a, BasicVector b) =>
(VecBuilder a, VecBuilder b) -> (a, b)
sumPair ((VecBuilder a, VecBuilder b) -> (a, b))
-> (Maybe (VecBuilder a, VecBuilder b)
-> (VecBuilder a, VecBuilder b))
-> Maybe (VecBuilder a, VecBuilder b)
-> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (VecBuilder a, VecBuilder b) -> (VecBuilder a, VecBuilder b)
forall m. Monoid m => Maybe m -> m
maybeToMonoid
where
sumPair :: (VecBuilder a, VecBuilder b) -> (a, b)
sumPair (VecBuilder a
a, VecBuilder b
b) = (VecBuilder a -> a
forall v. BasicVector v => VecBuilder v -> v
sumBuilder VecBuilder a
a, VecBuilder b -> b
forall v. BasicVector v => VecBuilder v -> v
sumBuilder VecBuilder b
b)
instance (BasicVector a, BasicVector b, BasicVector c) => BasicVector (a, b, c) where
type VecBuilder (a, b, c) = Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
sumBuilder :: VecBuilder (a, b, c) -> (a, b, c)
sumBuilder = (VecBuilder a, VecBuilder b, VecBuilder c) -> (a, b, c)
forall a b c.
(BasicVector a, BasicVector b, BasicVector c) =>
(VecBuilder a, VecBuilder b, VecBuilder c) -> (a, b, c)
sumTriple ((VecBuilder a, VecBuilder b, VecBuilder c) -> (a, b, c))
-> (Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
-> (VecBuilder a, VecBuilder b, VecBuilder c))
-> Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
-> (a, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
-> (VecBuilder a, VecBuilder b, VecBuilder c)
forall m. Monoid m => Maybe m -> m
maybeToMonoid
where
sumTriple :: (VecBuilder a, VecBuilder b, VecBuilder c) -> (a, b, c)
sumTriple (VecBuilder a
a, VecBuilder b
b, VecBuilder c
c) = (VecBuilder a -> a
forall v. BasicVector v => VecBuilder v -> v
sumBuilder VecBuilder a
a, VecBuilder b -> b
forall v. BasicVector v => VecBuilder v -> v
sumBuilder VecBuilder b
b, VecBuilder c -> c
forall v. BasicVector v => VecBuilder v -> v
sumBuilder VecBuilder c
c)
instance BasicVector Float where
type VecBuilder Float = Sum Float
sumBuilder :: VecBuilder Float -> Float
sumBuilder = VecBuilder Float -> Float
forall a. Sum a -> a
getSum
instance BasicVector Double where
type VecBuilder Double = Sum Double
sumBuilder :: VecBuilder Double -> Double
sumBuilder = VecBuilder Double -> Double
forall a. Sum a -> a
getSum
class (BasicVector v, VectorSpace v) => FullVector v where
identityBuilder :: v -> VecBuilder v
negateBuilder :: v -> VecBuilder v
scaleBuilder :: Scalar v -> v -> VecBuilder v
instance FullVector Float where
identityBuilder :: Float -> VecBuilder Float
identityBuilder = Float -> VecBuilder Float
forall a. a -> Sum a
Sum
negateBuilder :: Float -> VecBuilder Float
negateBuilder = Float -> Sum Float
forall a. a -> Sum a
Sum (Float -> Sum Float) -> (Float -> Float) -> Float -> Sum Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
negate
scaleBuilder :: Scalar Float -> Float -> VecBuilder Float
scaleBuilder Scalar Float
x = Float -> Sum Float
forall a. a -> Sum a
Sum (Float -> Sum Float) -> (Float -> Float) -> Float -> Sum Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
Scalar Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
*)
instance FullVector Double where
identityBuilder :: Double -> VecBuilder Double
identityBuilder = Double -> VecBuilder Double
forall a. a -> Sum a
Sum
negateBuilder :: Double -> VecBuilder Double
negateBuilder = Double -> Sum Double
forall a. a -> Sum a
Sum (Double -> Sum Double)
-> (Double -> Double) -> Double -> Sum Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Num a => a -> a
negate
scaleBuilder :: Scalar Double -> Double -> VecBuilder Double
scaleBuilder Scalar Double
x = Double -> Sum Double
forall a. a -> Sum a
Sum (Double -> Sum Double)
-> (Double -> Double) -> Double -> Sum Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
Scalar Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
*)
instance FullVector Integer where
identityBuilder :: Integer -> VecBuilder Integer
identityBuilder = Integer -> VecBuilder Integer
forall a. a -> Sum a
Sum
negateBuilder :: Integer -> VecBuilder Integer
negateBuilder = Integer -> Sum Integer
forall a. a -> Sum a
Sum (Integer -> Sum Integer)
-> (Integer -> Integer) -> Integer -> Sum Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate
scaleBuilder :: Scalar Integer -> Integer -> VecBuilder Integer
scaleBuilder Scalar Integer
x = Integer -> Sum Integer
forall a. a -> Sum a
Sum (Integer -> Sum Integer)
-> (Integer -> Integer) -> Integer -> Sum Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
Scalar Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*)
instance (Scalar a ~ Scalar b, FullVector a, FullVector b) => FullVector (a, b) where
identityBuilder :: (a, b) -> VecBuilder (a, b)
identityBuilder (a
x, b
y) = (VecBuilder a, VecBuilder b) -> Maybe (VecBuilder a, VecBuilder b)
forall a. a -> Maybe a
Just (a -> VecBuilder a
forall v. FullVector v => v -> VecBuilder v
identityBuilder a
x, b -> VecBuilder b
forall v. FullVector v => v -> VecBuilder v
identityBuilder b
y)
negateBuilder :: (a, b) -> VecBuilder (a, b)
negateBuilder (a
x, b
y) = (VecBuilder a, VecBuilder b) -> Maybe (VecBuilder a, VecBuilder b)
forall a. a -> Maybe a
Just (a -> VecBuilder a
forall v. FullVector v => v -> VecBuilder v
negateBuilder a
x, b -> VecBuilder b
forall v. FullVector v => v -> VecBuilder v
negateBuilder b
y)
scaleBuilder :: Scalar (a, b) -> (a, b) -> VecBuilder (a, b)
scaleBuilder Scalar (a, b)
a (a
x, b
y) = (VecBuilder a, VecBuilder b) -> Maybe (VecBuilder a, VecBuilder b)
forall a. a -> Maybe a
Just (Scalar a -> a -> VecBuilder a
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar a
Scalar (a, b)
a a
x, Scalar b -> b -> VecBuilder b
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar b
Scalar (a, b)
a b
y)
instance (s ~ Scalar a, s ~ Scalar b, s ~ Scalar c, FullVector a, FullVector b, FullVector c) => FullVector (a, b, c) where
identityBuilder :: (a, b, c) -> VecBuilder (a, b, c)
identityBuilder (a
x, b
y, c
z) = (VecBuilder a, VecBuilder b, VecBuilder c)
-> Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
forall a. a -> Maybe a
Just (a -> VecBuilder a
forall v. FullVector v => v -> VecBuilder v
identityBuilder a
x, b -> VecBuilder b
forall v. FullVector v => v -> VecBuilder v
identityBuilder b
y, c -> VecBuilder c
forall v. FullVector v => v -> VecBuilder v
identityBuilder c
z)
negateBuilder :: (a, b, c) -> VecBuilder (a, b, c)
negateBuilder (a
x, b
y, c
z) = (VecBuilder a, VecBuilder b, VecBuilder c)
-> Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
forall a. a -> Maybe a
Just (a -> VecBuilder a
forall v. FullVector v => v -> VecBuilder v
negateBuilder a
x, b -> VecBuilder b
forall v. FullVector v => v -> VecBuilder v
negateBuilder b
y, c -> VecBuilder c
forall v. FullVector v => v -> VecBuilder v
negateBuilder c
z)
scaleBuilder :: Scalar (a, b, c) -> (a, b, c) -> VecBuilder (a, b, c)
scaleBuilder Scalar (a, b, c)
a (a
x, b
y, c
z) = (VecBuilder a, VecBuilder b, VecBuilder c)
-> Maybe (VecBuilder a, VecBuilder b, VecBuilder c)
forall a. a -> Maybe a
Just (Scalar a -> a -> VecBuilder a
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar a
Scalar (a, b, c)
a a
x, Scalar b -> b -> VecBuilder b
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar b
Scalar (a, b, c)
a b
y, Scalar c -> c -> VecBuilder c
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar c
Scalar (a, b, c)
a c
z)
newtype SparseVector v = SparseVector
{SparseVector v -> VecBuilder v
unSparseVector :: VecBuilder v}
deriving via (VecBuilder v) instance Semigroup (VecBuilder v) => Semigroup (SparseVector v)
instance Monoid (VecBuilder v) => BasicVector (SparseVector v) where
type VecBuilder (SparseVector v) = VecBuilder v
sumBuilder :: VecBuilder (SparseVector v) -> SparseVector v
sumBuilder = VecBuilder (SparseVector v) -> SparseVector v
forall v. VecBuilder v -> SparseVector v
SparseVector
newtype DenseSemibuilder v = DenseSemibuilder {DenseSemibuilder v -> v
_unDenseSemibuilder :: v}
instance AdditiveGroup v => Semigroup (DenseSemibuilder v) where
DenseSemibuilder v
x <> :: DenseSemibuilder v -> DenseSemibuilder v -> DenseSemibuilder v
<> DenseSemibuilder v
y = v -> DenseSemibuilder v
forall v. v -> DenseSemibuilder v
DenseSemibuilder (v
x v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
y)
newtype DenseBuilder v = DenseBuilder (Maybe v)
deriving (b -> DenseBuilder v -> DenseBuilder v
NonEmpty (DenseBuilder v) -> DenseBuilder v
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
(DenseBuilder v -> DenseBuilder v -> DenseBuilder v)
-> (NonEmpty (DenseBuilder v) -> DenseBuilder v)
-> (forall b. Integral b => b -> DenseBuilder v -> DenseBuilder v)
-> Semigroup (DenseBuilder v)
forall b. Integral b => b -> DenseBuilder v -> DenseBuilder v
forall v.
AdditiveGroup v =>
NonEmpty (DenseBuilder v) -> DenseBuilder v
forall v.
AdditiveGroup v =>
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
forall v b.
(AdditiveGroup v, Integral b) =>
b -> DenseBuilder v -> DenseBuilder v
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DenseBuilder v -> DenseBuilder v
$cstimes :: forall v b.
(AdditiveGroup v, Integral b) =>
b -> DenseBuilder v -> DenseBuilder v
sconcat :: NonEmpty (DenseBuilder v) -> DenseBuilder v
$csconcat :: forall v.
AdditiveGroup v =>
NonEmpty (DenseBuilder v) -> DenseBuilder v
<> :: DenseBuilder v -> DenseBuilder v -> DenseBuilder v
$c<> :: forall v.
AdditiveGroup v =>
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
Semigroup, Semigroup (DenseBuilder v)
DenseBuilder v
Semigroup (DenseBuilder v)
-> DenseBuilder v
-> (DenseBuilder v -> DenseBuilder v -> DenseBuilder v)
-> ([DenseBuilder v] -> DenseBuilder v)
-> Monoid (DenseBuilder v)
[DenseBuilder v] -> DenseBuilder v
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall v. AdditiveGroup v => Semigroup (DenseBuilder v)
forall v. AdditiveGroup v => DenseBuilder v
forall v. AdditiveGroup v => [DenseBuilder v] -> DenseBuilder v
forall v.
AdditiveGroup v =>
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
mconcat :: [DenseBuilder v] -> DenseBuilder v
$cmconcat :: forall v. AdditiveGroup v => [DenseBuilder v] -> DenseBuilder v
mappend :: DenseBuilder v -> DenseBuilder v -> DenseBuilder v
$cmappend :: forall v.
AdditiveGroup v =>
DenseBuilder v -> DenseBuilder v -> DenseBuilder v
mempty :: DenseBuilder v
$cmempty :: forall v. AdditiveGroup v => DenseBuilder v
$cp1Monoid :: forall v. AdditiveGroup v => Semigroup (DenseBuilder v)
Monoid) via (Maybe (DenseSemibuilder v))
toDenseBuilder :: v -> DenseBuilder v
toDenseBuilder :: v -> DenseBuilder v
toDenseBuilder = Maybe v -> DenseBuilder v
forall v. Maybe v -> DenseBuilder v
DenseBuilder (Maybe v -> DenseBuilder v)
-> (v -> Maybe v) -> v -> DenseBuilder v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
forall a. a -> Maybe a
Just
newtype DenseVector v = DenseVector v
deriving (DenseVector v
DenseVector v -> DenseVector v
DenseVector v -> DenseVector v -> DenseVector v
DenseVector v
-> (DenseVector v -> DenseVector v -> DenseVector v)
-> (DenseVector v -> DenseVector v)
-> (DenseVector v -> DenseVector v -> DenseVector v)
-> AdditiveGroup (DenseVector v)
forall v.
v -> (v -> v -> v) -> (v -> v) -> (v -> v -> v) -> AdditiveGroup v
forall v. AdditiveGroup v => DenseVector v
forall v. AdditiveGroup v => DenseVector v -> DenseVector v
forall v.
AdditiveGroup v =>
DenseVector v -> DenseVector v -> DenseVector v
^-^ :: DenseVector v -> DenseVector v -> DenseVector v
$c^-^ :: forall v.
AdditiveGroup v =>
DenseVector v -> DenseVector v -> DenseVector v
negateV :: DenseVector v -> DenseVector v
$cnegateV :: forall v. AdditiveGroup v => DenseVector v -> DenseVector v
^+^ :: DenseVector v -> DenseVector v -> DenseVector v
$c^+^ :: forall v.
AdditiveGroup v =>
DenseVector v -> DenseVector v -> DenseVector v
zeroV :: DenseVector v
$czeroV :: forall v. AdditiveGroup v => DenseVector v
AdditiveGroup, AdditiveGroup (DenseVector v)
Scalar (DenseVector v) -> DenseVector v -> DenseVector v
AdditiveGroup (DenseVector v)
-> (Scalar (DenseVector v) -> DenseVector v -> DenseVector v)
-> VectorSpace (DenseVector v)
forall v. VectorSpace v => AdditiveGroup (DenseVector v)
forall v.
VectorSpace v =>
Scalar (DenseVector v) -> DenseVector v -> DenseVector v
forall v. AdditiveGroup v -> (Scalar v -> v -> v) -> VectorSpace v
*^ :: Scalar (DenseVector v) -> DenseVector v -> DenseVector v
$c*^ :: forall v.
VectorSpace v =>
Scalar (DenseVector v) -> DenseVector v -> DenseVector v
$cp1VectorSpace :: forall v. VectorSpace v => AdditiveGroup (DenseVector v)
VectorSpace) via v
instance AdditiveGroup v => BasicVector (DenseVector v) where
type VecBuilder (DenseVector v) = DenseBuilder v
sumBuilder :: VecBuilder (DenseVector v) -> DenseVector v
sumBuilder (DenseBuilder Nothing) = v -> DenseVector v
forall v. v -> DenseVector v
DenseVector v
forall v. AdditiveGroup v => v
zeroV
sumBuilder (DenseBuilder (Just x)) = v -> DenseVector v
forall v. v -> DenseVector v
DenseVector v
x
instance VectorSpace v => FullVector (DenseVector v) where
identityBuilder :: DenseVector v -> VecBuilder (DenseVector v)
identityBuilder (DenseVector v
v) = Maybe v -> DenseBuilder v
forall v. Maybe v -> DenseBuilder v
DenseBuilder (v -> Maybe v
forall a. a -> Maybe a
Just v
v)
negateBuilder :: DenseVector v -> VecBuilder (DenseVector v)
negateBuilder (DenseVector v
v) = Maybe v -> DenseBuilder v
forall v. Maybe v -> DenseBuilder v
DenseBuilder (v -> Maybe v
forall a. a -> Maybe a
Just (v -> v
forall v. AdditiveGroup v => v -> v
negateV v
v))
scaleBuilder :: Scalar (DenseVector v)
-> DenseVector v -> VecBuilder (DenseVector v)
scaleBuilder Scalar (DenseVector v)
a (DenseVector v
v) = Maybe v -> DenseBuilder v
forall v. Maybe v -> DenseBuilder v
DenseBuilder (v -> Maybe v
forall a. a -> Maybe a
Just (Scalar v
Scalar (DenseVector v)
a Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
v))
instance FullVector v => AdditiveGroup (Expr a v) where
zeroV :: Expr a v
zeroV = [Term a v] -> Expr a v
forall v a. BasicVector v => [Term a v] -> Expr a v
ExprSum []
negateV :: Expr a v -> Expr a v
negateV Expr a v
x = [Term a v] -> Expr a v
forall v a. BasicVector v => [Term a v] -> Expr a v
ExprSum [(v -> VecBuilder v) -> Expr a v -> Term a v
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term v -> VecBuilder v
forall v. FullVector v => v -> VecBuilder v
negateBuilder Expr a v
x]
Expr a v
x ^+^ :: Expr a v -> Expr a v -> Expr a v
^+^ Expr a v
y = [Term a v] -> Expr a v
forall v a. BasicVector v => [Term a v] -> Expr a v
ExprSum [(v -> VecBuilder v) -> Expr a v -> Term a v
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term v -> VecBuilder v
forall v. FullVector v => v -> VecBuilder v
identityBuilder Expr a v
x, (v -> VecBuilder v) -> Expr a v -> Term a v
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term v -> VecBuilder v
forall v. FullVector v => v -> VecBuilder v
identityBuilder Expr a v
y]
Expr a v
x ^-^ :: Expr a v -> Expr a v -> Expr a v
^-^ Expr a v
y = [Term a v] -> Expr a v
forall v a. BasicVector v => [Term a v] -> Expr a v
ExprSum [(v -> VecBuilder v) -> Expr a v -> Term a v
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term v -> VecBuilder v
forall v. FullVector v => v -> VecBuilder v
identityBuilder Expr a v
x, (v -> VecBuilder v) -> Expr a v -> Term a v
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term v -> VecBuilder v
forall v. FullVector v => v -> VecBuilder v
negateBuilder Expr a v
y]
instance FullVector dv => VectorSpace (Expr da dv) where
type Scalar (Expr da dv) = Scalar dv
Scalar (Expr da dv)
a *^ :: Scalar (Expr da dv) -> Expr da dv -> Expr da dv
*^ Expr da dv
v = [Term da dv] -> Expr da dv
forall v a. BasicVector v => [Term a v] -> Expr a v
ExprSum [(dv -> VecBuilder dv) -> Expr da dv -> Term da dv
forall v u a. (v -> VecBuilder u) -> Expr a u -> Term a v
Term (Scalar dv -> dv -> VecBuilder dv
forall v. FullVector v => Scalar v -> v -> VecBuilder v
scaleBuilder Scalar dv
Scalar (Expr da dv)
a) Expr da dv
v]