{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Primary.Linear.Vector where import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid (Ringoid ((*))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Quasiring (Quasiring (one)) import Pandora.Pattern.Object.Group (Group (invert)) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce)) data Vector r a where Scalar :: a -> Vector a a Vector :: a -> Vector r a -> Vector (a :*: r) a instance Semigroup a => Semigroup (Vector a a) where ~(Scalar a x) + :: Vector a a -> Vector a a -> Vector a a + ~(Scalar a y) = a -> Vector a a forall a. a -> Vector a a Scalar (a -> Vector a a) -> a -> Vector a a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a x a -> a -> a forall a. Semigroup a => a -> a -> a + a y instance (Semigroup a, Semigroup r, Semigroup (a :*: r), Semigroup (Vector r a)) => Semigroup (Vector (a :*: r) a) where Vector a x Vector r a xs + :: Vector (a :*: r) a -> Vector (a :*: r) a -> Vector (a :*: r) a + Vector a y Vector r a ys = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector (a -> Vector r a -> Vector (a :*: r) a) -> a -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a x a -> a -> a forall a. Semigroup a => a -> a -> a + a y (Vector r a -> Vector (a :*: r) a) -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- Vector r a xs Vector r a -> Vector r a -> Vector r a forall a. Semigroup a => a -> a -> a + Vector r a Vector r a ys instance Ringoid a => Ringoid (Vector a a) where ~(Scalar a x) * :: Vector a a -> Vector a a -> Vector a a * ~(Scalar a y) = a -> Vector a a forall a. a -> Vector a a Scalar (a -> Vector a a) -> a -> Vector a a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a x a -> a -> a forall a. Ringoid a => a -> a -> a * a y instance (Ringoid a, Ringoid r, Ringoid (a :*: r), Ringoid (Vector r a)) => Ringoid (Vector (a :*: r) a) where Vector a x Vector r a xs * :: Vector (a :*: r) a -> Vector (a :*: r) a -> Vector (a :*: r) a * Vector a y Vector r a ys = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector (a -> Vector r a -> Vector (a :*: r) a) -> a -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a x a -> a -> a forall a. Ringoid a => a -> a -> a * a y (Vector r a -> Vector (a :*: r) a) -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- Vector r a xs Vector r a -> Vector r a -> Vector r a forall a. Ringoid a => a -> a -> a * Vector r a Vector r a ys instance Monoid a => Monoid (Vector a a) where zero :: Vector a a zero = a -> Vector a a forall a. a -> Vector a a Scalar a forall a. Monoid a => a zero instance (Monoid a, Monoid r, Monoid (a :*: r), Monoid (Vector r a)) => Monoid (Vector (a :*: r) a) where zero :: Vector (a :*: r) a zero = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector a forall a. Monoid a => a zero Vector r a forall a. Monoid a => a zero instance Quasiring a => Quasiring (Vector a a) where one :: Vector a a one = a -> Vector a a forall a. a -> Vector a a Scalar a forall a. Quasiring a => a one instance (Quasiring a, Quasiring r, Quasiring (a :*: r), Quasiring (Vector r a)) => Quasiring (Vector (a :*: r) a) where one :: Vector (a :*: r) a one = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector a forall a. Quasiring a => a one Vector r a forall a. Quasiring a => a one instance Group a => Group (Vector a a) where invert :: Vector a a -> Vector a a invert ~(Scalar a x) = a -> Vector a a forall a. a -> Vector a a Scalar (a -> Vector a a) -> a -> Vector a a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> a forall a. Group a => a -> a invert a x instance (Group a, Group r, Group (a :*: r), Group (Vector r a)) => Group (Vector (a :*: r) a) where invert :: Vector (a :*: r) a -> Vector (a :*: r) a invert (Vector a x Vector r a xs) = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector (a -> Vector r a -> Vector (a :*: r) a) -> a -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> a forall a. Group a => a -> a invert a x (Vector r a -> Vector (a :*: r) a) -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- Vector r a -> Vector r a forall a. Group a => a -> a invert Vector r a xs instance Setoid a => Setoid (Vector a a) where ~(Scalar a x) == :: Vector a a -> Vector a a -> Boolean == ~(Scalar a y) = a x a -> a -> Boolean forall a. Setoid a => a -> a -> Boolean == a y instance (Setoid a, Setoid (Vector r a)) => Setoid (Vector (a :*: r) a) where Vector a x Vector r a xs == :: Vector (a :*: r) a -> Vector (a :*: r) a -> Boolean == Vector a y Vector r a ys = (a x a -> a -> Boolean forall a. Setoid a => a -> a -> Boolean == a y) Boolean -> Boolean -> Boolean forall a. Ringoid a => a -> a -> a * (Vector r a xs Vector r a -> Vector r a -> Boolean forall a. Setoid a => a -> a -> Boolean == Vector r a Vector r a ys) instance Monotonic a (Vector a a) where reduce :: (a -> r -> r) -> r -> Vector a a -> r reduce a -> r -> r f r r ~(Scalar a x) = a -> r -> r f a x r r instance Monotonic a (Vector r a) => Monotonic a (Vector (a :*: r) a) where reduce :: (a -> r -> r) -> r -> Vector (a :*: r) a -> r reduce a -> r -> r f r r (Vector a x Vector r a xs) = (a -> r -> r) -> r -> Vector r a -> r forall a e r. Monotonic a e => (a -> r -> r) -> r -> e -> r reduce a -> r -> r f (r -> Vector r a -> r) -> r -> Vector r a -> r forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> r -> r f a x r r (Vector r a -> r) -> Vector r a -> r forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- Vector r a xs class Vectorize a r where vectorize :: r -> Vector r a instance Vectorize a a where vectorize :: a -> Vector a a vectorize a x = a -> Vector a a forall a. a -> Vector a a Scalar a x instance Vectorize a r => Vectorize a (a :*: r) where vectorize :: (a :*: r) -> Vector (a :*: r) a vectorize (a x :*: r r) = a -> Vector r a -> Vector (a :*: r) a forall a r. a -> Vector r a -> Vector (a :*: r) a Vector a x (Vector r a -> Vector (a :*: r) a) -> Vector r a -> Vector (a :*: r) a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- r -> Vector r a forall a r. Vectorize a r => r -> Vector r a vectorize r r