{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright    :   (c) Mikael Johansson 2006
Maintainer   :   mik@math.uni-jena.de
Stability    :   provisional
Portability  :   requires multi-parameter type classes

Permutation of Integers represented by cycles.
-}

module MathObj.Permutation.CycleList where

import Data.Set(Set)
import qualified Data.Set as Set

import Data.List (unfoldr)
import Data.Array(Ix)
import qualified Data.Array as Array

import qualified Data.List.Match as Match
import Data.Maybe.HT (toMaybe)
import NumericPrelude (fromInteger)
import PreludeBase


type Cycle i = [i]
type T i = [Cycle i]



fromFunction :: (Ix i) =>
   (i, i) -> (i -> i) -> T i
fromFunction rng f =
   let extractCycle available =
          do el <- choose available
             let orb = orbit f el
             return (orb, Set.difference available (Set.fromList orb))
       cycles = unfoldr extractCycle (Set.fromList (Array.range rng))
   in  keepEssentials cycles



-- right action of a cycle
cycleRightAction :: (Eq i) => i -> Cycle i -> i
x `cycleRightAction` c = cycleAction c x

-- left action of a cycle
cycleLeftAction :: (Eq i) => Cycle i -> i -> i
c `cycleLeftAction` x = cycleAction (reverse c) x

cycleAction :: (Eq i) => [i] -> i -> i
cycleAction cyc x =
   case dropWhile (x/=) (cyc ++ [head cyc]) of
      _:y:_ -> y
      _ -> x


cycleOrbit :: (Ord i) => Cycle i -> i -> [i]
cycleOrbit cyc = orbit (flip cycleRightAction cyc)

{- |
Right (left?) group action on the Integers.
Close to, but not the same as the module action in Algebra.Module.
-}
(*>) :: (Eq i) => T i -> i -> i
p *> x = foldr (flip cycleRightAction) x p

cyclesOrbit ::(Ord i) => T i -> i -> [i]
cyclesOrbit p = orbit (p *>)

orbit :: (Ord i) => (i -> i) -> i -> [i]
orbit op x0 = takeUntilRepetition (iterate op x0)

-- | candidates for Utility ?
takeUntilRepetition :: Ord a => [a] -> [a]
takeUntilRepetition xs =
   let accs = scanl (flip Set.insert) Set.empty xs
       lenlist = takeWhile not (zipWith Set.member xs accs)
   in  Match.take lenlist xs

takeUntilRepetitionSlow :: Eq a => [a] -> [a]
takeUntilRepetitionSlow xs =
   let accs = scanl (flip (:)) [] xs
       lenlist = takeWhile not (zipWith elem xs accs)
   in  Match.take lenlist xs


{-
Alternative to Data.Set.minView in GHC-6.6.
-}
choose :: Set a -> Maybe a
choose set =
   toMaybe (not (Set.null set)) (Set.findMin set)

keepEssentials :: T i -> T i
keepEssentials = filter isEssential

-- is more lazy than (length cyc > 1)
isEssential :: Cycle i -> Bool
isEssential = not . null . drop 1

inverse :: T i -> T i
inverse = map reverse