{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances #-}

-- |
-- Copyright   : Anders Claesson 2013-2016
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--
-- Generating permutations: rank and unrank

module Sym.Perm
    (
      module Sym.Internal.CLongArray
    , Perm
    , emptyperm
    , one
    , idperm
    , ebb
    , mkPerm
    , rank
    , unrank
    , perms
    ) where

import Data.List
import Sym.Internal.CLongArray
import Foreign
import Foreign.C.Types
import System.IO.Unsafe

-- | A permutation is just a 'CLongArray'. By convention a permutation
-- of size @n@ is understood to be a permutation of @[0..n-1]@.
type Perm = CLongArray

-- | The unique permutation length zero.
emptyperm :: Perm
emptyperm :: Perm
emptyperm = [Int] -> Perm
fromList []

-- | The unique permutation length one.
one :: Perm
one :: Perm
one = [Int] -> Perm
fromList [Int
0]

-- | The identity permutation.
idperm :: Int -> Perm
idperm :: Int -> Perm
idperm Int
n = [Int] -> Perm
fromList [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

-- | The reverse of the identity permutation.
ebb :: Int -> Perm
ebb :: Int -> Perm
ebb Int
n = [Int] -> Perm
fromList [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..Int
0]

-- | Construct a permutation from a list of elements. As opposed to
-- 'fromList' this is a safe function in the sense that the output of
-- @mkPerm xs@ is guaranteed to be a permutation of @[0..length xs-1]@.
-- E.g., @mkPerm \"baxa\" == fromList [2,0,3,1]@.
mkPerm :: Ord a => [a] -> Perm
mkPerm :: forall a. Ord a => [a] -> Perm
mkPerm [a]
xs =
    let sti :: [a] -> [Int]
sti [a]
ys = ((a, Int) -> Int) -> [(a, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> Int
forall a b. (a, b) -> b
snd ([(a, Int)] -> [Int])
-> ([(a, Int)] -> [(a, Int)]) -> [(a, Int)] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Int)] -> [(a, Int)]
forall a. Ord a => [a] -> [a]
sort ([(a, Int)] -> [Int]) -> [(a, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ys [Int
0::Int ..]
    in [Int] -> Perm
fromList ([Int] -> Perm) -> [Int] -> Perm
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Int]
forall {a}. Ord a => [a] -> [Int]
sti ([Int] -> [Int]) -> ([a] -> [Int]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Int]
forall {a}. Ord a => [a] -> [Int]
sti) [a]
xs

foreign import ccall unsafe "rank.h rank" c_rank
    :: Ptr CLong -> CLong -> IO CDouble

-- | The rank of the given permutation, where the rank is defined as
-- in [W. Myrvold and F. Ruskey, Ranking and Unranking Permutations in
-- Linear Time, Information Processing Letters, 79 (2001) 281-284].
rank :: Perm -> Integer
rank :: Perm -> Integer
rank Perm
w =
    let n :: CLong
n = Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Perm -> Int
forall a. Size a => a -> Int
size Perm
w)
    in CDouble -> Integer
forall b. Integral b => CDouble -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (CDouble -> Integer)
-> ((Ptr CLong -> IO CDouble) -> CDouble)
-> (Ptr CLong -> IO CDouble)
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CDouble -> CDouble
forall a. IO a -> a
unsafePerformIO (IO CDouble -> CDouble)
-> ((Ptr CLong -> IO CDouble) -> IO CDouble)
-> (Ptr CLong -> IO CDouble)
-> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> (Ptr CLong -> IO CDouble) -> IO CDouble
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
w ((Ptr CLong -> IO CDouble) -> Integer)
-> (Ptr CLong -> IO CDouble) -> Integer
forall a b. (a -> b) -> a -> b
$ (Ptr CLong -> CLong -> IO CDouble)
-> CLong -> Ptr CLong -> IO CDouble
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CLong -> CLong -> IO CDouble
c_rank CLong
n
{-# INLINE rank #-}

foreign import ccall unsafe "rank.h unrank" c_unrank
    :: Ptr CLong -> CLong -> CDouble -> IO ()

-- | The permutation of size @n@ whose rank is @r@, where the rank
-- is defined as in [W. Myrvold and F. Ruskey, Ranking and Unranking
-- Permutations in Linear Time, Information Processing Letters, 79
-- (2001) 281-284].
unrank :: Int -> Integer -> Perm
unrank :: Int -> Integer -> Perm
unrank Int
n Integer
r =
    IO Perm -> Perm
forall a. IO a -> a
unsafePerformIO (IO Perm -> Perm)
-> ((Ptr CLong -> IO ()) -> IO Perm)
-> (Ptr CLong -> IO ())
-> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr CLong -> IO ()) -> IO Perm
unsafeNew Int
n ((Ptr CLong -> IO ()) -> Perm) -> (Ptr CLong -> IO ()) -> Perm
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
ptr ->
        Ptr CLong -> CLong -> CDouble -> IO ()
c_unrank Ptr CLong
ptr (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Integer -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r)
{-# INLINE unrank #-}

-- | All permutations of a given size.
perms :: Int -> [Perm]
perms :: Int -> [Perm]
perms Int
n = (Integer -> Perm) -> [Integer] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Integer -> Perm
unrank Int
n) [Integer
0..Integer
nFacInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1] where nFac :: Integer
nFac = [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Integer
1..Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n]