diff --git a/Sym/Perm/ListStat.hs b/Sym/Perm/ListStat.hs new file mode 100644 --- /dev/null +++ b/Sym/Perm/ListStat.hs @@ -0,0 +1,152 @@ +-- | +-- Copyright : Anders Claesson 2017 +-- Maintainer : Anders Claesson +-- +-- 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 w = + [ (i,x,y) + | (i,x,y) <- zip3 [0..] ys (drop 1 ys) + , x < y + ] + where + ys = toList w + +ascIx :: Perm -> [Int] +ascIx w = [ i | (i,_,_) <- asc w ] + +ascBots :: Perm -> [Int] +ascBots w = [ x | (_,x,_) <- asc w ] + +ascTops :: Perm -> [Int] +ascTops w = [ y | (_,_,y) <- asc w ] + +des :: Perm -> [(Int, Int, Int)] +des w = + [ (i,x,y) + | (i,x,y) <- zip3 [0..] ys (drop 1 ys) + , x > y + ] + where + ys = toList w + +desIx :: Perm -> [Int] +desIx w = [ i | (i,_,_) <- des w ] + +desBots :: Perm -> [Int] +desBots w = [ x | (_,x,_) <- des w ] + +desTops :: Perm -> [Int] +desTops w = [ y | (_,_,y) <- des w ] + +exc :: Perm -> [Int] +exc w = [ i | i <- [0 .. size w - 1], w `at` i > i ] + +fp :: Perm -> [Int] +fp w = [ i | i <- [0 .. size w - 1], w `at` i == 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 w = + [ (i,x,y) + | (i,x,y) <- zip3 [0..] ys (drop 1 ys) + , x == y + 1 + ] + where + ys = toList w + +des0Ix :: Perm -> [Int] +des0Ix w = [ i | (i,_,_) <- des0 w ] + +des0Bots :: Perm -> [Int] +des0Bots w = [ x | (_,x,_) <- des0 w ] + +des0Tops :: Perm -> [Int] +des0Tops w = [ y | (_,_,y) <- des0 w ] + +-- lis :: Perm -> [Int] +-- lis = undefined + +-- lds :: Perm -> [Int] +-- lds = undefined diff --git a/Sym/Perm/Pattern.hs b/Sym/Perm/Pattern.hs --- a/Sym/Perm/Pattern.hs +++ b/Sym/Perm/Pattern.hs @@ -83,16 +83,18 @@ -- | The set of minimal elements with respect to containment. FIX: Poor -- implementation minima :: [Pattern] -> [Pattern] -minima [] = [] -minima ws = let (v:vs) = nubSort ws - in v : minima (avoiders [v] vs) +minima ws = + case nubSort ws of + [] -> [] + (v:vs) -> v : minima (avoiders [v] vs) -- | The set of maximal elements with respect to containment. FIX: Poor -- implementation maxima :: [Pattern] -> [Pattern] -maxima [] = [] -maxima ws = let (v:vs) = reverse $ nubSort ws - in v : maxima (filter (avoids v) vs) +maxima ws = + case reverse (nubSort ws) of + [] -> [] + (v:vs) -> v : maxima (filter (avoids v) vs) -- | @coeff f v@ is the coefficient of @v@ when expanding the -- permutation statistic @f@ as a sum of permutations/patterns. See diff --git a/Sym/Perm/STAT.hs b/Sym/Perm/STAT.hs deleted file mode 100644 --- a/Sym/Perm/STAT.hs +++ /dev/null @@ -1,154 +0,0 @@ --- | --- Copyright : Anders Claesson 2017 --- Maintainer : Anders Claesson --- --- Common permutation statistics. Most of these are "set" versions of --- those in Sym.Perm.Stat --- - -module Sym.Perm.STAT - ( - 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 -import qualified Sym.Perm.SSYT as Y -import qualified Sym.Perm.D8 as D8 - -asc :: Perm -> [(Int, Int, Int)] -asc w = - [ (i,x,y) - | (i,x,y) <- zip3 [0..] ys (drop 1 ys) - , x < y - ] - where - ys = toList w - -ascIx :: Perm -> [Int] -ascIx w = [ i | (i,_,_) <- asc w ] - -ascBots :: Perm -> [Int] -ascBots w = [ x | (_,x,_) <- asc w ] - -ascTops :: Perm -> [Int] -ascTops w = [ y | (_,_,y) <- asc w ] - -des :: Perm -> [(Int, Int, Int)] -des w = - [ (i,x,y) - | (i,x,y) <- zip3 [0..] ys (drop 1 ys) - , x > y - ] - where - ys = toList w - -desIx :: Perm -> [Int] -desIx w = [ i | (i,_,_) <- des w ] - -desBots :: Perm -> [Int] -desBots w = [ x | (_,x,_) <- des w ] - -desTops :: Perm -> [Int] -desTops w = [ y | (_,_,y) <- des w ] - -exc :: Perm -> [Int] -exc w = [ i | i <- [0 .. size w - 1], w `at` i > i ] - -fp :: Perm -> [Int] -fp w = [ i | i <- [0 .. size w - 1], w `at` i == 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 w = - [ (i,x,y) - | (i,x,y) <- zip3 [0..] ys (drop 1 ys) - , x == y + 1 - ] - where - ys = toList w - -des0Ix :: Perm -> [Int] -des0Ix w = [ i | (i,_,_) <- des0 w ] - -des0Bots :: Perm -> [Int] -des0Bots w = [ x | (_,x,_) <- des0 w ] - -des0Tops :: Perm -> [Int] -des0Tops w = [ y | (_,_,y) <- des0 w ] - --- lis :: Perm -> [Int] --- lis = undefined - --- lds :: Perm -> [Int] --- lds = undefined diff --git a/Sym/Permgram.hs b/Sym/Permgram.hs --- a/Sym/Permgram.hs +++ b/Sym/Permgram.hs @@ -23,7 +23,6 @@ import Data.Ord import Data.List import Control.Monad -import Control.Applicative import Sym.Perm (Perm, unsafeAt) import qualified Sym.Perm as P import Data.Vector (Vector, (!)) @@ -79,13 +78,12 @@ instance Functor Permgram where fmap f w = w { label = V.map f (label w) } -instance Monad Permgram where - return x = permgram (P.fromList [0]) [x] - w >>= f = joinPermgram $ fmap f w - instance Applicative Permgram where - pure = return + pure x = permgram (P.fromList [0]) [x] (<*>) = ap + +instance Monad Permgram where + w >>= f = joinPermgram $ fmap f w joinPermgram :: Permgram (Permgram a) -> Permgram a joinPermgram w@(PGram u f) = PGram (P.fromList xs) (V.fromListN m ys) diff --git a/sym.cabal b/sym.cabal --- a/sym.cabal +++ b/sym.cabal @@ -1,5 +1,5 @@ name: sym -version: 0.13.0 +version: 0.14.0 synopsis: Permutations, patterns, and statistics description: Definitions for permutations with an emphasis on permutation @@ -12,13 +12,15 @@ maintainer: anders.claesson@gmail.com category: Math build-type: Simple -cabal-version: >=1.8 +cabal-version: >=1.9 source-repository head type: git location: git://github.com/akc/sym.git library + default-language: Haskell2010 + exposed-modules: Sym Sym.Perm Sym.Perm.Meta @@ -29,7 +31,7 @@ Sym.Perm.Group Sym.Perm.Bijection Sym.Perm.Stat - Sym.Perm.STAT + Sym.Perm.ListStat Sym.Perm.Sort Sym.Perm.Simple Sym.Perm.Pattern @@ -42,9 +44,9 @@ Sym.Internal.Util build-depends: base >=4.7 && <= 5, - vector >=0.11, - hashable >=1.1, - containers + vector >=0.11 && <= 1, + hashable >=1.1 && <= 2, + containers >= 0.6 && <= 1 ghc-options: -Wall -O2 cc-options: -Wall @@ -60,6 +62,7 @@ cbits/sortop.c Test-Suite Props + default-language: Haskell2010 type: exitcode-stdio-1.0 Main-is: Properties.hs hs-source-dirs: tests