-- | Permutations
--
-- Intended for qualified import.
--
-- > import Data.Falsify.Permutation (Permutation)
-- > import qualified Data.Falsify.Permutation as Permutation
module Data.Falsify.Permutation (
    Permutation -- opaque
  , invariant
  , toSwaps
    -- * Construction
  , identity
  , fromSwaps
    -- * Properties
  , size
    -- * Using permutations
  , apply
  ) where

import Control.Monad
import Control.Monad.ST

import qualified Data.Vector         as V
import qualified Data.Vector.Mutable as VM

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Permutation is a sequence of swaps
newtype Permutation = Permutation {
      -- | Individual swaps executed by this permutation
      Permutation -> [(Word, Word)]
toSwaps :: [(Word, Word)]
    }
  deriving stock (Int -> Permutation -> ShowS
[Permutation] -> ShowS
Permutation -> String
(Int -> Permutation -> ShowS)
-> (Permutation -> String)
-> ([Permutation] -> ShowS)
-> Show Permutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permutation -> ShowS
showsPrec :: Int -> Permutation -> ShowS
$cshow :: Permutation -> String
show :: Permutation -> String
$cshowList :: [Permutation] -> ShowS
showList :: [Permutation] -> ShowS
Show)

-- | Permutation invariant
--
-- For every swap @(i, j)@ in the permutation we must have @i > j@.
invariant :: Permutation -> Bool
invariant :: Permutation -> Bool
invariant = ((Word, Word) -> Bool) -> [(Word, Word)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word, Word) -> Bool
checkSwap ([(Word, Word)] -> Bool)
-> (Permutation -> [(Word, Word)]) -> Permutation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permutation -> [(Word, Word)]
toSwaps
  where
    checkSwap :: (Word, Word) -> Bool
    checkSwap :: (Word, Word) -> Bool
checkSwap (Word
i, Word
j) = Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
j

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Identity permutation
identity :: Permutation
identity :: Permutation
identity = [(Word, Word)] -> Permutation
fromSwaps []

-- | From swaps
--
-- Any identity swaps are filtered out.
fromSwaps :: [(Word, Word)] -> Permutation
fromSwaps :: [(Word, Word)] -> Permutation
fromSwaps = [(Word, Word)] -> Permutation
Permutation ([(Word, Word)] -> Permutation)
-> ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)]
-> Permutation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word, Word) -> Bool) -> [(Word, Word)] -> [(Word, Word)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Word
i, Word
j) -> Word
i Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
j)

{-------------------------------------------------------------------------------
  Properties
-------------------------------------------------------------------------------}

-- | Number of swaps
size :: Permutation -> Int
size :: Permutation -> Int
size = [(Word, Word)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Word, Word)] -> Int)
-> (Permutation -> [(Word, Word)]) -> Permutation -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permutation -> [(Word, Word)]
toSwaps

{-------------------------------------------------------------------------------
  Using permutations
-------------------------------------------------------------------------------}

-- | Apply permutation
apply :: Permutation -> [a] -> [a]
apply :: forall a. Permutation -> [a] -> [a]
apply (Permutation [(Word, Word)]
p) [a]
xs =
    Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Vector a -> [a]
forall a b. (a -> b) -> a -> b
$ (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify ([(Int, Int)] -> ((Int, Int) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((Word, Word) -> (Int, Int)) -> [(Word, Word)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> (Int, Int)
conv [(Word, Word)]
p) (((Int, Int) -> ST s ()) -> ST s ())
-> (MVector s a -> (Int, Int) -> ST s ()) -> MVector s a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector s a -> (Int, Int) -> ST s ()
forall s a. MVector s a -> (Int, Int) -> ST s ()
swap) ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
xs)
  where
    swap :: V.MVector s a -> (Int, Int) -> ST s ()
    swap :: forall s a. MVector s a -> (Int, Int) -> ST s ()
swap MVector s a
vec (Int
i, Int
j) = do
        a
x <- MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector s a
MVector (PrimState (ST s)) a
vec Int
i
        a
y <- MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector s a
MVector (PrimState (ST s)) a
vec Int
j
        MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector s a
MVector (PrimState (ST s)) a
vec Int
i a
y
        MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector s a
MVector (PrimState (ST s)) a
vec Int
j a
x

    conv :: (Word, Word) -> (Int, Int)
    conv :: (Word, Word) -> (Int, Int)
conv (Word
i, Word
j) = (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i, Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
j)