{-# OPTIONS_GHC -fno-warn-orphans #-}
module Pandora.Paradigm.Primary.Linear.Vector where

import Pandora.Pattern.Semigroupoid ((.))
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.Primary.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))
import Pandora.Paradigm.Schemes.TT (TT (TT))
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.Controlflow.Effect.Interpreted ((!))

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 :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! 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 :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! 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 :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! 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 :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
m (t a) (Primary t a)
! r -> Vector r a
forall a r. Vectorize a r => r -> Vector r a
vectorize r
r