    -- Copyright (c) 2010-2015, David Amos. All rights reserved.

    {-# LANGUAGE  MultiParamTypeClasses, FlexibleInstances #-}

    module Math.Algebras.Matrix where

    import Prelude hiding ( (*>) )

    import Math.Algebra.Field.Base
    import Math.Algebras.VectorSpace
    import Math.Algebras.TensorProduct
    import Math.Algebras.Structures

    -- Mat2

    {-
    -- defined in Math.Algebras.TensorProduct
    delta i j | i == j    = 1
              | otherwise = 0
    -}

    data Mat2 = E2 Int Int deriving (Mat2 -> Mat2 -> Bool
    (Mat2 -> Mat2 -> Bool) -> (Mat2 -> Mat2 -> Bool) -> Eq Mat2
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Mat2 -> Mat2 -> Bool
    $c/= :: Mat2 -> Mat2 -> Bool
    == :: Mat2 -> Mat2 -> Bool
    $c== :: Mat2 -> Mat2 -> Bool
    Eq,Eq Mat2
    Eq Mat2 =>
    (Mat2 -> Mat2 -> Ordering)
    -> (Mat2 -> Mat2 -> Bool)
    -> (Mat2 -> Mat2 -> Bool)
    -> (Mat2 -> Mat2 -> Bool)
    -> (Mat2 -> Mat2 -> Bool)
    -> (Mat2 -> Mat2 -> Mat2)
    -> (Mat2 -> Mat2 -> Mat2)
    -> Ord Mat2
    Mat2 -> Mat2 -> Bool
    Mat2 -> Mat2 -> Ordering
    Mat2 -> Mat2 -> Mat2
    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 :: Mat2 -> Mat2 -> Mat2
    $cmin :: Mat2 -> Mat2 -> Mat2
    max :: Mat2 -> Mat2 -> Mat2
    $cmax :: Mat2 -> Mat2 -> Mat2
    >= :: Mat2 -> Mat2 -> Bool
    $c>= :: Mat2 -> Mat2 -> Bool
    > :: Mat2 -> Mat2 -> Bool
    $c> :: Mat2 -> Mat2 -> Bool
    <= :: Mat2 -> Mat2 -> Bool
    $c<= :: Mat2 -> Mat2 -> Bool
    < :: Mat2 -> Mat2 -> Bool
    $c< :: Mat2 -> Mat2 -> Bool
    compare :: Mat2 -> Mat2 -> Ordering
    $ccompare :: Mat2 -> Mat2 -> Ordering
    $cp1Ord :: Eq Mat2
    Ord,Int -> Mat2 -> ShowS
    [Mat2] -> ShowS
    Mat2 -> String
    (Int -> Mat2 -> ShowS)
    -> (Mat2 -> String) -> ([Mat2] -> ShowS) -> Show Mat2
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Mat2] -> ShowS
    $cshowList :: [Mat2] -> ShowS
    show :: Mat2 -> String
    $cshow :: Mat2 -> String
    showsPrec :: Int -> Mat2 -> ShowS
    $cshowsPrec :: Int -> Mat2 -> ShowS
    Show)
    -- E i j represents the elementary matrix with a 1 at the (i,j) position, and 0s elsewhere

    instance (Eq k, Num k) => Algebra k Mat2 where
        unit :: k -> Vect k Mat2
    unit x :: k
    x = k
    x k -> Vect k Mat2 -> Vect k Mat2
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> [(Mat2, k)] -> Vect k Mat2
    forall k b. [(b, k)] -> Vect k b
    V [(Int -> Int -> Mat2
    E2 Int
    i Int
    i, 1) | Int
    i <- [1..2] ]
        mult :: Vect k (Tensor Mat2 Mat2) -> Vect k Mat2
    mult = (Tensor Mat2 Mat2 -> Vect k Mat2)
    -> Vect k (Tensor Mat2 Mat2) -> Vect k Mat2
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear Tensor Mat2 Mat2 -> Vect k Mat2
    forall k. (Eq k, Num k) => Tensor Mat2 Mat2 -> Vect k Mat2
    mult' where
            mult' :: Tensor Mat2 Mat2 -> Vect k Mat2
    mult' (E2 i :: Int
    i j :: Int
    j, E2 k :: Int
    k l :: Int
    l) = Int -> Int -> k
    forall a p. (Eq a, Num p) => a -> a -> p
    delta Int
    j Int
    k k -> Vect k Mat2 -> Vect k Mat2
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> Mat2 -> Vect k Mat2
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int -> Mat2
    E2 Int
    i Int
    l)

    -- In other words
    -- unit x = x (1 0)
    --            (0 1)
    -- mult (a1 b1) `te` (a2 b2) = (a1 b1) * (a2 b2) = (a b)
    --      (c1 d1)      (c2 d2)   (c1 d1)   (c2 d2)   (c d)

    instance (Eq k, Num k) => Module k Mat2 EBasis where
        -- action ax = nf $ ax >>= action' where
        action :: Vect k (Tensor Mat2 EBasis) -> Vect k EBasis
    action = (Tensor Mat2 EBasis -> Vect k EBasis)
    -> Vect k (Tensor Mat2 EBasis) -> Vect k EBasis
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear Tensor Mat2 EBasis -> Vect k EBasis
    forall k. (Eq k, Num k) => Tensor Mat2 EBasis -> Vect k EBasis
    action' where
            action' :: Tensor Mat2 EBasis -> Vect k EBasis
    action' (E2 i :: Int
    i j :: Int
    j, E k :: Int
    k) = Int -> Int -> k
    forall a p. (Eq a, Num p) => a -> a -> p
    delta Int
    j Int
    k k -> Vect k EBasis -> Vect k EBasis
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    `smultL` EBasis -> Vect k EBasis
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i)

    -- In other words
    -- action (a b) `te` (x) = (ax+by)
    --        (c d)      (y)   (cx+dy)

    toMat2 :: [[k]] -> Vect k Mat2
    toMat2 [[a :: k
    a,b :: k
    b],[c :: k
    c,d :: k
    d]] = [Vect k Mat2] -> Vect k Mat2
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Vect k Mat2] -> Vect k Mat2) -> [Vect k Mat2] -> Vect k Mat2
    forall a b. (a -> b) -> a -> b
    $ (k -> Mat2 -> Vect k Mat2) -> [k] -> [Mat2] -> [Vect k Mat2]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\x :: k
    x e :: Mat2
    e -> k -> Vect k Mat2
    forall k b. Algebra k b => k -> Vect k b
    unit k
    x Vect k Mat2 -> Vect k Mat2 -> Vect k Mat2
    forall a. Num a => a -> a -> a
    * Mat2 -> Vect k Mat2
    forall (m :: * -> *) a. Monad m => a -> m a
    return Mat2
    e) [k
    a,k
    b,k
    c,k
    d] [Int -> Int -> Mat2
    E2 1 1, Int -> Int -> Mat2
    E2 1 2, Int -> Int -> Mat2
    E2 2 1, Int -> Int -> Mat2
    E2 2 2]
    -- fromMat2

    toEB2 :: [k] -> Vect k EBasis
    toEB2 [x :: k
    x,y :: k
    y] = (Vect k EBasis -> Vect k EBasis -> Vect k EBasis)
    -> Vect k EBasis -> [Vect k EBasis] -> Vect k EBasis
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Vect k EBasis -> Vect k EBasis -> Vect k EBasis
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    add Vect k EBasis
    forall k b. Vect k b
    zerov ([Vect k EBasis] -> Vect k EBasis)
    -> [Vect k EBasis] -> Vect k EBasis
    forall a b. (a -> b) -> a -> b
    $ (k -> EBasis -> Vect k EBasis)
    -> [k] -> [EBasis] -> [Vect k EBasis]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\x :: k
    x e :: EBasis
    e -> k
    x k -> Vect k EBasis -> Vect k EBasis
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    `smultL` EBasis -> Vect k EBasis
    forall (m :: * -> *) a. Monad m => a -> m a
    return EBasis
    e) [k
    x,k
    y] [Int -> EBasis
    E 1, Int -> EBasis
    E 2]

    toEB :: [k] -> Vect k EBasis
    toEB xs :: [k]
    xs = (Vect k EBasis -> Vect k EBasis -> Vect k EBasis)
    -> Vect k EBasis -> [Vect k EBasis] -> Vect k EBasis
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Vect k EBasis -> Vect k EBasis -> Vect k EBasis
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    add Vect k EBasis
    forall k b. Vect k b
    zerov ([Vect k EBasis] -> Vect k EBasis)
    -> [Vect k EBasis] -> Vect k EBasis
    forall a b. (a -> b) -> a -> b
    $ (k -> EBasis -> Vect k EBasis)
    -> [k] -> [EBasis] -> [Vect k EBasis]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\x :: k
    x e :: EBasis
    e -> k
    x k -> Vect k EBasis -> Vect k EBasis
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    `smultL` EBasis -> Vect k EBasis
    forall (m :: * -> *) a. Monad m => a -> m a
    return EBasis
    e) [k]
    xs ((Int -> EBasis) -> [Int] -> [EBasis]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> EBasis
    E [1..])

    data Mat2' = E2' Int Int deriving (Mat2' -> Mat2' -> Bool
    (Mat2' -> Mat2' -> Bool) -> (Mat2' -> Mat2' -> Bool) -> Eq Mat2'
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Mat2' -> Mat2' -> Bool
    $c/= :: Mat2' -> Mat2' -> Bool
    == :: Mat2' -> Mat2' -> Bool
    $c== :: Mat2' -> Mat2' -> Bool
    Eq,Eq Mat2'
    Eq Mat2' =>
    (Mat2' -> Mat2' -> Ordering)
    -> (Mat2' -> Mat2' -> Bool)
    -> (Mat2' -> Mat2' -> Bool)
    -> (Mat2' -> Mat2' -> Bool)
    -> (Mat2' -> Mat2' -> Bool)
    -> (Mat2' -> Mat2' -> Mat2')
    -> (Mat2' -> Mat2' -> Mat2')
    -> Ord Mat2'
    Mat2' -> Mat2' -> Bool
    Mat2' -> Mat2' -> Ordering
    Mat2' -> Mat2' -> Mat2'
    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 :: Mat2' -> Mat2' -> Mat2'
    $cmin :: Mat2' -> Mat2' -> Mat2'
    max :: Mat2' -> Mat2' -> Mat2'
    $cmax :: Mat2' -> Mat2' -> Mat2'
    >= :: Mat2' -> Mat2' -> Bool
    $c>= :: Mat2' -> Mat2' -> Bool
    > :: Mat2' -> Mat2' -> Bool
    $c> :: Mat2' -> Mat2' -> Bool
    <= :: Mat2' -> Mat2' -> Bool
    $c<= :: Mat2' -> Mat2' -> Bool
    < :: Mat2' -> Mat2' -> Bool
    $c< :: Mat2' -> Mat2' -> Bool
    compare :: Mat2' -> Mat2' -> Ordering
    $ccompare :: Mat2' -> Mat2' -> Ordering
    $cp1Ord :: Eq Mat2'
    Ord,Int -> Mat2' -> ShowS
    [Mat2'] -> ShowS
    Mat2' -> String
    (Int -> Mat2' -> ShowS)
    -> (Mat2' -> String) -> ([Mat2'] -> ShowS) -> Show Mat2'
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Mat2'] -> ShowS
    $cshowList :: [Mat2'] -> ShowS
    show :: Mat2' -> String
    $cshow :: Mat2' -> String
    showsPrec :: Int -> Mat2' -> ShowS
    $cshowsPrec :: Int -> Mat2' -> ShowS
    Show)
    -- E2' i j represents the dual basis element corresponding to E i j

    -- Kassel p42
    instance (Eq k, Num k) => Coalgebra k Mat2' where
        counit :: Vect k Mat2' -> k
    counit (V ts :: [(Mat2', k)]
    ts) = [k] -> k
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [k
    xij k -> k -> k
    forall a. Num a => a -> a -> a
    * Int -> Int -> k
    forall a p. (Eq a, Num p) => a -> a -> p
    delta Int
    i Int
    j | (E2' i :: Int
    i j :: Int
    j, xij :: k
    xij) <- [(Mat2', k)]
    ts]
        -- comult (V ts) = V $ concatMap (\(E2' i j,xij) -> [(T (E2' i k) (E2' k j), xij) | k <- [1..2]]) ts
        comult :: Vect k Mat2' -> Vect k (Tensor Mat2' Mat2')
    comult = (Mat2' -> Vect k (Tensor Mat2' Mat2'))
    -> Vect k Mat2' -> Vect k (Tensor Mat2' Mat2')
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear (\(E2' i :: Int
    i j :: Int
    j) -> (Vect k (Tensor Mat2' Mat2')
     -> Vect k (Tensor Mat2' Mat2') -> Vect k (Tensor Mat2' Mat2'))
    -> Vect k (Tensor Mat2' Mat2')
    -> [Vect k (Tensor Mat2' Mat2')]
    -> Vect k (Tensor Mat2' Mat2')
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Vect k (Tensor Mat2' Mat2')
    -> Vect k (Tensor Mat2' Mat2') -> Vect k (Tensor Mat2' Mat2')
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    (<+>) Vect k (Tensor Mat2' Mat2')
    forall k b. Vect k b
    zerov [Tensor Mat2' Mat2' -> Vect k (Tensor Mat2' Mat2')
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int -> Mat2'
    E2' Int
    i Int
    k, Int -> Int -> Mat2'
    E2' Int
    k Int
    j) | Int
    k <- [1..2]])
    -- In other words
    -- counit (a b) = (1 0)
    --        (c d)   (0 1)
    -- comult (a b) = (a1 b1) `te` (a2 b2)
    --        (c d)   (c1 d1)      (c2 d2)
    -- ??
    -- ?? How does this act on Mat2?
    -- ?? What is the relationship between this and SL2 ABCD, which it seems to resemble

    data M3 = E3 Int Int deriving (M3 -> M3 -> Bool
    (M3 -> M3 -> Bool) -> (M3 -> M3 -> Bool) -> Eq M3
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: M3 -> M3 -> Bool
    $c/= :: M3 -> M3 -> Bool
    == :: M3 -> M3 -> Bool
    $c== :: M3 -> M3 -> Bool
    Eq,Eq M3
    Eq M3 =>
    (M3 -> M3 -> Ordering)
    -> (M3 -> M3 -> Bool)
    -> (M3 -> M3 -> Bool)
    -> (M3 -> M3 -> Bool)
    -> (M3 -> M3 -> Bool)
    -> (M3 -> M3 -> M3)
    -> (M3 -> M3 -> M3)
    -> Ord M3
    M3 -> M3 -> Bool
    M3 -> M3 -> Ordering
    M3 -> M3 -> M3
    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 :: M3 -> M3 -> M3
    $cmin :: M3 -> M3 -> M3
    max :: M3 -> M3 -> M3
    $cmax :: M3 -> M3 -> M3
    >= :: M3 -> M3 -> Bool
    $c>= :: M3 -> M3 -> Bool
    > :: M3 -> M3 -> Bool
    $c> :: M3 -> M3 -> Bool
    <= :: M3 -> M3 -> Bool
    $c<= :: M3 -> M3 -> Bool
    < :: M3 -> M3 -> Bool
    $c< :: M3 -> M3 -> Bool
    compare :: M3 -> M3 -> Ordering
    $ccompare :: M3 -> M3 -> Ordering
    $cp1Ord :: Eq M3
    Ord,Int -> M3 -> ShowS
    [M3] -> ShowS
    M3 -> String
    (Int -> M3 -> ShowS)
    -> (M3 -> String) -> ([M3] -> ShowS) -> Show M3
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [M3] -> ShowS
    $cshowList :: [M3] -> ShowS
    show :: M3 -> String
    $cshow :: M3 -> String
    showsPrec :: Int -> M3 -> ShowS
    $cshowsPrec :: Int -> M3 -> ShowS
    Show)
    -- E i j represents the elementary matrix with a 1 at the (i,j) position, and 0s elsewhere

    instance (Eq k, Num k) => Algebra k M3 where
        unit :: k -> Vect k M3
    unit 0 = Vect k M3
    forall k b. Vect k b
    zerov -- V []
        unit x :: k
    x = [(M3, k)] -> Vect k M3
    forall k b. [(b, k)] -> Vect k b
    V [(Int -> Int -> M3
    E3 Int
    i Int
    i, k
    x) | Int
    i <- [1..3] ]
        -- mult (V ts) = nf $ V $ map (\((E3 i j, E3 k l), x) -> (E3 i l, delta j k * x)) ts
        mult :: Vect k (Tensor M3 M3) -> Vect k M3
    mult = (Tensor M3 M3 -> Vect k M3) -> Vect k (Tensor M3 M3) -> Vect k M3
    forall k b a.
    (Eq k, Num k, Ord b) =>
    (a -> Vect k b) -> Vect k a -> Vect k b
    linear Tensor M3 M3 -> Vect k M3
    forall k. (Eq k, Num k) => Tensor M3 M3 -> Vect k M3
    mult' where
            mult' :: Tensor M3 M3 -> Vect k M3
    mult' (E3 i :: Int
    i j :: Int
    j, E3 k :: Int
    k l :: Int
    l) = Int -> Int -> k
    forall a p. (Eq a, Num p) => a -> a -> p
    delta Int
    j Int
    k k -> Vect k M3 -> Vect k M3
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> M3 -> Vect k M3
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int -> M3
    E3 Int
    i Int
    l)

    {-
    -- Kassel p42
    -- In this coalgebra instance, the E3 i j are to be interpreted as the dual basis, not the original basis
    instance Num k => Coalgebra k M3 where
        counit (V ts) = sum [xij * delta i j | (E3 i j, xij) <- ts]
        comult (V ts) = V $ concatMap (\(E3 i j,xij) -> [((E3 i k, E3 k j), xij) | k <- [1..3]]) ts
    -- (is this order preserving?)
    -}