--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Permutation
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type for representing a non-empty Permutation
--
--------------------------------------------------------------------------------
module HGeometry.Permutation
  ( Permutation(Permutation)
  , orbits
  , indices

  , Orbit
  , elems
  , size
  , cycleOf
  , next, previous
  , lookupIdx
  , apply
  , orbitFrom

  , cycleRep, toCycleRep
  ) where

import           Control.DeepSeq
import           Control.Lens
import           Control.Monad (forM)
import           Control.Monad.ST (runST)
import qualified Data.Foldable as F
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (catMaybes)
import           Data.Vector.NonEmpty (NonEmptyVector)
import qualified Data.Vector.NonEmpty as NonEmptyV
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import           GHC.Generics (Generic)
import           HGeometry.Vector.NonEmpty.Util ()

--------------------------------------------------------------------------------

-- | Orbits (Cycles) are represented by vectors
type Orbit a = NonEmptyVector a

-- | Cyclic representation of a non-empty permutation.
data Permutation a = Permutation { forall a. Permutation a -> NonEmptyVector (Orbit a)
_orbits  :: NonEmptyVector (Orbit a)
                                 , forall a. Permutation a -> Vector (Int, Int)
_indexes :: UV.Vector (Int,Int)
                                               -- ^ idxes (fromEnum a) = (i,j)
                                               -- implies that a is the j^th
                                               -- item in the i^th orbit
                                 }
                   deriving (Int -> Permutation a -> ShowS
[Permutation a] -> ShowS
Permutation a -> String
(Int -> Permutation a -> ShowS)
-> (Permutation a -> String)
-> ([Permutation a] -> ShowS)
-> Show (Permutation a)
forall a. Show a => Int -> Permutation a -> ShowS
forall a. Show a => [Permutation a] -> ShowS
forall a. Show a => Permutation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Permutation a -> ShowS
showsPrec :: Int -> Permutation a -> ShowS
$cshow :: forall a. Show a => Permutation a -> String
show :: Permutation a -> String
$cshowList :: forall a. Show a => [Permutation a] -> ShowS
showList :: [Permutation a] -> ShowS
Show,Permutation a -> Permutation a -> Bool
(Permutation a -> Permutation a -> Bool)
-> (Permutation a -> Permutation a -> Bool) -> Eq (Permutation a)
forall a. Eq a => Permutation a -> Permutation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Permutation a -> Permutation a -> Bool
== :: Permutation a -> Permutation a -> Bool
$c/= :: forall a. Eq a => Permutation a -> Permutation a -> Bool
/= :: Permutation a -> Permutation a -> Bool
Eq,(forall x. Permutation a -> Rep (Permutation a) x)
-> (forall x. Rep (Permutation a) x -> Permutation a)
-> Generic (Permutation a)
forall x. Rep (Permutation a) x -> Permutation a
forall x. Permutation a -> Rep (Permutation a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Permutation a) x -> Permutation a
forall a x. Permutation a -> Rep (Permutation a) x
$cfrom :: forall a x. Permutation a -> Rep (Permutation a) x
from :: forall x. Permutation a -> Rep (Permutation a) x
$cto :: forall a x. Rep (Permutation a) x -> Permutation a
to :: forall x. Rep (Permutation a) x -> Permutation a
Generic,(forall a b. (a -> b) -> Permutation a -> Permutation b)
-> (forall a b. a -> Permutation b -> Permutation a)
-> Functor Permutation
forall a b. a -> Permutation b -> Permutation a
forall a b. (a -> b) -> Permutation a -> Permutation b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Permutation a -> Permutation b
fmap :: forall a b. (a -> b) -> Permutation a -> Permutation b
$c<$ :: forall a b. a -> Permutation b -> Permutation a
<$ :: forall a b. a -> Permutation b -> Permutation a
Functor,(forall m. Monoid m => Permutation m -> m)
-> (forall m a. Monoid m => (a -> m) -> Permutation a -> m)
-> (forall m a. Monoid m => (a -> m) -> Permutation a -> m)
-> (forall a b. (a -> b -> b) -> b -> Permutation a -> b)
-> (forall a b. (a -> b -> b) -> b -> Permutation a -> b)
-> (forall b a. (b -> a -> b) -> b -> Permutation a -> b)
-> (forall b a. (b -> a -> b) -> b -> Permutation a -> b)
-> (forall a. (a -> a -> a) -> Permutation a -> a)
-> (forall a. (a -> a -> a) -> Permutation a -> a)
-> (forall a. Permutation a -> [a])
-> (forall a. Permutation a -> Bool)
-> (forall a. Permutation a -> Int)
-> (forall a. Eq a => a -> Permutation a -> Bool)
-> (forall a. Ord a => Permutation a -> a)
-> (forall a. Ord a => Permutation a -> a)
-> (forall a. Num a => Permutation a -> a)
-> (forall a. Num a => Permutation a -> a)
-> Foldable Permutation
forall a. Eq a => a -> Permutation a -> Bool
forall a. Num a => Permutation a -> a
forall a. Ord a => Permutation a -> a
forall m. Monoid m => Permutation m -> m
forall a. Permutation a -> Bool
forall a. Permutation a -> Int
forall a. Permutation a -> [a]
forall a. (a -> a -> a) -> Permutation a -> a
forall m a. Monoid m => (a -> m) -> Permutation a -> m
forall b a. (b -> a -> b) -> b -> Permutation a -> b
forall a b. (a -> b -> b) -> b -> Permutation a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Permutation m -> m
fold :: forall m. Monoid m => Permutation m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Permutation a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Permutation a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Permutation a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Permutation a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Permutation a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Permutation a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Permutation a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Permutation a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Permutation a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Permutation a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Permutation a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Permutation a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Permutation a -> a
foldr1 :: forall a. (a -> a -> a) -> Permutation a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Permutation a -> a
foldl1 :: forall a. (a -> a -> a) -> Permutation a -> a
$ctoList :: forall a. Permutation a -> [a]
toList :: forall a. Permutation a -> [a]
$cnull :: forall a. Permutation a -> Bool
null :: forall a. Permutation a -> Bool
$clength :: forall a. Permutation a -> Int
length :: forall a. Permutation a -> Int
$celem :: forall a. Eq a => a -> Permutation a -> Bool
elem :: forall a. Eq a => a -> Permutation a -> Bool
$cmaximum :: forall a. Ord a => Permutation a -> a
maximum :: forall a. Ord a => Permutation a -> a
$cminimum :: forall a. Ord a => Permutation a -> a
minimum :: forall a. Ord a => Permutation a -> a
$csum :: forall a. Num a => Permutation a -> a
sum :: forall a. Num a => Permutation a -> a
$cproduct :: forall a. Num a => Permutation a -> a
product :: forall a. Num a => Permutation a -> a
Foldable)

-- | Lens to access the orbits of the permutation
orbits :: Lens (Permutation a) (Permutation b) (NonEmptyVector (Orbit a)) (NonEmptyVector (Orbit b))
orbits :: forall a b (f :: * -> *).
Functor f =>
(NonEmptyVector (Orbit a) -> f (NonEmptyVector (Orbit b)))
-> Permutation a -> f (Permutation b)
orbits = (Permutation a -> NonEmptyVector (Orbit a))
-> (Permutation a -> NonEmptyVector (Orbit b) -> Permutation b)
-> Lens
     (Permutation a)
     (Permutation b)
     (NonEmptyVector (Orbit a))
     (NonEmptyVector (Orbit b))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Permutation a -> NonEmptyVector (Orbit a)
forall a. Permutation a -> NonEmptyVector (Orbit a)
_orbits (\Permutation a
p NonEmptyVector (Orbit b)
os -> Permutation a
p { _orbits = os })

-- | Lens to access the indexes of the permutation.
--
-- idxes (fromEnum a) = (i,j) implies that a is the j^th item in the
-- i^th orbit
indexes :: Lens' (Permutation a) (UV.Vector (Int,Int))
indexes :: forall a (f :: * -> *).
Functor f =>
(Vector (Int, Int) -> f (Vector (Int, Int)))
-> Permutation a -> f (Permutation a)
indexes = (Permutation a -> Vector (Int, Int))
-> (Permutation a -> Vector (Int, Int) -> Permutation a)
-> Lens
     (Permutation a)
     (Permutation a)
     (Vector (Int, Int))
     (Vector (Int, Int))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Permutation a -> Vector (Int, Int)
forall a. Permutation a -> Vector (Int, Int)
_indexes (\Permutation a
p Vector (Int, Int)
ixs -> Permutation a
p { _indexes = ixs })


instance NFData a => NFData (Permutation a)

instance Traversable Permutation where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Permutation a -> f (Permutation b)
traverse a -> f b
f (Permutation NonEmptyVector (Orbit a)
os Vector (Int, Int)
is) = (NonEmptyVector (Orbit b) -> Vector (Int, Int) -> Permutation b)
-> Vector (Int, Int) -> NonEmptyVector (Orbit b) -> Permutation b
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmptyVector (Orbit b) -> Vector (Int, Int) -> Permutation b
forall a.
NonEmptyVector (Orbit a) -> Vector (Int, Int) -> Permutation a
Permutation Vector (Int, Int)
is (NonEmptyVector (Orbit b) -> Permutation b)
-> f (NonEmptyVector (Orbit b)) -> f (Permutation b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Orbit a -> f (Orbit b))
-> NonEmptyVector (Orbit a) -> f (NonEmptyVector (Orbit b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmptyVector a -> f (NonEmptyVector b)
traverse ((a -> f b) -> Orbit a -> f (Orbit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmptyVector a -> f (NonEmptyVector b)
traverse a -> f b
f) NonEmptyVector (Orbit a)
os

-- | Get the elements of the permutation
elems :: Permutation a -> NonEmptyVector a
elems :: forall a. Permutation a -> NonEmptyVector a
elems = (NonEmptyVector a -> NonEmptyVector a)
-> NonEmptyVector (NonEmptyVector a) -> NonEmptyVector a
forall a b.
(a -> NonEmptyVector b) -> NonEmptyVector a -> NonEmptyVector b
NonEmptyV.concatMap NonEmptyVector a -> NonEmptyVector a
forall a. a -> a
id (NonEmptyVector (NonEmptyVector a) -> NonEmptyVector a)
-> (Permutation a -> NonEmptyVector (NonEmptyVector a))
-> Permutation a
-> NonEmptyVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permutation a -> NonEmptyVector (NonEmptyVector a)
forall a. Permutation a -> NonEmptyVector (Orbit a)
_orbits

-- | Get the size of a permutation
--
-- running time: \(O(1)\)
size      :: Permutation a -> Int
size :: forall a. Permutation a -> Int
size Permutation a
perm = Vector (Int, Int) -> Int
forall a. Unbox a => Vector a -> Int
UV.length (Permutation a
permPermutation a
-> Getting (Vector (Int, Int)) (Permutation a) (Vector (Int, Int))
-> Vector (Int, Int)
forall s a. s -> Getting a s a -> a
^.Getting (Vector (Int, Int)) (Permutation a) (Vector (Int, Int))
forall a (f :: * -> *).
Functor f =>
(Vector (Int, Int) -> f (Vector (Int, Int)))
-> Permutation a -> f (Permutation a)
indexes)

-- | The cycle containing a given item
cycleOf        :: Enum a => Permutation a -> a -> Orbit a
cycleOf :: forall a. Enum a => Permutation a -> a -> Orbit a
cycleOf Permutation a
perm a
x = Permutation a
permPermutation a
-> Getting (Endo (Orbit a)) (Permutation a) (Orbit a) -> Orbit a
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(NonEmptyVector (Orbit a)
 -> Const (Endo (Orbit a)) (NonEmptyVector (Orbit a)))
-> Permutation a -> Const (Endo (Orbit a)) (Permutation a)
forall a b (f :: * -> *).
Functor f =>
(NonEmptyVector (Orbit a) -> f (NonEmptyVector (Orbit b)))
-> Permutation a -> f (Permutation b)
orbits((NonEmptyVector (Orbit a)
  -> Const (Endo (Orbit a)) (NonEmptyVector (Orbit a)))
 -> Permutation a -> Const (Endo (Orbit a)) (Permutation a))
-> ((Orbit a -> Const (Endo (Orbit a)) (Orbit a))
    -> NonEmptyVector (Orbit a)
    -> Const (Endo (Orbit a)) (NonEmptyVector (Orbit a)))
-> Getting (Endo (Orbit a)) (Permutation a) (Orbit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (NonEmptyVector (Orbit a))
-> Traversal'
     (NonEmptyVector (Orbit a)) (IxValue (NonEmptyVector (Orbit a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Permutation a
permPermutation a -> Getting (Endo Int) (Permutation a) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(Vector (Int, Int) -> Const (Endo Int) (Vector (Int, Int)))
-> Permutation a -> Const (Endo Int) (Permutation a)
forall a (f :: * -> *).
Functor f =>
(Vector (Int, Int) -> f (Vector (Int, Int)))
-> Permutation a -> f (Permutation a)
indexes((Vector (Int, Int) -> Const (Endo Int) (Vector (Int, Int)))
 -> Permutation a -> Const (Endo Int) (Permutation a))
-> ((Int -> Const (Endo Int) Int)
    -> Vector (Int, Int) -> Const (Endo Int) (Vector (Int, Int)))
-> Getting (Endo Int) (Permutation a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Vector (Int, Int))
-> Traversal' (Vector (Int, Int)) (IxValue (Vector (Int, Int)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (a -> Int
forall a. Enum a => a -> Int
fromEnum a
x)(((Int, Int) -> Const (Endo Int) (Int, Int))
 -> Vector (Int, Int) -> Const (Endo Int) (Vector (Int, Int)))
-> ((Int -> Const (Endo Int) Int)
    -> (Int, Int) -> Const (Endo Int) (Int, Int))
-> (Int -> Const (Endo Int) Int)
-> Vector (Int, Int)
-> Const (Endo Int) (Vector (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const (Endo Int) Int)
-> (Int, Int) -> Const (Endo Int) (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Int, Int) (Int, Int) Int Int
_1)


-- | Next item in a cyclic permutation
next     :: NonEmptyVector a -> Int -> a
next :: forall a. NonEmptyVector a -> Int -> a
next NonEmptyVector a
v Int
i = let n :: Int
n = NonEmptyVector a -> Int
forall a. NonEmptyVector a -> Int
NonEmptyV.length NonEmptyVector a
v in NonEmptyVector a
v NonEmptyVector a -> Int -> a
forall a. NonEmptyVector a -> Int -> a
NonEmptyV.! ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)

-- | Previous item in a cyclic permutation
previous     :: NonEmptyVector a -> Int -> a
previous :: forall a. NonEmptyVector a -> Int -> a
previous NonEmptyVector a
v Int
i = let n :: Int
n = NonEmptyVector a -> Int
forall a. NonEmptyVector a -> Int
NonEmptyV.length NonEmptyVector a
v in NonEmptyVector a
v NonEmptyVector a -> Int -> a
forall a. NonEmptyVector a -> Int -> a
NonEmptyV.! ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)

-- | Lookup the indices of an element, i.e. in which orbit the item is, and the
-- index within the orbit.
--
-- runnign time: \(O(1)\)
lookupIdx        :: Enum a => Permutation a -> a -> (Int,Int)
lookupIdx :: forall a. Enum a => Permutation a -> a -> (Int, Int)
lookupIdx Permutation a
perm a
x = Permutation a
permPermutation a
-> Getting (Endo (Int, Int)) (Permutation a) (Int, Int)
-> (Int, Int)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(Vector (Int, Int) -> Const (Endo (Int, Int)) (Vector (Int, Int)))
-> Permutation a -> Const (Endo (Int, Int)) (Permutation a)
forall a (f :: * -> *).
Functor f =>
(Vector (Int, Int) -> f (Vector (Int, Int)))
-> Permutation a -> f (Permutation a)
indexes((Vector (Int, Int) -> Const (Endo (Int, Int)) (Vector (Int, Int)))
 -> Permutation a -> Const (Endo (Int, Int)) (Permutation a))
-> (((Int, Int) -> Const (Endo (Int, Int)) (Int, Int))
    -> Vector (Int, Int)
    -> Const (Endo (Int, Int)) (Vector (Int, Int)))
-> Getting (Endo (Int, Int)) (Permutation a) (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Vector (Int, Int))
-> Traversal' (Vector (Int, Int)) (IxValue (Vector (Int, Int)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (a -> Int
forall a. Enum a => a -> Int
fromEnum a
x)

-- | Apply the permutation, i.e. consider the permutation as a function.
apply        :: Enum a => Permutation a -> a -> a
apply :: forall a. Enum a => Permutation a -> a -> a
apply Permutation a
perm a
x = let (Int
c,Int
i) = Permutation a -> a -> (Int, Int)
forall a. Enum a => Permutation a -> a -> (Int, Int)
lookupIdx Permutation a
perm a
x
               in NonEmptyVector a -> Int -> a
forall a. NonEmptyVector a -> Int -> a
next (Permutation a
permPermutation a
-> Getting
     (Endo (NonEmptyVector a)) (Permutation a) (NonEmptyVector a)
-> NonEmptyVector a
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(NonEmptyVector (NonEmptyVector a)
 -> Const
      (Endo (NonEmptyVector a)) (NonEmptyVector (NonEmptyVector a)))
-> Permutation a -> Const (Endo (NonEmptyVector a)) (Permutation a)
forall a b (f :: * -> *).
Functor f =>
(NonEmptyVector (Orbit a) -> f (NonEmptyVector (Orbit b)))
-> Permutation a -> f (Permutation b)
orbits((NonEmptyVector (NonEmptyVector a)
  -> Const
       (Endo (NonEmptyVector a)) (NonEmptyVector (NonEmptyVector a)))
 -> Permutation a
 -> Const (Endo (NonEmptyVector a)) (Permutation a))
-> ((NonEmptyVector a
     -> Const (Endo (NonEmptyVector a)) (NonEmptyVector a))
    -> NonEmptyVector (NonEmptyVector a)
    -> Const
         (Endo (NonEmptyVector a)) (NonEmptyVector (NonEmptyVector a)))
-> Getting
     (Endo (NonEmptyVector a)) (Permutation a) (NonEmptyVector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (NonEmptyVector (NonEmptyVector a))
-> Traversal'
     (NonEmptyVector (NonEmptyVector a))
     (IxValue (NonEmptyVector (NonEmptyVector a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (NonEmptyVector (NonEmptyVector a))
c) Int
i


-- | Find the cycle in the permutation starting at element s
orbitFrom     :: Eq a => a -> (a -> a) -> NonEmpty a
orbitFrom :: forall a. Eq a => a -> (a -> a) -> NonEmpty a
orbitFrom a
s a -> a
p = a
s a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
s) ([a] -> [a]) -> (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.tail (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> NonEmpty a
forall a. (a -> a) -> a -> NonEmpty a
NonEmpty.iterate a -> a
p a
s)

-- | Given a vector with items in the permutation, and a permutation (by its
-- functional representation) construct the cyclic representation of the
-- permutation.
cycleRep        :: (Enum a, Eq a) => NonEmptyVector a -> (a -> a) -> Permutation a
cycleRep :: forall a.
(Enum a, Eq a) =>
NonEmptyVector a -> (a -> a) -> Permutation a
cycleRep NonEmptyVector a
v a -> a
perm = Int -> NonEmpty (NonEmpty a) -> Permutation a
forall a. Enum a => Int -> NonEmpty (NonEmpty a) -> Permutation a
toCycleRep Int
n (NonEmpty (NonEmpty a) -> Permutation a)
-> NonEmpty (NonEmpty a) -> Permutation a
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (NonEmpty (NonEmpty a))) -> NonEmpty (NonEmpty a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (NonEmpty (NonEmpty a))) -> NonEmpty (NonEmpty a))
-> (forall s. ST s (NonEmpty (NonEmpty a)))
-> NonEmpty (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ do
    MVector s Bool
bv    <- Int -> Bool -> ST s (MVector (PrimState (ST s)) Bool)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
UMV.replicate Int
n Bool
False -- bit vector of marks
    [Maybe (NonEmpty a)]
morbs <- [Int]
-> (Int -> ST s (Maybe (NonEmpty a))) -> ST s [Maybe (NonEmpty a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> ST s (Maybe (NonEmpty a))) -> ST s [Maybe (NonEmpty a)])
-> (Int -> ST s (Maybe (NonEmpty a))) -> ST s [Maybe (NonEmpty a)]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
               Bool
m <- MVector (PrimState (ST s)) Bool -> Int -> ST s Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UMV.read MVector s Bool
MVector (PrimState (ST s)) Bool
bv (a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ NonEmptyVector a
v NonEmptyVector a -> Int -> a
forall a. NonEmptyVector a -> Int -> a
NonEmptyV.! Int
i)
               if Bool
m then Maybe (NonEmpty a) -> ST s (Maybe (NonEmpty a))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty a)
forall a. Maybe a
Nothing -- already visited
                    else do
                      let xs :: NonEmpty a
xs = a -> (a -> a) -> NonEmpty a
forall a. Eq a => a -> (a -> a) -> NonEmpty a
orbitFrom (NonEmptyVector a
v NonEmptyVector a -> Int -> a
forall a. NonEmptyVector a -> Int -> a
NonEmptyV.! Int
i) a -> a
perm
                      MVector (PrimState (ST s)) Bool -> NonEmpty Int -> ST s ()
forall {t :: * -> *} {m :: * -> *}.
(Foldable t, PrimMonad m) =>
MVector (PrimState m) Bool -> t Int -> m ()
markAll MVector s Bool
MVector (PrimState (ST s)) Bool
bv (NonEmpty Int -> ST s ()) -> NonEmpty Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ (a -> Int) -> NonEmpty a -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a. Enum a => a -> Int
fromEnum NonEmpty a
xs
                      Maybe (NonEmpty a) -> ST s (Maybe (NonEmpty a))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty a) -> ST s (Maybe (NonEmpty a)))
-> (NonEmpty a -> Maybe (NonEmpty a))
-> NonEmpty a
-> ST s (Maybe (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (NonEmpty a -> ST s (Maybe (NonEmpty a)))
-> NonEmpty a -> ST s (Maybe (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ NonEmpty a
xs
    NonEmpty (NonEmpty a) -> ST s (NonEmpty (NonEmpty a))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (NonEmpty a) -> ST s (NonEmpty (NonEmpty a)))
-> ([Maybe (NonEmpty a)] -> NonEmpty (NonEmpty a))
-> [Maybe (NonEmpty a)]
-> ST s (NonEmpty (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NonEmpty a] -> NonEmpty (NonEmpty a)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([NonEmpty a] -> NonEmpty (NonEmpty a))
-> ([Maybe (NonEmpty a)] -> [NonEmpty a])
-> [Maybe (NonEmpty a)]
-> NonEmpty (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (NonEmpty a)] -> [NonEmpty a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (NonEmpty a)] -> ST s (NonEmpty (NonEmpty a)))
-> [Maybe (NonEmpty a)] -> ST s (NonEmpty (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ [Maybe (NonEmpty a)]
morbs
  where
    n :: Int
n  = NonEmptyVector a -> Int
forall a. NonEmptyVector a -> Int
NonEmptyV.length NonEmptyVector a
v

    mark :: MVector (PrimState m) Bool -> Int -> m ()
mark    MVector (PrimState m) Bool
bv Int
i = MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.write MVector (PrimState m) Bool
bv Int
i Bool
True
    markAll :: MVector (PrimState m) Bool -> t Int -> m ()
markAll MVector (PrimState m) Bool
bv   = (Int -> m ()) -> t Int -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MVector (PrimState m) Bool -> Int -> m ()
forall {m :: * -> *}.
PrimMonad m =>
MVector (PrimState m) Bool -> Int -> m ()
mark MVector (PrimState m) Bool
bv)

-- | Given the size n, and a list of Cycles, turns the cycles into a
-- cyclic representation of the Permutation.
toCycleRep      :: Enum a => Int -> NonEmpty (NonEmpty a) -> Permutation a
toCycleRep :: forall a. Enum a => Int -> NonEmpty (NonEmpty a) -> Permutation a
toCycleRep Int
n NonEmpty (NonEmpty a)
os = NonEmptyVector (Orbit a) -> Vector (Int, Int) -> Permutation a
forall a.
NonEmptyVector (Orbit a) -> Vector (Int, Int) -> Permutation a
Permutation (NonEmpty (Orbit a) -> NonEmptyVector (Orbit a)
forall a. NonEmpty a -> NonEmptyVector a
NonEmptyV.fromNonEmpty (NonEmpty (Orbit a) -> NonEmptyVector (Orbit a))
-> (NonEmpty (NonEmpty a) -> NonEmpty (Orbit a))
-> NonEmpty (NonEmpty a)
-> NonEmptyVector (Orbit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> Orbit a)
-> NonEmpty (NonEmpty a) -> NonEmpty (Orbit a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> Orbit a
forall a. NonEmpty a -> NonEmptyVector a
NonEmptyV.fromNonEmpty (NonEmpty (NonEmpty a) -> NonEmptyVector (Orbit a))
-> NonEmpty (NonEmpty a) -> NonEmptyVector (Orbit a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a)
os)
                              (Int -> NonEmpty (NonEmpty a) -> Vector (Int, Int)
forall a.
Enum a =>
Int -> NonEmpty (NonEmpty a) -> Vector (Int, Int)
genIndexes Int
n NonEmpty (NonEmpty a)
os)

-- | Helper function to generate the indices of a permutation
genIndexes      :: Enum a => Int -> NonEmpty (NonEmpty a)  -> UV.Vector (Int,Int)
genIndexes :: forall a.
Enum a =>
Int -> NonEmpty (NonEmpty a) -> Vector (Int, Int)
genIndexes Int
n NonEmpty (NonEmpty a)
os = (forall s. ST s (MVector s (Int, Int))) -> Vector (Int, Int)
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
UV.create ((forall s. ST s (MVector s (Int, Int))) -> Vector (Int, Int))
-> (forall s. ST s (MVector s (Int, Int))) -> Vector (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
                                MVector s (Int, Int)
v <- Int -> ST s (MVector (PrimState (ST s)) (Int, Int))
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
UMV.new Int
n
                                ((Int, (Int, Int)) -> ST s ()) -> [(Int, (Int, Int))] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> (Int, Int) -> ST s ()) -> (Int, (Int, Int)) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> (Int, Int) -> ST s ()) -> (Int, (Int, Int)) -> ST s ())
-> (Int -> (Int, Int) -> ST s ()) -> (Int, (Int, Int)) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MVector (PrimState (ST s)) (Int, Int)
-> Int -> (Int, Int) -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.write MVector s (Int, Int)
MVector (PrimState (ST s)) (Int, Int)
v) [(Int, (Int, Int))]
ixes'
                                MVector s (Int, Int) -> ST s (MVector s (Int, Int))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s (Int, Int)
v
  where
    f :: a -> t a -> [(Int, (a, b))]
f a
i t a
c = (a -> b -> (Int, (a, b))) -> [a] -> [b] -> [(Int, (a, b))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x b
j -> (a -> Int
forall a. Enum a => a -> Int
fromEnum a
x,(a
i,b
j))) (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
c) [b
0..]
    ixes' :: [(Int, (Int, Int))]
ixes' = [[(Int, (Int, Int))]] -> [(Int, (Int, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Int, (Int, Int))]] -> [(Int, (Int, Int))])
-> [[(Int, (Int, Int))]] -> [(Int, (Int, Int))]
forall a b. (a -> b) -> a -> b
$ (Int -> NonEmpty a -> [(Int, (Int, Int))])
-> [Int] -> [NonEmpty a] -> [[(Int, (Int, Int))]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> NonEmpty a -> [(Int, (Int, Int))]
forall {t :: * -> *} {b} {a} {a}.
(Foldable t, Num b, Enum a, Enum b) =>
a -> t a -> [(Int, (a, b))]
f [Int
0..] (NonEmpty (NonEmpty a) -> [NonEmpty a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty (NonEmpty a)
os)