{-# 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.Pattern.Functor.Pointable (point) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into, Push), premorph, into, item) import Pandora.Paradigm.Structure.Some.List (List) 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m # 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 :: * -> * -> *). Category m => m ~~> m # a -> r -> r f a x r r (Vector r a -> r) -> Vector r a -> r forall (m :: * -> * -> *). Category m => m ~~> m # Vector r a xs instance Morphable (Into List) (Vector r) where type Morphing (Into List) (Vector r) = List morphing :: (<:.>) (Tagged ('Into List)) (Vector r) a -> Morphing ('Into List) (Vector r) a morphing ((<:.>) (Tagged ('Into List)) (Vector r) a -> Vector r a forall k (f :: k) (t :: * -> *). Morphable f t => (Tagged f <:.> t) ~> t premorph -> Scalar r x) = r :=> List forall (t :: * -> *) a. Pointable t => a :=> t point r x morphing ((<:.>) (Tagged ('Into List)) (Vector r) a -> Vector r a forall k (f :: k) (t :: * -> *). Morphable f t => (Tagged f <:.> t) ~> t premorph -> Vector a x Vector r a xs) = a :=:=> List forall k (f :: k) (t :: * -> *) a. (Morphable f t, Morphing f t ~ ((Identity <:.:> t) := (->))) => a :=:=> t item @Push a x (TU Covariant Covariant Maybe (Construction Maybe) a -> TU Covariant Covariant Maybe (Construction Maybe) a) -> TU Covariant Covariant Maybe (Construction Maybe) a -> TU Covariant Covariant Maybe (Construction Maybe) a forall (m :: * -> * -> *). Category m => m ~~> m $ Vector r a -> Morphing ('Into List) (Vector r) a forall a (f :: a) (t :: * -> *). Morphable ('Into f) t => t ~> Morphing ('Into f) t into @List Vector r a xs instance Morphable (Into (Construction Maybe)) (Vector r) where type Morphing (Into (Construction Maybe)) (Vector r) = Construction Maybe morphing :: (<:.>) (Tagged ('Into (Construction Maybe))) (Vector r) a -> Morphing ('Into (Construction Maybe)) (Vector r) a morphing ((<:.>) (Tagged ('Into (Construction Maybe))) (Vector r) a -> Vector r a forall k (f :: k) (t :: * -> *). Morphable f t => (Tagged f <:.> t) ~> t premorph -> Scalar r x) = r :=> Construction Maybe forall (t :: * -> *) a. Pointable t => a :=> t point r x morphing ((<:.>) (Tagged ('Into (Construction Maybe))) (Vector r) a -> Vector r a forall k (f :: k) (t :: * -> *). Morphable f t => (Tagged f <:.> t) ~> t premorph -> Vector a x Vector r a xs) = a :=:=> Construction Maybe forall k (f :: k) (t :: * -> *) a. (Morphable f t, Morphing f t ~ ((Identity <:.:> t) := (->))) => a :=:=> t item @Push a x (Construction Maybe a -> Construction Maybe a) -> Construction Maybe a -> Construction Maybe a forall (m :: * -> * -> *). Category m => m ~~> m $ Vector r a -> Morphing ('Into (Nonempty List)) (Vector r) a forall a (f :: a) (t :: * -> *). Morphable ('Into f) t => t ~> Morphing ('Into f) t into @(Nonempty List) 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 :: * -> * -> *). Category m => m ~~> m $ r -> Vector r a forall a r. Vectorize a r => r -> Vector r a vectorize r r