-- |
-- Copyright   : Anders Claesson 2013-2016
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--
-- Components of permutations.
-- 

module Sym.Perm.Component
    (
      components
    , skewComponents
    , leftMaxima
    , leftMinima
    , rightMaxima
    , rightMinima
    ) where

import Foreign
import System.IO.Unsafe
import Sym.Perm
import qualified Sym.Perm.D8 as D8

-- Positions /i/ such that /max{ w[j] : j <= i } = i/. These positions
-- mark the boundaries of components.
comps :: Perm -> [Int]
comps :: Perm -> [Int]
comps Perm
w = IO [Int] -> [Int]
forall a. IO a -> a
unsafePerformIO (IO [Int] -> [Int])
-> ((Ptr CLong -> IO [Int]) -> IO [Int])
-> (Ptr CLong -> IO [Int])
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> (Ptr CLong -> IO [Int]) -> IO [Int]
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
w ((Ptr CLong -> IO [Int]) -> [Int])
-> (Ptr CLong -> IO [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> Int -> Int -> Ptr CLong -> IO [Int]
forall {a}.
(Integral a, Storable a) =>
[Int] -> Int -> Int -> Ptr a -> IO [Int]
go [] Int
0 Int
0
    where
      n :: Int
n = Perm -> Int
forall a. Size a => a -> Int
size Perm
w
      go :: [Int] -> Int -> Int -> Ptr a -> IO [Int]
go [Int]
ks Int
m Int
i Ptr a
p
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = [Int] -> IO [Int]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
ks)
        | Bool
otherwise =
            do Int
y <- a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> IO a -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
               let p' :: Ptr a
p'  = Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
p Int
1
               let i' :: Int
i'  = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
               let m' :: Int
m'  = if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m then Int
y else Int
m
               let ks' :: [Int]
ks' = if Int
m' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ks else [Int]
ks
               [Int] -> Int -> Int -> Ptr a -> IO [Int]
go [Int]
ks' Int
m' Int
i' Ptr a
p'

-- | The list of (plus) components.
components :: Perm -> [Perm]
components :: Perm -> [Perm]
components Perm
w =
    let ds :: [Int]
ds = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Perm -> [Int]
comps Perm
w)
        ks :: [Int]
ks = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
tail [Int]
ds) [Int]
ds
        ws :: [Perm]
ws = [Int] -> Perm -> [Perm]
slices [Int]
ks Perm
w
    in (Int -> Perm -> Perm) -> [Int] -> [Perm] -> [Perm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
d Perm
v -> (Int -> CLong -> CLong) -> Perm -> Perm
imap (\Int
_ CLong
x -> CLong
x CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
- Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) Perm
v) [Int]
ds [Perm]
ws

-- | The list of skew components, also called minus components.
skewComponents :: Perm -> [Perm]
skewComponents :: Perm -> [Perm]
skewComponents = (Perm -> Perm) -> [Perm] -> [Perm]
forall a b. (a -> b) -> [a] -> [b]
map Perm -> Perm
D8.complement ([Perm] -> [Perm]) -> (Perm -> [Perm]) -> Perm -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> [Perm]
components (Perm -> [Perm]) -> (Perm -> Perm) -> Perm -> [Perm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> Perm
D8.complement

records :: (a -> a -> Bool) -> [a] -> [a]
records :: forall a. (a -> a -> Bool) -> [a] -> [a]
records a -> a -> Bool
_ []     = []
records a -> a -> Bool
f (a
x:[a]
xs) = [a] -> [a] -> [a]
recs [a
x] [a]
xs
    where
      recs :: [a] -> [a] -> [a]
recs rs :: [a]
rs@(a
r:[a]
_) (a
y:[a]
ys) = [a] -> [a] -> [a]
recs ((if a -> a -> Bool
f a
r a
y then a
y else a
r)a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs) [a]
ys
      recs [a]
rs       [a]
_      = [a]
rs

-- | For each position, left-to-right, records the largest value seen
-- thus far.
leftMaxima :: Perm -> [Int]
leftMaxima :: Perm -> [Int]
leftMaxima Perm
w = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
records Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Perm -> [Int]
toList Perm
w)

-- | For each position, left-to-right, records the smallest value seen
-- thus far.
leftMinima :: Perm -> [Int]
leftMinima :: Perm -> [Int]
leftMinima Perm
w = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
records Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Perm -> [Int]
toList Perm
w)

-- | For each position, /right-to-left/, records the largest value seen
-- thus far.
rightMaxima :: Perm -> [Int]
rightMaxima :: Perm -> [Int]
rightMaxima Perm
w = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
records Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) ([Int] -> [Int]
forall a. [a] -> [a]
reverse (Perm -> [Int]
toList Perm
w))

-- | For each position, /right-to-left/, records the smallest value seen
-- thus far.
rightMinima :: Perm -> [Int]
rightMinima :: Perm -> [Int]
rightMinima Perm
w = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
records Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) ([Int] -> [Int]
forall a. [a] -> [a]
reverse (Perm -> [Int]
toList Perm
w))