{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Module      : OAlg.AbelianGroup.ZMod
-- Description : homomorphisms between cyclic groups
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- Homomorphisms between cyclic groups.
--
-- A group is called __/cyclic/__ if it is generated by one element.
-- Such a group @G@ is obviously abelian and isomorphic to @'Z'/n'Z'@ for some @n :: 'N'@,
-- which is called its __/order/__. The group homomorphisms between cyclic groups form a
-- 'Z'-algebraic structure which is presented here.
module OAlg.AbelianGroup.ZMod
  (
    
    -- * Cyclic Group
    ZMod(..), zmOrd

    -- * Homomorphism
  , ZModHom(), toZ, fromZ
  , zmh, zmhEligible
  , zmhGenOrd, zmhGenerator
  
    -- * X
    -- | Since the algebraic structure of 'ZModHom' is not balanced - which means that
    -- between any two cyclic groups there may be no nontrivial homomorphisms - it is
    -- appropriate to work with t'XOrtSite' instead of t'XOrtOrientation' for
    -- random variables with values in 'ZModHom'.
  , xZModHom, xZModHomTo, xZModHomFrom
  , xZModTo, xZModFrom

    -- * Proposition
  , prpZModHom

    -- * Exception
  , ZModException(..)  
  )
  where

import Control.Monad
import Control.Exception

import Data.List ((++),foldl)

import OAlg.Prelude

import OAlg.Control.Solver

import OAlg.Data.Canonical

import OAlg.Structure.Exception
import OAlg.Structure.Oriented
import OAlg.Structure.Multiplicative
import OAlg.Structure.Fibred
import OAlg.Structure.Additive
import OAlg.Structure.Vectorial
import OAlg.Structure.Distributive
import OAlg.Structure.Algebraic

import OAlg.AbelianGroup.Euclid
import OAlg.Entity.Product

--------------------------------------------------------------------------------
-- ZModException -

-- | exceptions for cyclic groups which are sub exceptions from 'SomeOAlgException'.
data ZModException
  = NotEligible String
  deriving (ZModException -> ZModException -> Bool
(ZModException -> ZModException -> Bool)
-> (ZModException -> ZModException -> Bool) -> Eq ZModException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZModException -> ZModException -> Bool
== :: ZModException -> ZModException -> Bool
$c/= :: ZModException -> ZModException -> Bool
/= :: ZModException -> ZModException -> Bool
Eq,Int -> ZModException -> ShowS
[ZModException] -> ShowS
ZModException -> String
(Int -> ZModException -> ShowS)
-> (ZModException -> String)
-> ([ZModException] -> ShowS)
-> Show ZModException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ZModException -> ShowS
showsPrec :: Int -> ZModException -> ShowS
$cshow :: ZModException -> String
show :: ZModException -> String
$cshowList :: [ZModException] -> ShowS
showList :: [ZModException] -> ShowS
Show)

instance Exception ZModException where
  toException :: ZModException -> SomeException
toException   = ZModException -> SomeException
forall e. Exception e => e -> SomeException
oalgExceptionToException
  fromException :: SomeException -> Maybe ZModException
fromException = SomeException -> Maybe ZModException
forall e. Exception e => SomeException -> Maybe e
oalgExceptionFromException


--------------------------------------------------------------------------------
-- ZMod -

-- | cyclic group @'Z'\/n@, i.e. the quotient group of 'Z' /divided/
--   by @n'Z'@.
newtype ZMod = ZMod N deriving (ZMod -> ZMod -> Bool
(ZMod -> ZMod -> Bool) -> (ZMod -> ZMod -> Bool) -> Eq ZMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZMod -> ZMod -> Bool
== :: ZMod -> ZMod -> Bool
$c/= :: ZMod -> ZMod -> Bool
/= :: ZMod -> ZMod -> Bool
Eq,Eq ZMod
Eq ZMod =>
(ZMod -> ZMod -> Ordering)
-> (ZMod -> ZMod -> Bool)
-> (ZMod -> ZMod -> Bool)
-> (ZMod -> ZMod -> Bool)
-> (ZMod -> ZMod -> Bool)
-> (ZMod -> ZMod -> ZMod)
-> (ZMod -> ZMod -> ZMod)
-> Ord ZMod
ZMod -> ZMod -> Bool
ZMod -> ZMod -> Ordering
ZMod -> ZMod -> ZMod
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
$ccompare :: ZMod -> ZMod -> Ordering
compare :: ZMod -> ZMod -> Ordering
$c< :: ZMod -> ZMod -> Bool
< :: ZMod -> ZMod -> Bool
$c<= :: ZMod -> ZMod -> Bool
<= :: ZMod -> ZMod -> Bool
$c> :: ZMod -> ZMod -> Bool
> :: ZMod -> ZMod -> Bool
$c>= :: ZMod -> ZMod -> Bool
>= :: ZMod -> ZMod -> Bool
$cmax :: ZMod -> ZMod -> ZMod
max :: ZMod -> ZMod -> ZMod
$cmin :: ZMod -> ZMod -> ZMod
min :: ZMod -> ZMod -> ZMod
Ord,ZMod -> Statement
(ZMod -> Statement) -> Validable ZMod
forall a. (a -> Statement) -> Validable a
$cvalid :: ZMod -> Statement
valid :: ZMod -> Statement
Validable,Eq ZMod
Show ZMod
Typeable ZMod
Validable ZMod
(Show ZMod, Eq ZMod, Validable ZMod, Typeable ZMod) => Entity ZMod
forall a. (Show a, Eq a, Validable a, Typeable a) => Entity a
Entity)

instance Show ZMod where
  show :: ZMod -> String
show (ZMod N
n) = case N
n of
    N
0 -> String
"Z"
    N
_ -> String
"Z/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ N -> String
forall a. Show a => a -> String
show N
n


--------------------------------------------------------------------------------
-- zm -

zm0, zm1 :: ZMod
zm0 :: ZMod
zm0 = N -> ZMod
ZMod N
0
zm1 :: ZMod
zm1 = N -> ZMod
ZMod N
1

--------------------------------------------------------------------------------
-- zmOrd -

-- | order of the cyclic group.
zmOrd :: ZMod -> N
zmOrd :: ZMod -> N
zmOrd (ZMod N
n) = N
n

--------------------------------------------------------------------------------
-- ZModHom -

-- | additive homomorphisms between cyclic groups 'ZMod' constructable via 'zmh'.
--
-- __Note__ The homomorphisms between two cyclic groups @a@ and @b@ form again a cyclic
-- group which will be denoted by @'ZModHom' (a':>'b)@ (see 'zmhGenOrd').
data ZModHom = ZModHom !ZMod !ZMod !Z deriving (ZModHom -> ZModHom -> Bool
(ZModHom -> ZModHom -> Bool)
-> (ZModHom -> ZModHom -> Bool) -> Eq ZModHom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ZModHom -> ZModHom -> Bool
== :: ZModHom -> ZModHom -> Bool
$c/= :: ZModHom -> ZModHom -> Bool
/= :: ZModHom -> ZModHom -> Bool
Eq,Eq ZModHom
Eq ZModHom =>
(ZModHom -> ZModHom -> Ordering)
-> (ZModHom -> ZModHom -> Bool)
-> (ZModHom -> ZModHom -> Bool)
-> (ZModHom -> ZModHom -> Bool)
-> (ZModHom -> ZModHom -> Bool)
-> (ZModHom -> ZModHom -> ZModHom)
-> (ZModHom -> ZModHom -> ZModHom)
-> Ord ZModHom
ZModHom -> ZModHom -> Bool
ZModHom -> ZModHom -> Ordering
ZModHom -> ZModHom -> ZModHom
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
$ccompare :: ZModHom -> ZModHom -> Ordering
compare :: ZModHom -> ZModHom -> Ordering
$c< :: ZModHom -> ZModHom -> Bool
< :: ZModHom -> ZModHom -> Bool
$c<= :: ZModHom -> ZModHom -> Bool
<= :: ZModHom -> ZModHom -> Bool
$c> :: ZModHom -> ZModHom -> Bool
> :: ZModHom -> ZModHom -> Bool
$c>= :: ZModHom -> ZModHom -> Bool
>= :: ZModHom -> ZModHom -> Bool
$cmax :: ZModHom -> ZModHom -> ZModHom
max :: ZModHom -> ZModHom -> ZModHom
$cmin :: ZModHom -> ZModHom -> ZModHom
min :: ZModHom -> ZModHom -> ZModHom
Ord)

instance Show ZModHom where
  show :: ZModHom -> String
show (ZModHom (ZMod N
0) (ZMod N
0) Z
z) = Z -> String
forall a. Show a => a -> String
show Z
z
  show (ZModHom ZMod
_ ZMod
_ Z
z)               = String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Z -> String
forall a. Show a => a -> String
show Z
z String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

--------------------------------------------------------------------------------
-- toZ -

-- | the underlying integer.
toZ :: ZModHom -> Z
toZ :: ZModHom -> Z
toZ (ZModHom ZMod
_ ZMod
_ Z
r) = Z
r

--------------------------------------------------------------------------------
-- fromZ -

-- | the endomorphism in @'ZMod' 0@ given by the integer, i.e. the inverse of 'toZ'.
fromZ :: Z -> ZModHom
fromZ :: Z -> ZModHom
fromZ Z
r = ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
zm0 ZMod
zm0 Z
r

--------------------------------------------------------------------------------
-- zmhEligible -

-- | predicate to determine the eligibility of a value in 'Z' to induce a homomorphism
-- between the given cyclic groups.
--
-- __Property__ Let @a = 'ZMod' a'@, @b = 'ZMod' b'@ be in 'ZMod' and @r@ in 'Z',
-- then holds: @'zmhEligible' a b r@ is true if and only if
-- @'mod0' (r '*' 'inj' a') b' '==' 0@.
zmhEligible :: ZMod -> ZMod -> Z -> Bool
zmhEligible :: ZMod -> ZMod -> Z -> Bool
zmhEligible (ZMod N
a) (ZMod N
b) Z
r = Z -> N -> Z
mod0 (Z
r Z -> Z -> Z
forall c. Multiplicative c => c -> c -> c
* N -> Z
forall a b. Embeddable a b => a -> b
inj N
a) N
b Z -> Z -> Bool
forall a. Eq a => a -> a -> Bool
== Z
0

instance Validable ZModHom where
  valid :: ZModHom -> Statement
valid (ZModHom ZMod
a ZMod
b Z
r) = String -> Label
Label String
"ZModHom" Label -> Statement -> Statement
:<=>:
    [Statement] -> Statement
And [ (ZMod, ZMod, Z) -> Statement
forall a. Validable a => a -> Statement
valid (ZMod
a,ZMod
b,Z
r)
        , ZMod -> ZMod -> Z -> Bool
zmhEligible ZMod
a ZMod
b Z
r Bool -> Message -> Statement
:?> [Parameter] -> Message
Params [String
"(a,b,r)"String -> String -> Parameter
:= (ZMod, ZMod, Z) -> String
forall a. Show a => a -> String
show (ZMod
a,ZMod
b,Z
r)]
        ]

instance Entity ZModHom

--------------------------------------------------------------------------------
-- zmhMod -

-- | reduction to normal form.
zmhMod :: ZModHom -> ZModHom
zmhMod :: ZModHom -> ZModHom
zmhMod (ZModHom ZMod
a ZMod
b Z
r) = ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (Z -> N -> Z
mod0 Z
r (ZMod -> N
zmOrd ZMod
b))

-------------------------------------------------------------------------------
-- zmh -

-- | the induced homomorphism.
--
-- __Property__ Let @a@, @b@ be in 'ZMod' and @r@ in 'Z' then holds:
--
-- (1) @'zmh' a b r@ is 'valid' if and only if @'zmhEligible' a b r@ is true.
--
-- (2) If @'zmhEligible' a b r@ is false then the evaluation of @'zmh' a b r@ will
-- end up by throwing a 'NotEligible'-exception.
zmh :: Orientation ZMod -> Z -> ZModHom
zmh :: Orientation ZMod -> Z -> ZModHom
zmh o :: Orientation ZMod
o@(ZMod
a :> ZMod
b) Z
r | ZMod -> ZMod -> Z -> Bool
zmhEligible ZMod
a ZMod
b Z
r = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b Z
r)
                 | Bool
otherwise         = ZModException -> ZModHom
forall a e. Exception e => e -> a
throw (ZModException -> ZModHom) -> ZModException -> ZModHom
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ String -> ZModException
NotEligible (String -> ZModException) -> String -> ZModException
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ (Orientation ZMod, Z) -> String
forall a. Show a => a -> String
show (Orientation ZMod
o,Z
r)

--------------------------------------------------------------------------------
-- ZModHom - Algebraic -

instance Oriented ZModHom where
  type Point ZModHom = ZMod
  orientation :: ZModHom -> Orientation (Point ZModHom)
orientation (ZModHom ZMod
a ZMod
b Z
_) = ZMod
aZMod -> ZMod -> Orientation ZMod
forall p. p -> p -> Orientation p
:>ZMod
b

instance Multiplicative ZModHom where
  one :: Point ZModHom -> ZModHom
one Point ZModHom
a = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom Point ZModHom
ZMod
a Point ZModHom
ZMod
a Z
1)
  ZModHom ZMod
b' ZMod
c Z
f * :: ZModHom -> ZModHom -> ZModHom
* ZModHom ZMod
a ZMod
b Z
g | ZMod
b' ZMod -> ZMod -> Bool
forall a. Eq a => a -> a -> Bool
== ZMod
b   = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
c (Z
fZ -> Z -> Z
forall c. Multiplicative c => c -> c -> c
*Z
g))
                                 | Bool
otherwise = ArithmeticException -> ZModHom
forall a e. Exception e => e -> a
throw ArithmeticException
NotMultiplicable

  npower :: ZModHom -> N -> ZModHom
npower ZModHom
h N
1 = ZModHom
h
  npower (ZModHom ZMod
a ZMod
b Z
r) N
n | ZMod
a ZMod -> ZMod -> Bool
forall a. Eq a => a -> a -> Bool
== ZMod
b    = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
a (Z -> N -> Z
forall c. Multiplicative c => c -> N -> c
npower Z
r N
n))
                           | Bool
otherwise = ArithmeticException -> ZModHom
forall a e. Exception e => e -> a
throw ArithmeticException
NotExponential 

instance Commutative ZModHom

instance Invertible ZModHom where
  tryToInvert :: ZModHom -> Solver ZModHom
tryToInvert (ZModHom ZMod
a ZMod
b Z
r)
    | ZMod
a ZMod -> ZMod -> Bool
forall a. Eq a => a -> a -> Bool
/= ZMod
b    = ArithmeticException -> Solver ZModHom
forall e x. Exception e => e -> Solver x
failure ArithmeticException
NotInvertible
    | N
g N -> N -> Bool
forall a. Eq a => a -> a -> Bool
== N
1    = ZModHom -> Solver ZModHom
forall a. a -> Solver a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZModHom -> Solver ZModHom) -> ZModHom -> Solver ZModHom
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ZModHom -> ZModHom
zmhMod (ZModHom -> ZModHom) -> ZModHom -> ZModHom
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
a Z
s
    | Bool
otherwise = ArithmeticException -> Solver ZModHom
forall e x. Exception e => e -> Solver x
failure ArithmeticException
NotInvertible
    where (N
g,Z
s,Z
_) = Z -> Z -> (N, Z, Z)
euclid Z
r (N -> Z
forall a b. Embeddable a b => a -> b
inj (N -> Z) -> N -> Z
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ZMod -> N
zmOrd ZMod
a)

instance Fibred ZModHom where
  type Root ZModHom = Orientation ZMod

instance FibredOriented ZModHom

instance Additive ZModHom where
  zero :: Root ZModHom -> ZModHom
zero (ZMod
a :> ZMod
b) = ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b Z
0  
  f :: ZModHom
f@(ZModHom ZMod
a ZMod
b Z
r) + :: ZModHom -> ZModHom -> ZModHom
+ g :: ZModHom
g@(ZModHom ZMod
_ ZMod
_ Z
s)
    | ZModHom -> Root ZModHom
forall f. Fibred f => f -> Root f
root ZModHom
f Orientation ZMod -> Orientation ZMod -> Bool
forall a. Eq a => a -> a -> Bool
== ZModHom -> Root ZModHom
forall f. Fibred f => f -> Root f
root ZModHom
g = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (Z
rZ -> Z -> Z
forall a. Additive a => a -> a -> a
+Z
s))
    | Bool
otherwise        = ArithmeticException -> ZModHom
forall a e. Exception e => e -> a
throw ArithmeticException
NotAddable
    -- note: if r and r' are eligible then r+r' is also eligible!
    
  ntimes :: N -> ZModHom -> ZModHom
ntimes N
n (ZModHom ZMod
a ZMod
b Z
r) = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (N -> Z -> Z
forall a. Additive a => N -> a -> a
ntimes N
n Z
r))
  
instance Abelian ZModHom where
  negate :: ZModHom -> ZModHom
negate (ZModHom ZMod
a ZMod
b Z
r) = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (Z -> Z
forall a. Abelian a => a -> a
negate Z
r))
  f :: ZModHom
f@(ZModHom ZMod
a ZMod
b Z
r) - :: ZModHom -> ZModHom -> ZModHom
- g :: ZModHom
g@(ZModHom ZMod
_ ZMod
_ Z
s)
    | ZModHom -> Root ZModHom
forall f. Fibred f => f -> Root f
root ZModHom
f Orientation ZMod -> Orientation ZMod -> Bool
forall a. Eq a => a -> a -> Bool
== ZModHom -> Root ZModHom
forall f. Fibred f => f -> Root f
root ZModHom
g = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (Z
rZ -> Z -> Z
forall a. Abelian a => a -> a -> a
-Z
s))
    | Bool
otherwise        = ArithmeticException -> ZModHom
forall a e. Exception e => e -> a
throw ArithmeticException
NotAddable
  ztimes :: Z -> ZModHom -> ZModHom
ztimes Z
z (ZModHom ZMod
a ZMod
b Z
r) = ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b (Z -> Z -> Z
forall a. Abelian a => Z -> a -> a
ztimes Z
z Z
r))
  
instance Vectorial ZModHom where
  type Scalar ZModHom = Z
  ! :: Scalar ZModHom -> ZModHom -> ZModHom
(!) = Z -> ZModHom -> ZModHom
Scalar ZModHom -> ZModHom -> ZModHom
forall a. Abelian a => Z -> a -> a
ztimes

instance Distributive ZModHom

instance Algebraic ZModHom

--------------------------------------------------------------------------------
-- zmhGenOrd -

-- | @zmhGenOrd (a':>'b) = (r,o)@ where @r@ is a generator for @'ZModHom'(a':>'b)@
-- with order @o@.
--
-- __Note__ It follows that @'inj' o '!' r '==' 'zero' (a':>'b)@ and @'ZModHom'(a':>'b)@
-- is isomorphic to @'Z'\/o@ which is represented by @'ZMod' o@.
zmhGenOrd :: Orientation ZMod -> (ZModHom,N)
zmhGenOrd :: Orientation ZMod -> (ZModHom, N)
zmhGenOrd ab :: Orientation ZMod
ab@(ZMod
a:>ZMod
b) = N -> N -> (ZModHom, N)
go (ZMod -> N
zmOrd ZMod
a) (ZMod -> N
zmOrd ZMod
b) where
  go :: N -> N -> (ZModHom,N)
  go :: N -> N -> (ZModHom, N)
go N
0 N
1   = (Root ZModHom -> ZModHom
forall a. Additive a => Root a -> a
zero Orientation ZMod
Root ZModHom
ab,N
1) 
  go N
0 N
b'  = (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b Z
1,N
b')                -- ZModHom(a:>b) ~ Z/b = ZMod (zmOrd b)
  go N
_ N
0   = (Root ZModHom -> ZModHom
forall a. Additive a => Root a -> a
zero Orientation ZMod
Root ZModHom
ab,N
1)                       -- ZModHom(a:>b) ~ Z/1 = ZMod 1
  go N
a' N
b' = (ZModHom -> ZModHom
zmhMod (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
b Z
r),N
g) where  -- ZModHom(a:>b) ~ Z/gcd a b
    g :: N
g = N -> N -> N
gcd N
a' N
b'
    r :: Z
r = N -> Z
forall a b. Embeddable a b => a -> b
inj N
b' Z -> N -> Z
// N
g

--------------------------------------------------------------------------------
-- zmhGenerator -

-- | @zmhGenerator (a:>b) = h@ is a generator for the abelian group @'ZModHom'(a':>'b)@.
zmhGenerator :: Orientation ZMod -> ZModHom
zmhGenerator :: Orientation ZMod -> ZModHom
zmhGenerator = (ZModHom, N) -> ZModHom
forall a b. (a, b) -> a
fst ((ZModHom, N) -> ZModHom)
-> (Orientation ZMod -> (ZModHom, N))
-> Orientation ZMod
-> ZModHom
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Orientation ZMod -> (ZModHom, N)
zmhGenOrd

--------------------------------------------------------------------------------
-- ZMod - XStandard -

-- | the maximal order of cyclic groups for the standard random variable of type @'X' 'ZMod'@.
--
-- __Property__ @0 < 'stdMaxOrder'@.
stdMaxOrder :: N
stdMaxOrder :: N
stdMaxOrder = N
1000

instance XStandard ZMod where
  xStandard :: X ZMod
xStandard = (N -> ZMod) -> X N -> X ZMod
forall a b. (a -> b) -> X a -> X b
forall (h :: * -> * -> *) (f :: * -> *) a b.
Applicative1 h f =>
h a b -> f a -> f b
amap1 N -> ZMod
ZMod (X N -> X ZMod) -> X N -> X ZMod
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ X (X N) -> X N
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X N) -> X N) -> X (X N) -> X N
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ X (X N)
xn where
    xn :: X (X N)
xn = [(Q, X N)] -> X (X N)
forall a. [(Q, a)] -> X a
xOneOfW [ (Q
10,N -> X N
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return N
0)
                 , ( Q
1,N -> X N
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return N
1)
                 , (Q
21,N -> N -> X N
xNB N
2 N
stdMaxOrder)
                 ]

--------------------------------------------------------------------------------
-- xZModTo -

-- | random variable of cyclic groups admitting nontrivial homomorphisms to the given group.
xZModTo :: N -> ZMod -> X ZMod
xZModTo :: N -> ZMod -> X ZMod
xZModTo N
0 ZMod
z          = ZMod -> X ZMod
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ZMod
z 
xZModTo N
_ z :: ZMod
z@(ZMod N
0) = ZMod -> X ZMod
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ZMod
z
xZModTo N
_ (ZMod N
1)   = X ZMod
forall x. XStandard x => X x
xStandard
xZModTo N
i (ZMod N
n)   = N -> N -> X N -> X [N]
forall x. N -> N -> X x -> X [x]
xTakeB N
1 (N
eN -> N -> N
forall a. Additive a => a -> a -> a
+N
i) ([N] -> X N
forall a. [a] -> X a
xOneOf [N]
dvs) X [N] -> ([N] -> X ZMod) -> X ZMod
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZMod -> X ZMod
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZMod -> X ZMod) -> ([N] -> ZMod) -> [N] -> X ZMod
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. N -> ZMod
ZMod (N -> ZMod) -> ([N] -> N) -> [N] -> ZMod
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. (N -> N -> N) -> N -> [N] -> N
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl N -> N -> N
forall c. Multiplicative c => c -> c -> c
(*) N
1
  where ps :: [(N, N)]
ps = Word N N -> [(N, N)]
forall r a. Word r a -> [(a, r)]
fromWord (Word N N -> [(N, N)]) -> Word N N -> [(N, N)]
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ N -> Word N N
nFactorize N
n
        e :: N
e  = (N -> N -> N) -> N -> [N] -> N
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl N -> N -> N
forall a. Additive a => a -> a -> a
(+) N
0 ([N] -> N) -> [N] -> N
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ((N, N) -> N) -> [(N, N)] -> [N]
forall a b. (a -> b) -> [a] -> [b]
forall (h :: * -> * -> *) (f :: * -> *) a b.
Applicative1 h f =>
h a b -> f a -> f b
amap1 (N, N) -> N
forall a b. (a, b) -> b
snd [(N, N)]
ps
        dvs :: [N]
dvs = ((N, N) -> N) -> [(N, N)] -> [N]
forall a b. (a -> b) -> [a] -> [b]
forall (h :: * -> * -> *) (f :: * -> *) a b.
Applicative1 h f =>
h a b -> f a -> f b
amap1 (N, N) -> N
forall a b. (a, b) -> a
fst [(N, N)]
ps 

dstXZModTo :: Int -> N -> ZMod -> IO ()
dstXZModTo :: Int -> N -> ZMod -> IO ()
dstXZModTo Int
n N
i ZMod
z = IO Omega
getOmega IO Omega -> (Omega -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> X ZMod -> Omega -> IO ()
forall x. (Show x, Ord x) => Int -> X x -> Omega -> IO ()
putDistribution Int
n (N -> ZMod -> X ZMod
xZModTo N
i ZMod
z)

--------------------------------------------------------------------------------
-- xZModFrom -

-- | random variable of cyclic groups admitting non trivial homomorphisms from the given one.
xZModFrom :: N -> ZMod -> X ZMod
xZModFrom :: N -> ZMod -> X ZMod
xZModFrom N
_ (ZMod N
0) = X ZMod
forall x. XStandard x => X x
xStandard
xZModFrom N
_ (ZMod N
1) = X ZMod
forall x. XStandard x => X x
xStandard
xZModFrom N
i ZMod
z        = N -> ZMod -> X ZMod
xZModTo N
i ZMod
z

--------------------------------------------------------------------------------
-- xZModHom -

-- | random variable for homomorphisms for the given orientation of 'ZMod'.
xZModHom :: X Z -> Orientation ZMod -> X ZModHom
xZModHom :: X Z -> Orientation ZMod -> X ZModHom
xZModHom X Z
xz (ZMod N
0 :> ZMod N
0) = X Z
xz X Z -> (Z -> X ZModHom) -> X ZModHom
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZModHom -> X ZModHom) -> (Z -> ZModHom) -> Z -> X ZModHom
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
zm0 ZMod
zm0
xZModHom X Z
_ (ZMod
a :> ZMod N
1)       = ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
a ZMod
zm1 Z
0)
xZModHom X Z
_ (ZMod N
1 :> ZMod
b)       = ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZMod -> ZMod -> Z -> ZModHom
ZModHom ZMod
zm1 ZMod
b Z
0)
xZModHom X Z
xz Orientation ZMod
ab                 = (ZModHom, N) -> X ZModHom
xh (Orientation ZMod -> (ZModHom, N)
zmhGenOrd Orientation ZMod
ab) where
  xh :: (ZModHom, N) -> X ZModHom
xh (ZModHom
h,N
0) = X Z
xz X Z -> (Z -> X ZModHom) -> X ZModHom
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZModHom -> X ZModHom) -> (Z -> ZModHom) -> Z -> X ZModHom
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. (Scalar ZModHom -> ZModHom -> ZModHom
forall v. Vectorial v => Scalar v -> v -> v
! ZModHom
h)
  xh (ZModHom
h,N
1) = ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ZModHom
h
  xh (ZModHom
h,N
o) = do
    N
n <- N -> N -> X N
xNB N
1 (N -> N
forall a. Enum a => a -> a
pred N
o)
    ZModHom -> X ZModHom
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (N -> ZModHom -> ZModHom
forall a. Additive a => N -> a -> a
ntimes N
n ZModHom
h)
  

--------------------------------------------------------------------------------
-- xZModHomTo -

-- | random variable for homomorphisms based on 'xZModTo'.
xZModHomTo :: N -> X Z -> X ZMod -> XOrtSite To ZModHom
xZModHomTo :: N -> X Z -> X ZMod -> XOrtSite 'To ZModHom
xZModHomTo N
i X Z
xz X ZMod
xm = X (Point ZModHom)
-> (Point ZModHom -> X ZModHom) -> XOrtSite 'To ZModHom
forall q. X (Point q) -> (Point q -> X q) -> XOrtSite 'To q
XEnd X (Point ZModHom)
X ZMod
xm Point ZModHom -> X ZModHom
ZMod -> X ZModHom
xh where
  xh :: ZMod -> X ZModHom
xh ZMod
t = do
    ZMod
f <- N -> ZMod -> X ZMod
xZModTo N
i ZMod
t
    X Z -> Orientation ZMod -> X ZModHom
xZModHom X Z
xz (ZMod
fZMod -> ZMod -> Orientation ZMod
forall p. p -> p -> Orientation p
:>ZMod
t)

dstZModHomTo :: Int -> N -> X Z -> X ZMod -> IO ()
dstZModHomTo :: Int -> N -> X Z -> X ZMod -> IO ()
dstZModHomTo Int
n N
i X Z
xz X ZMod
xm = IO Omega
getOmega IO Omega -> (Omega -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> X N -> Omega -> IO ()
forall x. (Show x, Ord x) => Int -> X x -> Omega -> IO ()
putDistribution Int
n X N
xHomOrt where
  XEnd X (Point ZModHom)
X ZMod
xt Point ZModHom -> X ZModHom
ZMod -> X ZModHom
xh = N -> X Z -> X ZMod -> XOrtSite 'To ZModHom
xZModHomTo N
i X Z
xz X ZMod
xm
  xHomOrt :: X N
xHomOrt = do
    ZModHom ZMod
_ ZMod
_ Z
r <- X ZMod
xt X ZMod -> (ZMod -> X ZModHom) -> X ZModHom
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZMod -> X ZModHom
xh
    N -> X N
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Z
r Z -> Z -> Bool
forall a. Eq a => a -> a -> Bool
== Z
0 then N
0 else String -> N
forall x. LengthN x => x -> N
lengthN (String -> N) -> String -> N
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ Z -> String
forall a. Show a => a -> String
show Z
r)

instance XStandardOrtSite To ZModHom where
  xStandardOrtSite :: XOrtSite 'To ZModHom
xStandardOrtSite = N -> X Z -> X ZMod -> XOrtSite 'To ZModHom
xZModHomTo N
5 X Z
forall x. XStandard x => X x
xStandard X ZMod
forall x. XStandard x => X x
xStandard

--------------------------------------------------------------------------------
-- xZModHomFrom -

-- | random variable for homomorphisms based on 'xZModFrom'.
xZModHomFrom :: N -> X Z -> X ZMod -> XOrtSite From ZModHom
xZModHomFrom :: N -> X Z -> X ZMod -> XOrtSite 'From ZModHom
xZModHomFrom N
i X Z
xz X ZMod
xm = X (Point ZModHom)
-> (Point ZModHom -> X ZModHom) -> XOrtSite 'From ZModHom
forall q. X (Point q) -> (Point q -> X q) -> XOrtSite 'From q
XStart X (Point ZModHom)
X ZMod
xm Point ZModHom -> X ZModHom
ZMod -> X ZModHom
xh where
  xh :: ZMod -> X ZModHom
xh ZMod
f = do
    ZMod
t <- N -> ZMod -> X ZMod
xZModFrom N
i ZMod
f
    X Z -> Orientation ZMod -> X ZModHom
xZModHom X Z
xz (ZMod
fZMod -> ZMod -> Orientation ZMod
forall p. p -> p -> Orientation p
:>ZMod
t)
  
dstZModHomFrom :: Int -> N -> X Z -> X ZMod -> IO ()
dstZModHomFrom :: Int -> N -> X Z -> X ZMod -> IO ()
dstZModHomFrom Int
n N
i X Z
xz X ZMod
xm = IO Omega
getOmega IO Omega -> (Omega -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> X N -> Omega -> IO ()
forall x. (Show x, Ord x) => Int -> X x -> Omega -> IO ()
putDistribution Int
n X N
xHomOrt where
  XStart X (Point ZModHom)
X ZMod
xt Point ZModHom -> X ZModHom
ZMod -> X ZModHom
xh = N -> X Z -> X ZMod -> XOrtSite 'From ZModHom
xZModHomFrom N
i X Z
xz X ZMod
xm
  xHomOrt :: X N
xHomOrt = do
    ZModHom ZMod
_ ZMod
_ Z
r <- X ZMod
xt X ZMod -> (ZMod -> X ZModHom) -> X ZModHom
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZMod -> X ZModHom
xh
    N -> X N
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Z
r Z -> Z -> Bool
forall a. Eq a => a -> a -> Bool
== Z
0 then N
0 else String -> N
forall x. LengthN x => x -> N
lengthN (String -> N) -> String -> N
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ Z -> String
forall a. Show a => a -> String
show Z
r)

instance XStandardOrtSite From ZModHom where
  xStandardOrtSite :: XOrtSite 'From ZModHom
xStandardOrtSite = N -> X Z -> X ZMod -> XOrtSite 'From ZModHom
xZModHomFrom N
5 X Z
forall x. XStandard x => X x
xStandard X ZMod
forall x. XStandard x => X x
xStandard
  
--------------------------------------------------------------------------------
-- prpZModHom -

-- | validity of the 'Z'-algebraic structure of 'ZModHom'.
prpZModHom :: Statement
prpZModHom :: Statement
prpZModHom = String -> Label
Prp String
"ZModHom" Label -> Statement -> Statement
:<=>:
  [Statement] -> Statement
And [ X ZModHom -> Statement
forall q. Oriented q => XOrt q -> Statement
prpOrt X ZModHom
xOrt
      , XMlt ZModHom -> Statement
forall c. Multiplicative c => XMlt c -> Statement
prpMlt XMlt ZModHom
xMlt
      , X ZModHom -> Statement
forall f. Fibred f => XFbr f -> Statement
prpFbr X ZModHom
xFbr
      , XAdd ZModHom -> Statement
forall a. Additive a => XAdd a -> Statement
prpAdd XAdd ZModHom
xAdd
      , XAbl ZModHom -> Statement
forall a. Abelian a => XAbl a -> Statement
prpAbl XAbl ZModHom
xAbl
      , XDst ZModHom -> Statement
forall d. Distributive d => XDst d -> Statement
prpDst XDst ZModHom
xDst
      ] where

  xz :: X Z
xz     = X Z
forall x. XStandard x => X x
xStandard
  xMod :: X ZMod
xMod   = X ZMod
forall x. XStandard x => X x
xStandard 
  xHomTo :: XOrtSite 'To ZModHom
xHomTo = XOrtSite 'To ZModHom
forall (s :: Site) a. XStandardOrtSite s a => XOrtSite s a
xStandardOrtSite :: XOrtSite To ZModHom 
  
  xOrt :: X ZModHom
xOrt = XOrtSite 'To ZModHom -> X ZModHom
forall q (s :: Site). Oriented q => XOrtSite s q -> XOrt q
xosOrt XOrtSite 'To ZModHom
xHomTo
  
  xMlt :: XMlt ZModHom
xMlt = X N
-> X (Point ZModHom)
-> X ZModHom
-> X (Endo ZModHom)
-> X (Mltp2 ZModHom)
-> X (Mltp3 ZModHom)
-> XMlt ZModHom
forall c.
X N
-> X (Point c)
-> X c
-> X (Endo c)
-> X (Mltp2 c)
-> X (Mltp3 c)
-> XMlt c
XMlt X N
xn X (Point ZModHom)
X ZMod
xMod X ZModHom
xOrt X (Endo ZModHom)
xe X (Mltp2 ZModHom)
xh2 X (Mltp3 ZModHom)
xh3 where
    xn :: X N
xn = N -> N -> X N
xNB N
0 N
100
    xe :: X (Endo ZModHom)
xe = do
      ZMod
c <- X ZMod
xMod
      ZModHom
h <- X Z -> Orientation ZMod -> X ZModHom
xZModHom X Z
xz (ZMod
cZMod -> ZMod -> Orientation ZMod
forall p. p -> p -> Orientation p
:>ZMod
c)
      Endo ZModHom -> X (Endo ZModHom)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Endo ZModHom -> X (Endo ZModHom))
-> Endo ZModHom -> X (Endo ZModHom)
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ZModHom -> Endo ZModHom
forall q. q -> Endo q
Endo (ZModHom -> Endo ZModHom) -> ZModHom -> Endo ZModHom
forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ ZModHom
h
      
    xh2 :: X (Mltp2 ZModHom)
xh2 = XOrtSite 'To ZModHom -> X (Mltp2 ZModHom)
forall c (d :: Site).
Multiplicative c =>
XOrtSite d c -> X (Mltp2 c)
xMltp2 XOrtSite 'To ZModHom
xHomTo
    xh3 :: X (Mltp3 ZModHom)
xh3 = XOrtSite 'To ZModHom -> X (Mltp3 ZModHom)
forall c (d :: Site).
Multiplicative c =>
XOrtSite d c -> X (Mltp3 c)
xMltp3 XOrtSite 'To ZModHom
xHomTo
  
  xFbr :: X ZModHom
xFbr = X ZModHom
xOrt

  xRoot :: X (Orientation ZMod)
xRoot  = do
    ZMod
t <- X ZMod
xMod
    ZMod
f <- N -> ZMod -> X ZMod
xZModTo N
5 ZMod
t
    Orientation ZMod -> X (Orientation ZMod)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZMod
fZMod -> ZMod -> Orientation ZMod
forall p. p -> p -> Orientation p
:>ZMod
t)

  xStalk :: XStalk ZModHom
xStalk = X (Root ZModHom) -> (Root ZModHom -> X ZModHom) -> XStalk ZModHom
forall x. X (Root x) -> (Root x -> X x) -> XStalk x
XStalk X (Orientation ZMod)
X (Root ZModHom)
xRoot (X Z -> Orientation ZMod -> X ZModHom
xZModHom X Z
xz)
  xAdd :: XAdd ZModHom
xAdd = XStalk ZModHom -> X N -> XAdd ZModHom
forall a. Additive a => XStalk a -> X N -> XAdd a
xAddStalk XStalk ZModHom
xStalk (N -> N -> X N
xNB N
0 N
1000)
  xAbl :: XAbl ZModHom
xAbl = X Z -> X ZModHom -> X (Adbl2 ZModHom) -> XAbl ZModHom
forall a. X Z -> X a -> X (Adbl2 a) -> XAbl a
XAbl X Z
forall x. XStandard x => X x
xStandard X ZModHom
xFbr X (Adbl2 ZModHom)
xa2 where
    xa2 :: X (Adbl2 ZModHom)
xa2 = X (Orientation ZMod)
xRoot X (Orientation ZMod)
-> (Orientation ZMod -> X (Adbl2 ZModHom)) -> X (Adbl2 ZModHom)
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= XStalk ZModHom -> Root ZModHom -> X (Adbl2 ZModHom)
forall a. Additive a => XStalk a -> Root a -> X (Adbl2 a)
xStalkAdbl2 XStalk ZModHom
xStalk

    
  xHomFrom :: XOrtSite 'From ZModHom
xHomFrom = XOrtSite 'From ZModHom
forall (s :: Site) a. XStandardOrtSite s a => XOrtSite s a
xStandardOrtSite :: XOrtSite From ZModHom
  xDst :: XDst ZModHom
xDst = XStalk ZModHom
-> XOrtSite 'From ZModHom -> XOrtSite 'To ZModHom -> XDst ZModHom
forall m.
Distributive m =>
XStalk m -> XOrtSite 'From m -> XOrtSite 'To m -> XDst m
xDstStalkStartEnd XStalk ZModHom
xStalk XOrtSite 'From ZModHom
xHomFrom XOrtSite 'To ZModHom
xHomTo
  
{-
--------------------------------------------------------------------------------
-- ZModHomForm -

-- | form of a group homomorphism between cyclic groups.
--
--  __Property__ Let @'ZModHomForm' ('ZMod' a) ('ZMod' b) r@ be in t'ZModHomForm' then holds:
--  @'mod0' (r' '*' 'inj' a) b '==' 0@.
data ZModHomForm = ZModHomForm ZMod ZMod Z deriving (Eq,Ord,Show)

--------------------------------------------------------------------------------
-- cyhfz -

-- | the underlying integer.
cyhfz :: ZModHomForm -> Z
cyhfz (ZModHomForm _ _ r) = r

cy0 :: ZMod
cy0 = ZMod 0

zcyhf :: Z -> ZModHomForm
zcyhf r = ZModHomForm cy0 cy0 r

--------------------------------------------------------------------------------
-- ZModHom - Entity -


instance Oriented ZModHomForm where
  type Point ZModHomForm = ZMod
  orientation (ZModHomForm a b _) = a:>b

instance Fibred ZModHomForm where
  type Root ZModHomForm = Orientation ZMod

instance FibredOriented ZModHomForm

cyhfMlt :: ZModHomForm -> ZModHomForm -> ZModHomForm
cyhfMlt (ZModHomForm _ d f) (ZModHomForm a _ g) = ZModHomForm a d (f*g)

cyhfNPower :: ZModHomForm -> N -> ZModHomForm
cyhfNPower (ZModHomForm a b f) n = ZModHomForm a b (npower f n)

cyhfAdd :: ZModHomForm -> ZModHomForm -> ZModHomForm
cyhfAdd (ZModHomForm a b f) (ZModHomForm _ _ g) = ZModHomForm a b (f+g)

cyhfNTimes :: N -> ZModHomForm -> ZModHomForm
cyhfNTimes n (ZModHomForm a b f) = ZModHomForm a b (ntimes n f)

cyhfNeg :: ZModHomForm -> ZModHomForm
cyhfNeg (ZModHomForm a b f) = ZModHomForm a b (negate f)

cyhfSub :: ZModHomForm -> ZModHomForm -> ZModHomForm
cyhfSub (ZModHomForm a b f) (ZModHomForm _ _ g) = ZModHomForm a b (f-g)

cyhfZTimes :: Z -> ZModHomForm -> ZModHomForm
cyhfZTimes z (ZModHomForm a b f) = ZModHomForm a b (ztimes z f)

--------------------------------------------------------------------------------
-- ZModHomForm - Reduzible -

instance Reducible ZModHomForm where
  reduce (ZModHomForm a b r) = ZModHomForm a b (mod0 r (zmOrd b))

--------------------------------------------------------------------------------
-- ZModHom -

-- | representation of a group homomorphism between cyclic groups. They are
--   constructed via 'ZModHomForm'\'s.
newtype ZModHom = ZModHom ZModHomForm deriving (Eq,Ord,Validable,Entity)

instance Show ZModHom where
  show (ZModHom (ZModHomForm _ b r))
    | b == ZMod 0 = show r
    | otherwise = "{"++show r++"}"

--------------------------------------------------------------------------------
-- cyHom -

cyHom :: ZMod -> ZMod -> Z -> ZModHom
cyHom a b z = error "nyi"

--------------------------------------------------------------------------------
-- cyGenerator -

-- | generating homomorphism of the cyclic group, i.e the epimorphism with
--  @'start' '==' 'ZMod' 0@ and induced by @1@.
--
-- @
--           cyGenerator c
--    ZMod 0 ---------------->> c
--
-- @
cyGenerator :: ZMod -> ZModHom
cyGenerator c = make (ZModHomForm (ZMod 0) c 1) 

--------------------------------------------------------------------------------
-- cyhLift

-- | lifting a homomorphism between cyclic groups to its canonical homormorphism
-- between @'ZMod' 0@.
cyhLift :: ZModHom -> ZModHom
cyhLift (ZModHom (ZModHomForm _ _ r)) = ZModHom (ZModHomForm z z r) where z = ZMod 0

--------------------------------------------------------------------------------
-- ZModHom - Constructabel -

instance Exposable ZModHom where
  type Form ZModHom = ZModHomForm
  form (ZModHom f) = f

instance Constructable ZModHom where
  make = ZModHom . reduce

--------------------------------------------------------------------------------
-- ZModHom - Algebraic -

instance Oriented ZModHom where
  type Point ZModHom = ZMod
  orientation = restrict orientation

instance Multiplicative ZModHom where
  one a = make (ZModHomForm a a 1)
  ZModHom f * ZModHom g = if start f == end g
    then make (f `cyhfMlt` g)
    else throw NotMultiplicable
  npower f 1                          = f
  npower f _         | not (isEndo f) = throw NotExponential
  npower (ZModHom f) n                  = make (cyhfNPower f n)

instance Commutative ZModHom

instance Invertible ZModHom where
  tryToInvert (ZModHom (ZModHomForm a b r))
    | a /= b    = failure NotInvertible
    | g == 1    = return $ ZModHom $ ZModHomForm a a (mod0 s (zmOrd a))
    | otherwise = failure NotInvertible
    where (g,s,_) = euclid r (inj $ zmOrd a)

instance Fibred ZModHom where
  type Root ZModHom = Orientation ZMod

instance FibredOriented ZModHom

instance Additive ZModHom where
  zero (a :> b) = ZModHom (ZModHomForm a b 0)
  ZModHom f + ZModHom g = if root f == root g
    then make (f `cyhfAdd` g)
    else throw NotAddable
    -- note: if r and r' are eligible then r+r' is also eligible!
  ntimes n (ZModHom f) = make (cyhfNTimes n f)
  
instance Abelian ZModHom where
  negate (ZModHom f) = make (cyhfNeg f)
  ZModHom f - ZModHom g = if root f == root g
    then make (f `cyhfSub` g)
    else throw NotAddable
  ztimes z (ZModHom f) = make (cyhfZTimes z f)
  
instance Vectorial ZModHom where
  type Scalar ZModHom = Z
  z ! ZModHom f = make (cyhfZTimes z f)

instance Distributive ZModHom

instance Algebraic ZModHom

--------------------------------------------------------------------------------
-- cyGenHomOrd -

-- | @cyGenHomOrd (a':>'b) = (r,o)@ where @r@ is a generator for @'ZModHom'(a':>'b)@ with
--   order @o@.
--
--   __Note__
--
--   (1) It follows that @'inj' o '!' r '==' 'zero' (a':>'b)@ and @'ZModHom'(a':>'b)@
--   is isomorphic to @'Z'\/o@ which is represented by @'ZMod' o@.
--
--   (1) In the case that @a '==' 'ZMod' 0@ then @o '==' 'zmOrd' b@.
--
--   (1) In the case that @a '/=' 'ZMod' 0@ and @b '==' 'ZMod' 0@ then @o '==' 1@.
--
--   (1) In the case that @a '/=' 'ZMod' 0@ and @b '/=' 'ZMod' 0@ then @o '==' b' '//' g@
--   where @g = 'gcd' a' b'@, @a' = 'inj' '$' 'zmOrd' a@ and @b' = 'inj' '$' 'zmOrd' b@. 
cyGenHomOrd :: Orientation ZMod -> (ZModHom,N)
cyGenHomOrd (a:>b) = go (zmOrd a) (zmOrd b) where
  go :: N -> N -> (ZModHom,N)
  go 0 _   = (make (ZModHomForm a b 1),zmOrd b)  -- ZModHom(a:>b) ~ Z/b = ZMod (zmOrd b)
  go _  0  = (make (ZModHomForm a b 0),1)        -- ZModHom(a:>b) ~ Z/1 = ZMod 1
  go a' b' = (make (ZModHomForm a b r),g) where  -- ZModHom(a:>b) ~ Z/gcd a b
    g = gcd a' b'
    r = inj b' // g

--------------------------------------------------------------------------------
-- cyGenHom -

-- | @cyGenHom (a:>b) = h@ is a generater for the abelian group @'ZModHom'(a':>'b)@.
cyGenHom :: Orientation ZMod -> ZModHom
cyGenHom = fst . cyGenHomOrd

--------------------------------------------------------------------------------
-- xodZModHom -

xodZModHom :: X Z -> X ZMod -> XOrtDirection LeftToRight ZModHom
xodZModHom xz xcy = XOrtLeftToRight xcy xh where
    xh a b = zs o >>= return . (! h) where
      (h,o) = cyGenHomOrd (a:>b)
      zs :: N -> X Z
      zs 0 = xz
      zs 1 = return 0
      zs o = amap1 inj $ xNB 1 (pred o)
  
--------------------------------------------------------------------------------
-- ZModHom - XStandardOrtDirection -

instance XStandardOrtDirection LeftToRight ZModHom where
  xStandardOrtDirection = xodZModHom xStandard (amap1 ZMod xStandard)
  
instance XStandardOrtDirectionLR ZModHom

dst :: Int -> IO ()
dst n = getOmega >>= putDistribution n (amap1 shw xc) where
  xc :: X (Orientation ZMod,ZModHom)
  xc = do
    h <- xodOrt (xStandardOrtDirection :: XOrtDirection LeftToRight ZModHom)
    return (orientation h,h)

  shw (o,h) = join $ tween ":" [shwo o,shwh h] 

  shwc v (ZMod n) = if 1 < n then v else show n

  shwo (a:>b) = join $ tween "->" $ if a == b
    then [shwc "n" a,shwc "n" a]
    else [shwc "n" a,shwc "m" b]
  
  shwh h = if isZero h then "0" else "h"

-}