あれやこれやで理由を付けて（要するにサボっていた）群の話を全然進めていなかったが，以前より少しだけHaskellの勉強が進んだので自由群の定義を書きなおしてみた．　今回は Group 型クラスと，その instane としての　FreeGroup という事にして書いてみた．　※コードがコンパイルを通ったところで満足したのでテストはこれから．

（Haskell なのにコメントが//で始まっていたりするのはご愛嬌．　Wordpress のコード表示が Haskell に対応しておらず，やむなく親戚（？）の Scala だということにしてコード表示方式を設定している．）

//------------------------------------
//-- General Group type class
//------------------------------------
class (Eq a) => Group a where
  unit :: a
  (#) :: a -> a -> a
  inv :: a -> a
  pow :: a -> Int -> a
  x `pow` n  | (n==0)    = unit
             | (n >0)    = foldl1 (#) (replicate n x)
             | otherwise = foldl1 (#) (replicate (-n) x)

//------------------------------------
//-- Element for Free Group
//------------------------------------
type Element s = (s, Int)
antielement :: Element s -> Element s
antielement (x, i) = (x, -i)

//------------------------------------
//-- FreeGroup
//------------------------------------
data FreeGroup s = Word [Element s]

reduce :: (Eq s) => [Element s] -> [Element s]
reduce = foldr  reduce_rec []
  where reduce_rec :: (Eq s) => Element s -> [Element s] -> [Element s]
        reduce_rec t [] = [t]
        reduce_rec t (u:us) = (red2 t u) ++ us
          where red2 :: (Eq s) => Element s -> Element s -> [Element s]
                red2 (s1, i1) (s2, i2)
                  | (s1==s2)&&(i1+i2==0)  = []
                  | (s1==s2)              = [(s1, i1+i2)]
                  | otherwise             = [(s1,i1), (s2, i2)]

instance (Eq s) => Eq (FreeGroup s) where
  (==) (Word xs) (Word ys) = (reduce xs) == (reduce ys)

instance (Eq s) => Group (FreeGroup s) where
  (#) (Word xs) (Word ys) = Word (reduce (xs++ys))
  inv (Word xs) = Word (map antielement (reverse xs))
  unit = (Word [])