{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,
             MultiParamTypeClasses, FunctionalDependencies, 
             TypeFamilies, DataKinds, GeneralizedNewtypeDeriving
  #-}
module Math.RootLoci.Motivic.Classes where

--------------------------------------------------------------------------------

import Data.Char
import Data.List
import Data.Ord
import Data.Maybe

import GHC.TypeLits

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

import qualified Math.Algebra.Polynomial.FreeModule as ZMod 
import Math.Algebra.Polynomial.FreeModule (ZMod,QMod,FreeMod)
import Math.Algebra.Polynomial.Pretty

import Math.Combinat.Classes hiding (empty)
import Math.Combinat.Tuples
import Math.Combinat.Partitions
import Math.Combinat.Permutations hiding (permute)

import Math.Algebra.Polynomial.Class
import Math.Algebra.Polynomial.Monomial.Indexed 

import Math.RootLoci.Misc.Common

--------------------------------------------------------------------------------
-- * Dimensions

-- | A dimension (@d@ in @Sym^d(X)@)
newtype Dim 
  = Dim Int
  deriving (Dim -> Dim -> Bool
(Dim -> Dim -> Bool) -> (Dim -> Dim -> Bool) -> Eq Dim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dim -> Dim -> Bool
$c/= :: Dim -> Dim -> Bool
== :: Dim -> Dim -> Bool
$c== :: Dim -> Dim -> Bool
Eq,Eq Dim
Eq Dim
-> (Dim -> Dim -> Ordering)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Bool)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> Ord Dim
Dim -> Dim -> Bool
Dim -> Dim -> Ordering
Dim -> Dim -> Dim
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
min :: Dim -> Dim -> Dim
$cmin :: Dim -> Dim -> Dim
max :: Dim -> Dim -> Dim
$cmax :: Dim -> Dim -> Dim
>= :: Dim -> Dim -> Bool
$c>= :: Dim -> Dim -> Bool
> :: Dim -> Dim -> Bool
$c> :: Dim -> Dim -> Bool
<= :: Dim -> Dim -> Bool
$c<= :: Dim -> Dim -> Bool
< :: Dim -> Dim -> Bool
$c< :: Dim -> Dim -> Bool
compare :: Dim -> Dim -> Ordering
$ccompare :: Dim -> Dim -> Ordering
$cp1Ord :: Eq Dim
Ord,Int -> Dim -> ShowS
[Dim] -> ShowS
Dim -> String
(Int -> Dim -> ShowS)
-> (Dim -> String) -> ([Dim] -> ShowS) -> Show Dim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dim] -> ShowS
$cshowList :: [Dim] -> ShowS
show :: Dim -> String
$cshow :: Dim -> String
showsPrec :: Int -> Dim -> ShowS
$cshowsPrec :: Int -> Dim -> ShowS
Show,Integer -> Dim
Dim -> Dim
Dim -> Dim -> Dim
(Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim -> Dim)
-> (Dim -> Dim)
-> (Dim -> Dim)
-> (Dim -> Dim)
-> (Integer -> Dim)
-> Num Dim
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Dim
$cfromInteger :: Integer -> Dim
signum :: Dim -> Dim
$csignum :: Dim -> Dim
abs :: Dim -> Dim
$cabs :: Dim -> Dim
negate :: Dim -> Dim
$cnegate :: Dim -> Dim
* :: Dim -> Dim -> Dim
$c* :: Dim -> Dim -> Dim
- :: Dim -> Dim -> Dim
$c- :: Dim -> Dim -> Dim
+ :: Dim -> Dim -> Dim
$c+ :: Dim -> Dim -> Dim
Num)

unDim :: Dim -> Int
unDim :: Dim -> Int
unDim (Dim Int
d) = Int
d

dimVector :: Partition -> [Dim]
dimVector :: Partition -> [Dim]
dimVector = (Int -> Dim) -> [Int] -> [Dim]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Dim
Dim ([Int] -> [Dim]) -> (Partition -> [Int]) -> Partition -> [Dim]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> [Int]
exponentVector

dimTuples :: [Dim] -> [[Dim]]
dimTuples :: [Dim] -> [[Dim]]
dimTuples  
  = (([Int] -> [Dim]) -> [[Int]] -> [[Dim]]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> [Dim]) -> [[Int]] -> [[Dim]])
-> ((Int -> Dim) -> [Int] -> [Dim])
-> (Int -> Dim)
-> [[Int]]
-> [[Dim]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Dim) -> [Int] -> [Dim]
forall a b. (a -> b) -> [a] -> [b]
map) Int -> Dim
Dim
  ([[Int]] -> [[Dim]]) -> ([Dim] -> [[Int]]) -> [Dim] -> [[Dim]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[Int]]
tuples'
  ([Int] -> [[Int]]) -> ([Dim] -> [Int]) -> [Dim] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dim -> Int) -> [Dim] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Dim -> Int
unDim 

--------------------------------------------------------------------------------
-- * Classes

-- | Degree of something
class Degree a where
  type MultiDegree a :: *
  totalDegree :: a -> Int
  multiDegree :: a -> MultiDegree a

instance (KnownNat n) => Degree (XS v n) where
  type MultiDegree (XS v n) = [Int]
  totalDegree :: XS v n -> Int
totalDegree = XS v n -> Int
forall (v :: Symbol) (n :: Nat). XS v n -> Int
totalDegXS
  multiDegree :: XS v n -> MultiDegree (XS v n)
multiDegree = XS v n -> MultiDegree (XS v n)
forall (n :: Nat) (v :: Symbol). KnownNat n => XS v n -> [Int]
xsToExponents

--------------------------------------------------------------------------------

class Empty a where
  empty :: a

instance Empty [a] where
  empty :: [a]
empty = []

instance Empty (Maybe a) where
  empty :: Maybe a
empty = Maybe a
forall a. Maybe a
Nothing

instance Empty Int where
  empty :: Int
empty = Int
0

instance KnownNat n => Empty (XS v n) where
  empty :: XS v n
empty = XS v n
forall (n :: Nat) (v :: Symbol). KnownNat n => XS v n
emptyXS

--------------------------------------------------------------------------------

-- | Normalize terms and lambdas
class Normalize a where
  normalize :: a -> a

-- | This is a hack because there is some issue when this is included in normalize that i don't want to debug right now
class SuperNormalize a where
  superNormalize :: a -> a 
  
--------------------------------------------------------------------------------

-- | Exterior (or cross) product
class Cross a where
  cross :: a -> a -> a
  crossMany :: [a] -> a
  crossMany = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Cross a => a -> a -> a
cross
  crossInterleave :: a -> a -> a       -- ^ interleaved cross product of vectors

instance Cross [a] where
  cross :: [a] -> [a] -> [a]
cross     = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
  crossMany :: [[a]] -> [a]
crossMany = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 
  crossInterleave :: [a] -> [a] -> [a]
crossInterleave [a]
xs [a]
ys = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys

-------------------------------------------------------------------------------

-- | Conversion from scalar to vector
class SingleToMulti s t | s->t, t->s where
  singleToMulti :: s -> t

--------------------------------------------------------------------------------

omegaZeroError :: a
omegaZeroError :: a
omegaZeroError = String -> a
forall a. HasCallStack => String -> a
error String
"Omega^0 should not appear in the algorithm"

-- | replicating points (power map)
class Omega a where
  omega :: Int -> a -> a

--------------------------------------------------------------------------------

-- | @Omega^{1,2,3,...}@
class Omega123 a where
  omega123 :: a -> a

--------------------------------------------------------------------------------

-- | The merging (or multiplication) map
class Psi t s | t->s where
  psi :: t -> s

--------------------------------------------------------------------------------

-- | The interleaved pairwise merging map
class PsiEvenOdd t where
  psiEvenOdd :: t -> t

--------------------------------------------------------------------------------

-- | Pontrjagin ring
class Pontrjagin a where
  pontrjaginOne :: a 
  pontrjaginMul :: a -> a -> a

--------------------------------------------------------------------------------

class ExtendToCommonSize a where
  extendToCommonSize :: (a,a) -> (a,a)

instance Empty a => ExtendToCommonSize [a] where
  extendToCommonSize :: ([a], [a]) -> ([a], [a])
extendToCommonSize ([a]
xs,[a]
ys) = ([a]
xs',[a]
ys') where
    a :: Int
a = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
    b :: Int
b = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
b
    xs' :: [a]
xs' = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
a) a
forall a. Empty a => a
empty
    ys' :: [a]
ys' = [a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
b) a
forall a. Empty a => a
empty

--------------------------------------------------------------------------------

-- | Applying permutations
class Permute a where
  permute :: Permutation -> a -> a

instance Permute [a] where
  permute :: Permutation -> [a] -> [a]
permute = Permutation -> [a] -> [a]
forall a. Permutation -> [a] -> [a]
permuteList

--------------------------------------------------------------------------------

-- | The custom pusforward @Theta@ appearing in the algorithm
--
-- we subdivide the input as @[z;x1,y1,x2,y2,x3,y3...]@
-- and then duplicate each of @y1,y2,y3...@, then combine the left copies of @y_i@ with
-- @z@, and the right copies of @y_i@ with the corresponding @x_i@-s, resulting in
-- @[z*y1*y2*...;x1*y1,x2*y2,...]@
class Theta a where
  theta :: a -> a       --mypf :: a -> a

--------------------------------------------------------------------------------