-- |
-- Copyright   : Anders Claesson 2017
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--
-- Common permutation statistics. Most of these are refined (list) versions of
-- those in Sym.Perm.Stat
--

module Sym.Perm.ListStat
    (
      asc         -- list of ascent
    , ascIx       -- ascent indices
    , ascTops     -- ascent tops
    , ascBots     -- ascent bottoms
    , des         -- descents
    , desIx       -- descent indices
    , desTops     -- descent tops
    , desBots     -- descent bottoms
    , exc         -- excedances
    , fp          -- fixed points
    -- , sfp         -- strong fixed points
    -- , cyc         -- cycles
    -- , inv         -- inversions
    -- , peak        -- peaks
    -- , vall        -- valleys
    -- , dasc        -- double ascents
    -- , ddes        -- double descents
    -- , lmin        -- left-to-right minima
    -- , lmax        -- left-to-right maxima
    -- , rmin        -- right-to-left minima
    -- , rmax        -- right-to-left maxima
    -- , comp        -- components
    -- , scomp       -- skew components
    -- , asc0        -- small ascents
    , des0        -- list small descents
    , des0Ix      -- indices of small descents
    , des0Tops    -- small descents tops
    , des0Bots    -- small descents bottoms
    -- , lis         -- longest increasing subsequence
    -- , lds         -- longest decreasing subsequence
    ) where

import Prelude hiding (head, last)
import Sym.Perm

asc :: Perm -> [(Int, Int, Int)]
asc :: Perm -> [(Int, Int, Int)]
asc Perm
w =
    [ (Int
i,Int
x,Int
y)
    | (Int
i,Int
x,Int
y) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Int]
ys (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
ys)
    , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y
    ]
  where
    ys :: [Int]
ys = Perm -> [Int]
toList Perm
w

ascIx :: Perm -> [Int]
ascIx :: Perm -> [Int]
ascIx Perm
w = [ Int
i | (Int
i,Int
_,Int
_) <- Perm -> [(Int, Int, Int)]
asc Perm
w ]

ascBots :: Perm -> [Int]
ascBots :: Perm -> [Int]
ascBots Perm
w = [ Int
x | (Int
_,Int
x,Int
_) <- Perm -> [(Int, Int, Int)]
asc Perm
w ]

ascTops :: Perm -> [Int]
ascTops :: Perm -> [Int]
ascTops Perm
w = [ Int
y | (Int
_,Int
_,Int
y) <- Perm -> [(Int, Int, Int)]
asc Perm
w ]

des :: Perm -> [(Int, Int, Int)]
des :: Perm -> [(Int, Int, Int)]
des Perm
w =
    [ (Int
i,Int
x,Int
y)
    | (Int
i,Int
x,Int
y) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Int]
ys (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
ys)
    , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y
    ]
  where
    ys :: [Int]
ys = Perm -> [Int]
toList Perm
w

desIx :: Perm -> [Int]
desIx :: Perm -> [Int]
desIx Perm
w = [ Int
i | (Int
i,Int
_,Int
_) <- Perm -> [(Int, Int, Int)]
des Perm
w ]

desBots :: Perm -> [Int]
desBots :: Perm -> [Int]
desBots Perm
w = [ Int
x | (Int
_,Int
x,Int
_) <- Perm -> [(Int, Int, Int)]
des Perm
w ]

desTops :: Perm -> [Int]
desTops :: Perm -> [Int]
desTops Perm
w = [ Int
y | (Int
_,Int
_,Int
y) <- Perm -> [(Int, Int, Int)]
des Perm
w ]

exc :: Perm -> [Int]
exc :: Perm -> [Int]
exc Perm
w = [ Int
i | Int
i <- [Int
0 .. Perm -> Int
forall a. Size a => a -> Int
size Perm
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Perm
w Perm -> Int -> Int
`at` Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i ]

fp :: Perm -> [Int]
fp :: Perm -> [Int]
fp Perm
w = [ Int
i | Int
i <- [Int
0 .. Perm -> Int
forall a. Size a => a -> Int
size Perm
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1], Perm
w Perm -> Int -> Int
`at` Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i ]

-- sfp :: Perm -> [Int]
-- sfp = undefined

-- cyc :: Perm -> [[Int]]
-- cyc = undefined

-- inv :: Perm -> [(Int, Int)]
-- inv = undefined

-- peak :: Perm -> [Int]
-- peak = undefined

-- vall :: Perm -> [Int]
-- vall = undefined

-- dasc :: Perm -> [Int]
-- dasc = undefined

-- ddes :: Perm -> [Int]
-- ddes = undefined

-- lmin :: Perm -> [Int]
-- lmin = undefined

-- lmax :: Perm -> [Int]
-- lmax = undefined

-- rmin :: Perm -> [Int]
-- rmin = undefined

-- rmax :: Perm -> [Int]
-- rmax = undefined

-- comp :: Perm -> [Perm]
-- comp = undefined

-- scomp :: Perm -> [Perm]
-- scomp = undefined

-- asc0 :: Perm -> [Int]
-- asc0 = undefined

des0 :: Perm -> [(Int, Int, Int)]
des0 :: Perm -> [(Int, Int, Int)]
des0 Perm
w =
    [ (Int
i,Int
x,Int
y)
    | (Int
i,Int
x,Int
y) <- [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Int]
ys (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
ys)
    , Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    ]
  where
    ys :: [Int]
ys = Perm -> [Int]
toList Perm
w

des0Ix :: Perm -> [Int]
des0Ix :: Perm -> [Int]
des0Ix Perm
w = [ Int
i | (Int
i,Int
_,Int
_) <- Perm -> [(Int, Int, Int)]
des0 Perm
w ]

des0Bots :: Perm -> [Int]
des0Bots :: Perm -> [Int]
des0Bots Perm
w = [ Int
x | (Int
_,Int
x,Int
_) <- Perm -> [(Int, Int, Int)]
des0 Perm
w ]

des0Tops :: Perm -> [Int]
des0Tops :: Perm -> [Int]
des0Tops Perm
w = [ Int
y | (Int
_,Int
_,Int
y) <- Perm -> [(Int, Int, Int)]
des0 Perm
w ]

-- lis :: Perm -> [Int]
-- lis = undefined

-- lds :: Perm -> [Int]
-- lds = undefined