{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Algebra.Morphism.Affine where

import Prelude (Eq(..), Ord(..), Functor(..), id,Bool(..),Show,otherwise)
import Algebra.Classes
import Algebra.Linear
import qualified Data.Map as M
import Data.Either
import Control.Applicative

import Algebra.Morphism.LinComb (LinComb(..))
import qualified Algebra.Morphism.LinComb as LC


data Affine x c = Affine c (LinComb x c)
  deriving ((forall a b. (a -> b) -> Affine x a -> Affine x b)
-> (forall a b. a -> Affine x b -> Affine x a)
-> Functor (Affine x)
forall a b. a -> Affine x b -> Affine x a
forall a b. (a -> b) -> Affine x a -> Affine x b
forall x a b. a -> Affine x b -> Affine x a
forall x a b. (a -> b) -> Affine x a -> Affine x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall x a b. (a -> b) -> Affine x a -> Affine x b
fmap :: forall a b. (a -> b) -> Affine x a -> Affine x b
$c<$ :: forall x a b. a -> Affine x b -> Affine x a
<$ :: forall a b. a -> Affine x b -> Affine x a
Functor, Affine x c -> Affine x c -> Bool
(Affine x c -> Affine x c -> Bool)
-> (Affine x c -> Affine x c -> Bool) -> Eq (Affine x c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x c. (Eq c, Eq x) => Affine x c -> Affine x c -> Bool
$c== :: forall x c. (Eq c, Eq x) => Affine x c -> Affine x c -> Bool
== :: Affine x c -> Affine x c -> Bool
$c/= :: forall x c. (Eq c, Eq x) => Affine x c -> Affine x c -> Bool
/= :: Affine x c -> Affine x c -> Bool
Eq, Eq (Affine x c)
Eq (Affine x c) =>
(Affine x c -> Affine x c -> Ordering)
-> (Affine x c -> Affine x c -> Bool)
-> (Affine x c -> Affine x c -> Bool)
-> (Affine x c -> Affine x c -> Bool)
-> (Affine x c -> Affine x c -> Bool)
-> (Affine x c -> Affine x c -> Affine x c)
-> (Affine x c -> Affine x c -> Affine x c)
-> Ord (Affine x c)
Affine x c -> Affine x c -> Bool
Affine x c -> Affine x c -> Ordering
Affine x c -> Affine x c -> Affine x c
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x c. (Ord c, Ord x) => Eq (Affine x c)
forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Bool
forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Ordering
forall x c.
(Ord c, Ord x) =>
Affine x c -> Affine x c -> Affine x c
$ccompare :: forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Ordering
compare :: Affine x c -> Affine x c -> Ordering
$c< :: forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Bool
< :: Affine x c -> Affine x c -> Bool
$c<= :: forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Bool
<= :: Affine x c -> Affine x c -> Bool
$c> :: forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Bool
> :: Affine x c -> Affine x c -> Bool
$c>= :: forall x c. (Ord c, Ord x) => Affine x c -> Affine x c -> Bool
>= :: Affine x c -> Affine x c -> Bool
$cmax :: forall x c.
(Ord c, Ord x) =>
Affine x c -> Affine x c -> Affine x c
max :: Affine x c -> Affine x c -> Affine x c
$cmin :: forall x c.
(Ord c, Ord x) =>
Affine x c -> Affine x c -> Affine x c
min :: Affine x c -> Affine x c -> Affine x c
Ord,Int -> Affine x c -> ShowS
[Affine x c] -> ShowS
Affine x c -> String
(Int -> Affine x c -> ShowS)
-> (Affine x c -> String)
-> ([Affine x c] -> ShowS)
-> Show (Affine x c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x c. (Show c, Show x) => Int -> Affine x c -> ShowS
forall x c. (Show c, Show x) => [Affine x c] -> ShowS
forall x c. (Show c, Show x) => Affine x c -> String
$cshowsPrec :: forall x c. (Show c, Show x) => Int -> Affine x c -> ShowS
showsPrec :: Int -> Affine x c -> ShowS
$cshow :: forall x c. (Show c, Show x) => Affine x c -> String
show :: Affine x c -> String
$cshowList :: forall x c. (Show c, Show x) => [Affine x c] -> ShowS
showList :: [Affine x c] -> ShowS
Show)

instance Multiplicative c => Scalable c (Affine x c) where
  c
k *^ :: c -> Affine x c -> Affine x c
*^ Affine x c
x = c
k c -> Affine x c -> Affine x c
forall (f :: * -> *) a.
(Functor f, Multiplicative a) =>
a -> f a -> f a
*< Affine x c
x

instance (Ord x, AbelianAdditive c,DecidableZero c) => AbelianAdditive (Affine x c)
instance (Ord x, AbelianAdditive c,Group c,DecidableZero c) => Group (Affine x c) where
  negate :: Affine x c -> Affine x c
negate = (c -> c) -> Affine x c -> Affine x c
forall a b. (a -> b) -> Affine x a -> Affine x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> c
forall a. Group a => a -> a
negate
instance (Ord x, AbelianAdditive c,DecidableZero c) => Additive (Affine x c) where
  (Affine c
c1 LinComb x c
xs1) + :: Affine x c -> Affine x c -> Affine x c
+ (Affine c
c2 LinComb x c
xs2) = c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine (c
c1 c -> c -> c
forall a. Additive a => a -> a -> a
+ c
c2) (LinComb x c
xs1 LinComb x c -> LinComb x c -> LinComb x c
forall a. Additive a => a -> a -> a
+ LinComb x c
xs2)
  zero :: Affine x c
zero = c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine c
forall a. Additive a => a
zero LinComb x c
forall a. Additive a => a
zero

splitVar :: Ord x => Additive c => x -> Affine x c -> (c, Affine x c)
splitVar :: forall x c.
(Ord x, Additive c) =>
x -> Affine x c -> (c, Affine x c)
splitVar x
x (Affine c
c0 (LinComb Map x c
m)) = (c -> x -> Map x c -> c
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault c
forall a. Additive a => a
zero x
x Map x c
m, c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine c
c0 (Map x c -> LinComb x c
forall x c. Map x c -> LinComb x c
LinComb (x -> Map x c -> Map x c
forall k a. Ord k => k -> Map k a -> Map k a
M.delete x
x Map x c
m)))

-- | @solve x f@ solves the equation @f == 0@ for x.
-- Let f = k x + e.  If k == 0, return Left e. Otherwise, x and return Right -e/k. (The value of x)
solve :: (Ord scalar, Eq scalar, Field scalar, Ord x,DecidableZero scalar)
      => x -> Affine x scalar -> Either (Affine x scalar) (Bool,Affine x scalar)
solve :: forall scalar x.
(Ord scalar, Eq scalar, Field scalar, Ord x,
 DecidableZero scalar) =>
x
-> Affine x scalar
-> Either (Affine x scalar) (Bool, Affine x scalar)
solve x
x Affine x scalar
f = if scalar
k scalar -> scalar -> Bool
forall a. Eq a => a -> a -> Bool
== scalar
forall a. Additive a => a
zero then Affine x scalar -> Either (Affine x scalar) (Bool, Affine x scalar)
forall a b. a -> Either a b
Left Affine x scalar
e else (Bool, Affine x scalar)
-> Either (Affine x scalar) (Bool, Affine x scalar)
forall a b. b -> Either a b
Right (scalar
kscalar -> scalar -> Bool
forall a. Ord a => a -> a -> Bool
>scalar
forall a. Additive a => a
zero,scalar -> scalar
forall a. Division a => a -> a
recip scalar
k scalar -> Affine x scalar -> Affine x scalar
forall s a. Scalable s a => s -> a -> a
*^ Affine x scalar -> Affine x scalar
forall a. Group a => a -> a
negate Affine x scalar
e) 
  where (scalar
k,Affine x scalar
e) = x -> Affine x scalar -> (scalar, Affine x scalar)
forall x c.
(Ord x, Additive c) =>
x -> Affine x c -> (c, Affine x c)
splitVar x
x Affine x scalar
f

-- | Constant affine expression
constant :: (AbelianAdditive c, DecidableZero c) => Ord x => c -> Affine x c
constant :: forall c x.
(AbelianAdditive c, DecidableZero c, Ord x) =>
c -> Affine x c
constant c
c = c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine c
c LinComb x c
forall a. Additive a => a
zero

isConstant :: Eq c => Ord x => DecidableZero c => Affine x c -> Either x c
isConstant :: forall c x.
(Eq c, Ord x, DecidableZero c) =>
Affine x c -> Either x c
isConstant (Affine c
k LinComb x c
x) = case LinComb x c -> [(x, c)]
forall k a. LinComb k a -> [(k, a)]
LC.toList LinComb x c
x of
  [] -> c -> Either x c
forall a b. b -> Either a b
Right c
k
  ((x
v,c
_):[(x, c)]
_) -> x -> Either x c
forall a b. a -> Either a b
Left x
v

var :: Multiplicative c => Additive c => v -> Affine v c
var :: forall c v. (Multiplicative c, Additive c) => v -> Affine v c
var v
x = c -> LinComb v c -> Affine v c
forall x c. c -> LinComb x c -> Affine x c
Affine c
forall a. Additive a => a
zero (v -> LinComb v c
forall c x. Multiplicative c => x -> LinComb x c
LC.var v
x)

eval :: forall x c v. (Additive x, Scalable x x) => (c -> x) -> (v -> x) -> Affine v c -> x
eval :: forall x c v.
(Additive x, Scalable x x) =>
(c -> x) -> (v -> x) -> Affine v c -> x
eval c -> x
fc v -> x
fv (Affine c
c LinComb v c
p) = c -> x
fc c
c x -> x -> x
forall a. Additive a => a -> a -> a
+ (c -> x) -> (v -> x) -> LinComb v c -> x
forall d x c v.
(Scalable d x, Additive x) =>
(c -> d) -> (v -> x) -> LinComb v c -> x
LC.eval c -> x
fc v -> x
fv LinComb v c
p

subst :: (Ord x, AbelianAdditive c, DecidableZero c, Multiplicative c) => (v -> Affine x c) -> Affine v c -> Affine x c
subst :: forall x c v.
(Ord x, AbelianAdditive c, DecidableZero c, Multiplicative c) =>
(v -> Affine x c) -> Affine v c -> Affine x c
subst v -> Affine x c
f (Affine c
c LinComb v c
p) = c -> Affine x c
forall c x.
(AbelianAdditive c, DecidableZero c, Ord x) =>
c -> Affine x c
constant c
c Affine x c -> Affine x c -> Affine x c
forall a. Additive a => a -> a -> a
+ (c -> c) -> (v -> Affine x c) -> LinComb v c -> Affine x c
forall d x c v.
(Scalable d x, Additive x) =>
(c -> d) -> (v -> x) -> LinComb v c -> x
LC.eval c -> c
forall a. a -> a
id v -> Affine x c
f LinComb v c
p 

mapVars :: Ord x => (v -> x) -> Affine v c -> Affine x c
mapVars :: forall x v c. Ord x => (v -> x) -> Affine v c -> Affine x c
mapVars v -> x
f (Affine c
k LinComb v c
e) = c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine c
k ((v -> x) -> LinComb v c -> LinComb x c
forall x t c. Ord x => (t -> x) -> LinComb t c -> LinComb x c
LC.mapVars v -> x
f LinComb v c
e)

traverseVars :: Ord x => Applicative f => (v -> f x) -> Affine v c -> f (Affine x c)
traverseVars :: forall x (f :: * -> *) v c.
(Ord x, Applicative f) =>
(v -> f x) -> Affine v c -> f (Affine x c)
traverseVars v -> f x
f (Affine c
k LinComb v c
e) = c -> LinComb x c -> Affine x c
forall x c. c -> LinComb x c -> Affine x c
Affine c
k (LinComb x c -> Affine x c) -> f (LinComb x c) -> f (Affine x c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> f x) -> LinComb v c -> f (LinComb x c)
forall (f :: * -> *) x v c.
(Applicative f, Ord x) =>
(v -> f x) -> LinComb v c -> f (LinComb x c)
LC.traverseVars v -> f x
f LinComb v c
e