home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.uni-stuttgart.de/pub/systems/acorn/
/
Acorn.tar
/
Acorn
/
acornet
/
dev
/
gofer.spk
/
scripts
/
Group
< prev
next >
Wrap
Text File
|
1994-02-28
|
5KB
|
168 lines
----------------- Groups -----------------
{- This script enables manipulations with groups, in particular
with F2, the free group on x,y.
Notation for group elements:
x,y are generators of F2.
x' is inverse of x, y' is inverse of y.
g*h is product of g and h.
(invert g) is inverse of g.
product [g1,...,gn] is product g1*...*gn.
g^n is n-th power of g, for n>=0.
g^^h is conjugate of g by h, (invert h)*g*h.
g >< h is the commutator (invert g)*(invert h)*g*h.
show <expression> prettyprints the group expression.
-}
t,j,s :: AutF2 -- 3 particular automorphisms of F2.
t = endo (y,x) -- t defined by (x,y) --> (y,x)
j = endo (x',y) -- j defined by (x,y) --> (x',y)
s = endo (x',x'*y) -- s defined by (x,y) --> (x',x'*y)
{- These 3 endomorphisms, each of order 2, generate the automorphism
group AutF2 of F2.
t,j generate the dihedral group D8. (t*j)^4 == 1.
s,t generate the dihedral group D6. (s*t)^3 == 1.
Only s alters any word lengths. s*j has infinite order.
endo (w1,w2) gives the endomorphism of F2 induced by
\(x,y)->(w1,w2).
show <endomorphism> shows the effect on x and on y.
-}
------ infix declarations ----------------------------------------
infixr 8 ^^,>< -- conjugation, commutator
----- datatypes and synonyms -------------------------------------
type F2 = Word Char
type AutF2 = F2 -> F2
data Gen a = P a | N a -- P "positive", N "negative" generators.
data Word a = W [Gen a] -- datatype of group words on a
---- instance declarations for Gen a ------------------------------
instance Eq a => Eq (Gen a) where
P a == P a' = a == a'
N a == N a' = a == a'
_ == _ = False
instance Functor Gen where
map f (P a) = P (f a)
map f (N a) = N (f a)
---- instance declarations for Word a ------------------------------
instance Functor Word where
map f (W xs) = W (map (map f) xs)
instance Eq a => Mult (Word a) where
unit = W ([]::[Gen a])
instance Eq a => LeftMul (Word a) (Word a) where
(W xs) * (W ys) = W (genAppend xs ys)
instance Eq [Gen a] => Eq (Word a) where
(W xs) == (W ys) = (cancel xs) == (cancel ys)
instance Text F2 where -- how to print elements of F2
showsPrec p (W []) = ('1':)
showsPrec p (W gs) = ((f gs)++)
where f [] = ""
f (x:xs) = (showGen x)++(f xs)
showGen (P g) = [g]
showGen (N g) = g:"'"
instance Text AutF2 where -- how to print elements of AutF2
showsPrec p f = ((effect f)++)
------- Machinery -----------------------------
wlen :: (Word a) -> Int -- word length
wlen (W gs) = sum [ 1 | _ <- gs]
-- genCons is the key function on which composition
-- of group words depends. It conses a generator, and then
-- performs a cancellation, if possible.
genCons :: Eq a => (Gen a) -> [Gen a] -> [Gen a]
genCons x [] = [x]
genCons x (y@(x':xs)) = case (x,x') of
(P a, N a') | a == a' -> xs
| otherwise -> x:y
(N a, P a') | a == a' -> xs
| otherwise -> x:y
_ -> x:y
-- genAppend is group word multiplication.
genAppend :: Eq a => BinOp [Gen a]
genAppend [] ys = ys
genAppend (x:xs) ys = genCons x (genAppend xs ys)
-- cancel takes a word to its reduced form.
cancel :: Eq a => [Gen a] -> [Gen a]
cancel [] = []
cancel (g:gs) = genCons g (cancel gs)
invert :: (Word a) -> (Word a) -- group inverse
invert (W xs) = W (reverse (map invertGen xs))
where invertGen :: (Gen a) -> (Gen a)
invertGen (P a) = N a
invertGen (N a) = P a
-- (lift f) extends f to a homomorphism, with f defined on generators.
lift :: Mult (Word b) => (a->(Word b)) -> (Word a) -> (Word b)
lift _ (W []) = unit
lift f (W (x:xs)) = z*(lift f (W xs) )
where z = case x of
P a -> (f a)
N a -> invert (f a)
(^^) :: LeftMul (Word a) (Word a) => BinOp (Word a) -- conjugation
x ^^ y = (invert y)*x*y
(><) :: LeftMul (Word a) (Word a) => BinOp (Word a) -- commutator
x >< y = (invert x)*(x^^y)
{- word converts a string to a group word on Char.
The character ' inverts the previous character.
No characters after a space are counted.-}
word :: String -> F2
word "" = unit
word "'" = unit
word " " = unit
word (c:'\'':cs) = (W [N c])*(word cs)
word (c:' ':_) = (W [P c])
word (c:cs) = (W [P c])*(word cs)
x,y,x',y' :: F2 -- convenient abbreviations.
x = word "x"
y = word "y"
x' = word "x'"
y' = word "y'"
-- endomorphism of F2, free group on x,y, taking x,y to wx,wy.
endo :: (F2, F2) -> AutF2
endo (wx,wy) = lift f
where f 'x' = wx
f 'y' = wy
f _ = unit
-- display effect of an automorphism on the generators x,y.
effect :: AutF2 -> String
effect f = "\\x->"++(show (f x))++"\n"++"\\y->"++(show (f y))
-- reverse a list.
reverse = f [] where
f ys [] = ys
f ys (x:xs) = f (x:ys) xs
----- End -----------------------