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

    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}

    -- |A module defining the affine plane and its symmetries
    module Math.Algebras.AffinePlane where

    import Math.Algebra.Field.Base hiding (powers)
    import Math.Algebras.VectorSpace
    import Math.Algebras.TensorProduct
    import Math.Algebras.Structures
    import Math.Algebras.Commutative

    data XY = X | Y deriving (XY -> XY -> Bool
    (XY -> XY -> Bool) -> (XY -> XY -> Bool) -> Eq XY
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: XY -> XY -> Bool
    $c/= :: XY -> XY -> Bool
    == :: XY -> XY -> Bool
    $c== :: XY -> XY -> Bool
    Eq, Eq XY
    Eq XY =>
    (XY -> XY -> Ordering)
    -> (XY -> XY -> Bool)
    -> (XY -> XY -> Bool)
    -> (XY -> XY -> Bool)
    -> (XY -> XY -> Bool)
    -> (XY -> XY -> XY)
    -> (XY -> XY -> XY)
    -> Ord XY
    XY -> XY -> Bool
    XY -> XY -> Ordering
    XY -> XY -> XY
    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 :: XY -> XY -> XY
    $cmin :: XY -> XY -> XY
    max :: XY -> XY -> XY
    $cmax :: XY -> XY -> XY
    >= :: XY -> XY -> Bool
    $c>= :: XY -> XY -> Bool
    > :: XY -> XY -> Bool
    $c> :: XY -> XY -> Bool
    <= :: XY -> XY -> Bool
    $c<= :: XY -> XY -> Bool
    < :: XY -> XY -> Bool
    $c< :: XY -> XY -> Bool
    compare :: XY -> XY -> Ordering
    $ccompare :: XY -> XY -> Ordering
    $cp1Ord :: Eq XY
    Ord)

    instance Show XY where show :: XY -> String
    show X = "x"; show Y = "y"

    x :: GlexPoly Q XY
    x = XY -> GlexPoly Q XY
    forall k v. Num k => v -> GlexPoly k v
    glexVar XY
    X :: GlexPoly Q XY
    y :: GlexPoly Q XY
    y = XY -> GlexPoly Q XY
    forall k v. Num k => v -> GlexPoly k v
    glexVar XY
    Y :: GlexPoly Q XY

    data ABCD = A | B | C | D deriving (ABCD -> ABCD -> Bool
    (ABCD -> ABCD -> Bool) -> (ABCD -> ABCD -> Bool) -> Eq ABCD
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ABCD -> ABCD -> Bool
    $c/= :: ABCD -> ABCD -> Bool
    == :: ABCD -> ABCD -> Bool
    $c== :: ABCD -> ABCD -> Bool
    Eq, Eq ABCD
    Eq ABCD =>
    (ABCD -> ABCD -> Ordering)
    -> (ABCD -> ABCD -> Bool)
    -> (ABCD -> ABCD -> Bool)
    -> (ABCD -> ABCD -> Bool)
    -> (ABCD -> ABCD -> Bool)
    -> (ABCD -> ABCD -> ABCD)
    -> (ABCD -> ABCD -> ABCD)
    -> Ord ABCD
    ABCD -> ABCD -> Bool
    ABCD -> ABCD -> Ordering
    ABCD -> ABCD -> ABCD
    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 :: ABCD -> ABCD -> ABCD
    $cmin :: ABCD -> ABCD -> ABCD
    max :: ABCD -> ABCD -> ABCD
    $cmax :: ABCD -> ABCD -> ABCD
    >= :: ABCD -> ABCD -> Bool
    $c>= :: ABCD -> ABCD -> Bool
    > :: ABCD -> ABCD -> Bool
    $c> :: ABCD -> ABCD -> Bool
    <= :: ABCD -> ABCD -> Bool
    $c<= :: ABCD -> ABCD -> Bool
    < :: ABCD -> ABCD -> Bool
    $c< :: ABCD -> ABCD -> Bool
    compare :: ABCD -> ABCD -> Ordering
    $ccompare :: ABCD -> ABCD -> Ordering
    $cp1Ord :: Eq ABCD
    Ord)

    instance Show ABCD where show :: ABCD -> String
    show A = "a"; show B = "b"; show C = "c"; show D = "d"

    a,b,c,d :: Monomial m => Vect Q (m ABCD)
    a :: Vect Q (m ABCD)
    a = ABCD -> Vect Q (m ABCD)
    forall (m :: * -> *) v. Monomial m => v -> Vect Q (m v)
    var ABCD
    A
    b :: Vect Q (m ABCD)
    b = ABCD -> Vect Q (m ABCD)
    forall (m :: * -> *) v. Monomial m => v -> Vect Q (m v)
    var ABCD
    B
    c :: Vect Q (m ABCD)
    c = ABCD -> Vect Q (m ABCD)
    forall (m :: * -> *) v. Monomial m => v -> Vect Q (m v)
    var ABCD
    C
    d :: Vect Q (m ABCD)
    d = ABCD -> Vect Q (m ABCD)
    forall (m :: * -> *) v. Monomial m => v -> Vect Q (m v)
    var ABCD
    D

    -- SL2

    newtype SL2 v = SL2 (GlexMonomial v) deriving (SL2 v -> SL2 v -> Bool
    (SL2 v -> SL2 v -> Bool) -> (SL2 v -> SL2 v -> Bool) -> Eq (SL2 v)
    forall v. Eq v => SL2 v -> SL2 v -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SL2 v -> SL2 v -> Bool
    $c/= :: forall v. Eq v => SL2 v -> SL2 v -> Bool
    == :: SL2 v -> SL2 v -> Bool
    $c== :: forall v. Eq v => SL2 v -> SL2 v -> Bool
    Eq,Eq (SL2 v)
    Eq (SL2 v) =>
    (SL2 v -> SL2 v -> Ordering)
    -> (SL2 v -> SL2 v -> Bool)
    -> (SL2 v -> SL2 v -> Bool)
    -> (SL2 v -> SL2 v -> Bool)
    -> (SL2 v -> SL2 v -> Bool)
    -> (SL2 v -> SL2 v -> SL2 v)
    -> (SL2 v -> SL2 v -> SL2 v)
    -> Ord (SL2 v)
    SL2 v -> SL2 v -> Bool
    SL2 v -> SL2 v -> Ordering
    SL2 v -> SL2 v -> SL2 v
    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 v. Ord v => Eq (SL2 v)
    forall v. Ord v => SL2 v -> SL2 v -> Bool
    forall v. Ord v => SL2 v -> SL2 v -> Ordering
    forall v. Ord v => SL2 v -> SL2 v -> SL2 v
    min :: SL2 v -> SL2 v -> SL2 v
    $cmin :: forall v. Ord v => SL2 v -> SL2 v -> SL2 v
    max :: SL2 v -> SL2 v -> SL2 v
    $cmax :: forall v. Ord v => SL2 v -> SL2 v -> SL2 v
    >= :: SL2 v -> SL2 v -> Bool
    $c>= :: forall v. Ord v => SL2 v -> SL2 v -> Bool
    > :: SL2 v -> SL2 v -> Bool
    $c> :: forall v. Ord v => SL2 v -> SL2 v -> Bool
    <= :: SL2 v -> SL2 v -> Bool
    $c<= :: forall v. Ord v => SL2 v -> SL2 v -> Bool
    < :: SL2 v -> SL2 v -> Bool
    $c< :: forall v. Ord v => SL2 v -> SL2 v -> Bool
    compare :: SL2 v -> SL2 v -> Ordering
    $ccompare :: forall v. Ord v => SL2 v -> SL2 v -> Ordering
    $cp1Ord :: forall v. Ord v => Eq (SL2 v)
    Ord)

    instance Show v => Show (SL2 v) where show :: SL2 v -> String
    show (SL2 m :: GlexMonomial v
    m) = GlexMonomial v -> String
    forall a. Show a => a -> String
    show GlexMonomial v
    m

    instance Algebra Q (SL2 ABCD) where -- to do this for Num k instead of Q we would need a,b,c,d defined for Num k
        unit :: Q -> Vect Q (SL2 ABCD)
    unit 0 = Vect Q (SL2 ABCD)
    forall k b. Vect k b
    zerov -- V []
        unit x :: Q
    x = [(SL2 ABCD, Q)] -> Vect Q (SL2 ABCD)
    forall k b. [(b, k)] -> Vect k b
    V [(SL2 ABCD
    forall v. SL2 v
    munit,Q
    x)] where munit :: SL2 v
    munit = GlexMonomial v -> SL2 v
    forall v. GlexMonomial v -> SL2 v
    SL2 (Int -> [(v, Int)] -> GlexMonomial v
    forall v. Int -> [(v, Int)] -> GlexMonomial v
    Glex 0 [])
        mult :: Vect Q (Tensor (SL2 ABCD) (SL2 ABCD)) -> Vect Q (SL2 ABCD)
    mult x :: Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    x = Vect Q (SL2 ABCD)
    x''' where
            x' :: Vect Q (GlexMonomial ABCD)
    x' = Vect Q (Tensor (GlexMonomial ABCD) (GlexMonomial ABCD))
    -> Vect Q (GlexMonomial ABCD)
    forall k b. Algebra k b => Vect k (Tensor b b) -> Vect k b
    mult (Vect Q (Tensor (GlexMonomial ABCD) (GlexMonomial ABCD))
     -> Vect Q (GlexMonomial ABCD))
    -> Vect Q (Tensor (GlexMonomial ABCD) (GlexMonomial ABCD))
    -> Vect Q (GlexMonomial ABCD)
    forall a b. (a -> b) -> a -> b
    $ (Tensor (SL2 ABCD) (SL2 ABCD)
     -> Tensor (GlexMonomial ABCD) (GlexMonomial ABCD))
    -> Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    -> Vect Q (Tensor (GlexMonomial ABCD) (GlexMonomial ABCD))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ( \(SL2 a :: GlexMonomial ABCD
    a, SL2 b :: GlexMonomial ABCD
    b) -> (GlexMonomial ABCD
    a,GlexMonomial ABCD
    b) ) Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    x -- perform the multiplication in GlexPoly
            x'' :: Vect Q (GlexMonomial ABCD)
    x'' = Vect Q (GlexMonomial ABCD)
    x' Vect Q (GlexMonomial ABCD)
    -> [Vect Q (GlexMonomial ABCD)] -> Vect Q (GlexMonomial ABCD)
    forall k b.
    (Eq k, Fractional k, Ord b, Show b, Algebra k b,
     DivisionBasis b) =>
    Vect k b -> [Vect k b] -> Vect k b
    %% [Vect Q (GlexMonomial ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    aVect Q (GlexMonomial ABCD)
    -> Vect Q (GlexMonomial ABCD) -> Vect Q (GlexMonomial ABCD)
    forall a. Num a => a -> a -> a
    *Vect Q (GlexMonomial ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    dVect Q (GlexMonomial ABCD)
    -> Vect Q (GlexMonomial ABCD) -> Vect Q (GlexMonomial ABCD)
    forall a. Num a => a -> a -> a
    -Vect Q (GlexMonomial ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    bVect Q (GlexMonomial ABCD)
    -> Vect Q (GlexMonomial ABCD) -> Vect Q (GlexMonomial ABCD)
    forall a. Num a => a -> a -> a
    *Vect Q (GlexMonomial ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    cVect Q (GlexMonomial ABCD)
    -> Vect Q (GlexMonomial ABCD) -> Vect Q (GlexMonomial ABCD)
    forall a. Num a => a -> a -> a
    -1] -- :: GlexPoly Q ABCD] -- quotient by ad-bc=1 in GlexPoly Q ABCD
            x''' :: Vect Q (SL2 ABCD)
    x''' = (GlexMonomial ABCD -> SL2 ABCD)
    -> Vect Q (GlexMonomial ABCD) -> Vect Q (SL2 ABCD)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GlexMonomial ABCD -> SL2 ABCD
    forall v. GlexMonomial v -> SL2 v
    SL2 Vect Q (GlexMonomial ABCD)
    x'' -- ie wrap the monomials up as SL2 again
            -- mmult (Glex si xis) (Glex sj yjs) = Glex (si+sj) $ addmerge xis yjs

    sl2Var :: v -> Vect k (SL2 v)
    sl2Var v :: v
    v = [(SL2 v, k)] -> Vect k (SL2 v)
    forall k b. [(b, k)] -> Vect k b
    V [(GlexMonomial v -> SL2 v
    forall v. GlexMonomial v -> SL2 v
    SL2 (Int -> [(v, Int)] -> GlexMonomial v
    forall v. Int -> [(v, Int)] -> GlexMonomial v
    Glex 1 [(v
    v,1)]), 1)] -- :: Vect Q (SL2 ABCD)

    -- For example:
    -- > a*d :: Vect Q (SL2 ABCD)
    -- bc+1

    instance Monomial SL2 where
        var :: v -> Vect Q (SL2 v)
    var = v -> Vect Q (SL2 v)
    forall k v. Num k => v -> Vect k (SL2 v)
    sl2Var
        powers :: SL2 v -> [(v, Int)]
    powers (SL2 (Glex _ xis :: [(v, Int)]
    xis)) = [(v, Int)]
    xis

    instance Coalgebra Q (SL2 ABCD) where
        counit :: Vect Q (SL2 ABCD) -> Q
    counit x :: Vect Q (SL2 ABCD)
    x = case Vect Q (SL2 ABCD)
    x Vect Q (SL2 ABCD)
    -> (ABCD -> Vect Q (SL2 ABCD)) -> Vect Q (SL2 ABCD)
    forall (m :: * -> *) k b v.
    (Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
    Vect k (m v) -> (v -> Vect k b) -> Vect k b
    `bind` ABCD -> Vect Q (SL2 ABCD)
    cu of
                   V [] -> 0
                   V [(SL2 (Glex 0 []), c :: Q
    c)] -> Q
    c
            where cu :: ABCD -> Vect Q (SL2 ABCD)
    cu A = 1 :: Vect Q (SL2 ABCD)
                  cu B = 0
                  cu C = 0
                  cu D = 1
        comult :: Vect Q (SL2 ABCD) -> Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    comult x :: Vect Q (SL2 ABCD)
    x = Vect Q (SL2 ABCD)
    x Vect Q (SL2 ABCD)
    -> (ABCD -> Vect Q (Tensor (SL2 ABCD) (SL2 ABCD)))
    -> Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    forall (m :: * -> *) k b v.
    (Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
    Vect k (m v) -> (v -> Vect k b) -> Vect k b
    `bind` ABCD -> Vect Q (Tensor (SL2 ABCD) (SL2 ABCD))
    forall (m :: * -> *) (m :: * -> *).
    (Ord (m ABCD), Ord (m ABCD), Show (m ABCD), Show (m ABCD),
     Algebra Q (m ABCD), Algebra Q (m ABCD), Monomial m, Monomial m) =>
    ABCD -> Vect Q (Tensor (m ABCD) (m ABCD))
    cm
            where cm :: ABCD -> Vect Q (Tensor (m ABCD) (m ABCD))
    cm A = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    a Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    a Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall a. Num a => a -> a -> a
    + Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    b Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    c
                  cm B = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    a Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    b Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall a. Num a => a -> a -> a
    + Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    b Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    d
                  cm C = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    c Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    a Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall a. Num a => a -> a -> a
    + Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    d Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    c
                  cm D = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    c Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    b Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall a. Num a => a -> a -> a
    + Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    d Vect Q (m ABCD)
    -> Vect Q (m ABCD) -> Vect Q (Tensor (m ABCD) (m ABCD))
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    d
    -- 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)

    instance Bialgebra Q (SL2 ABCD) where {}

    instance HopfAlgebra Q (SL2 ABCD) where
        antipode :: Vect Q (SL2 ABCD) -> Vect Q (SL2 ABCD)
    antipode x :: Vect Q (SL2 ABCD)
    x = Vect Q (SL2 ABCD)
    x Vect Q (SL2 ABCD)
    -> (ABCD -> Vect Q (SL2 ABCD)) -> Vect Q (SL2 ABCD)
    forall (m :: * -> *) k b v.
    (Monomial m, Eq k, Num k, Ord b, Show b, Algebra k b) =>
    Vect k (m v) -> (v -> Vect k b) -> Vect k b
    `bind` ABCD -> Vect Q (SL2 ABCD)
    forall (m :: * -> *).
    (Monomial m, Ord (m ABCD), Show (m ABCD), Algebra Q (m ABCD)) =>
    ABCD -> Vect Q (m ABCD)
    antipode'
            where antipode' :: ABCD -> Vect Q (m ABCD)
    antipode' A = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    d
                  antipode' B = -Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    b
                  antipode' C = -Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    c
                  antipode' D = Vect Q (m ABCD)
    forall (m :: * -> *). Monomial m => Vect Q (m ABCD)
    a
    -- in the GL2 case we would need 1/det factor as well