packages feed

sym 0.1.1 → 0.2

raw patch · 8 files changed

+151/−26 lines, 8 files

Files

Math/Sym.hs view
@@ -37,11 +37,14 @@     , bubbleSort      -- :: Perm a => a -> a      -- * Permutation patterns-    , copies          -- :: Perm a => StPerm -> a -> [Set]-    , avoids          -- :: Perm a => [StPerm] -> a -> Bool+    , copiesOf        -- :: Perm a => StPerm -> a -> [Set]+    , avoids          -- :: Perm a => a -> [StPerm] -> Bool     , avoiders        -- :: Perm a => [StPerm] -> [a] -> [a]     , av              -- :: [StPerm] -> Int -> [StPerm] +    -- * Simple permutations+    , simple          -- :: Perm a => a -> Bool+     -- * Subsets     , Set     , subsets         -- :: Int -> Int -> [Set]@@ -63,8 +66,13 @@  -- | By a /standard permutation/ we shall mean a permutations of -- @[0..k-1]@.-newtype StPerm = StPerm { perm0 :: I.Perm0 } deriving (Eq, Ord)+newtype StPerm = StPerm { perm0 :: I.Perm0 } deriving Eq +instance Ord StPerm where+    compare u v = case comparing size u v of+                    EQ -> compare (perm0 u) (perm0 v)+                    x  -> x+ instance Show StPerm where     show = show . toVector @@ -267,22 +275,22 @@ -- Permutation patterns -- -------------------- --- | @copies p w@ is the list of (indices of) copies of the pattern+-- | @copiesOf p w@ is the list of (indices of) copies of the pattern -- @p@ in the permutation @w@. E.g., -- --- > copies (st "21") "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]]+-- > copiesOf (st "21") "2431" == [fromList [1,2],fromList [0,3],fromList [1,3],fromList [2,3]] -- -copies :: Perm a => StPerm -> a -> [Set]-copies p w = I.copies subsets (toVector p) (toVector $ st w)+copiesOf :: Perm a => StPerm -> a -> [Set]+copiesOf p w = I.copies subsets (toVector p) (toVector $ st w) --- | @avoids ps w@ is a predicate determining if @w@ avoids the patterns @ps@.-avoids :: Perm a => [StPerm] -> a -> Bool-avoids ps w = all null [ copies p w | p <- ps ]+-- | @avoids w ps@ is a predicate determining if @w@ avoids the patterns @ps@.+avoids :: Perm a => a -> [StPerm] -> Bool+w `avoids` ps = all null [ copiesOf p w | p <- ps ]  -- | @avoiders ps v@ is the list of permutations of @v@ avoiding the -- patterns @ps@. This is equivalent to the definition -- --- > avoiders ps = filter (avoids ps)+-- > avoiders ps = filter (`avoids` ps) --  -- but is usually much faster. avoiders :: Perm a => [StPerm] -> [a] -> [a]@@ -295,6 +303,14 @@ --  av :: [StPerm] -> Int -> [StPerm] av ps = avoiders ps . sym+++-- Simple permutations+-- -------------------++-- | A predicate determining if a given permutation is simple.+simple :: Perm a => a -> Bool+simple = I.simple . toVector . st   -- Subsets
Math/Sym/Internal.hs view
@@ -43,6 +43,7 @@     , sti     , st     , ordiso+    , simple     , copies     , avoiders @@ -75,6 +76,7 @@     , rdr     -- right-most decreasing run     , comp    -- components     , ep      -- rank a la Elizalde & Pak+    , dim     -- dimension      -- * Sorting operators     , stackSort@@ -226,6 +228,17 @@         SV.unsafeWith m $ \m' ->         return . toBool $ c_ordiso (castPtr u') (castPtr v') (castPtr m') k +foreign import ccall unsafe "simple.h simple" c_simple+    :: Ptr CLong -> CLong -> CInt++-- | @simple w@ determines whether @w@ is simple+simple :: Perm0 -> Bool+simple w =+    let n = fromIntegral (SV.length w)+    in  unsafePerformIO $+        SV.unsafeWith w $ \w' ->+        return . toBool $ c_simple (castPtr w') n+ -- | @copies subsets p w@ is the list of bitmasks that represent copies of @p@ in @w@. copies :: (Int -> Int -> [SV.Vector Int]) -> Perm0 -> Perm0 -> [SV.Vector Int] copies subsets p w = filter (ordiso p w) $ subsets n k@@ -334,6 +347,9 @@ foreign import ccall unsafe "stat.h ep" c_ep     :: Ptr CLong -> CLong -> CLong +foreign import ccall unsafe "stat.h dim" c_dim+    :: Ptr CLong -> CLong -> CLong+ -- Marshal a permutation statistic defined in C to on in Haskell. stat :: (Ptr CLong -> CLong -> CLong) -> Perm0 -> Int stat f w = unsafePerformIO $@@ -427,6 +443,10 @@ -- | Rank as defined by Elizalde & Pak. ep :: Perm0 -> Int ep = stat c_ep++-- | Dimension (largest non-fixed-point).+dim :: Perm0 -> Int+dim = stat c_dim   -- Sorting operators
Math/Sym/Stat.hs view
@@ -41,6 +41,7 @@     , rdr     -- right-most decreasing run     , comp    -- components     , ep      -- rank a la Elizalde & Pak+    , dim     -- dimension     ) where  import Prelude hiding (head, last)@@ -48,7 +49,7 @@ import Math.Sym.Internal (Perm0) import qualified Math.Sym.Internal as I      ( asc, des, exc, fp, inv, maj, peak, vall, dasc, ddes, lmin, lmax, rmin, rmax-    , head, last, lir, ldr, rir, rdr, comp, ep+    , head, last, lir, ldr, rir, rdr, comp, ep, dim     )  generalize :: Perm a => (Perm0 -> Int) -> a -> Int@@ -152,3 +153,8 @@ --  ep :: Perm a => a -> Int ep = generalize I.ep++-- | The dimension of a permutation is defined as the largest+-- non-fixed-point, or zero if all points are fixed.+dim :: Perm a => a -> Int+dim = generalize I.dim
+ cbits/simple.c view
@@ -0,0 +1,36 @@+#include <stdlib.h>+#include <string.h>++#define MIN(a,b) (((a)<(b))?(a):(b))+#define MAX(a,b) (((a)>(b))?(a):(b))++/*+ * Determines whether a permutation is simple.+ * Based on Michael Albert's java implementation in PermLab.+ */+int+simple(const long *w, long len)+{+	register int i, j;+	int size  = len * sizeof(*w);+	long *mins = malloc(size);+	long *maxs = malloc(size);+	+	memcpy(mins, w, size);+	memcpy(maxs, w, size);+	+	for (i = 1; i < len-1; i++) {+		for (j = len-1; j >= i; j--) {+			mins[j] = MIN(mins[j-1], w[j]);+			maxs[j] = MAX(maxs[j-1], w[j]);+			if (maxs[j] - mins[j] == i) {+				free(mins);+				free(maxs);+				return 0;+			}+		}+	}+	free(mins);+	free(maxs);+	return 1;+}
cbits/stat.c view
@@ -242,3 +242,16 @@ 	} 	return len; }++/* The dimension is the largest i such that w[i] != i */+long+dim(const long *w, long len)+{+	long i, j = 0;++	for (i = 0; i < len; i++, w++) {+		if (*w != i)+			j = i;+	}+	return j;+}
+ include/simple.h view
@@ -0,0 +1,1 @@+int simple(const long *, long);
sym.cabal view
@@ -1,5 +1,5 @@ Name:                sym-Version:             0.1.1+Version:             0.2 Synopsis:            Permutations, patterns, and statistics Description:            Definitions for permutations with an emphasis on permutation@@ -44,7 +44,12 @@   ghc-options:         -Wall -O2   cc-options:          -Wall -  c-sources:           cbits/stat.c, cbits/sortop.c, cbits/ordiso.c, cbits/bit.c+  c-sources:           cbits/stat.c+                       cbits/sortop.c+                       cbits/ordiso.c+                       cbits/simple.c+                       cbits/bit.c+   include-dirs:        include-  includes:            stat.h, sortop.h, ordiso.h, bit.h-  install-includes:    stat.h, sortop.h, ordiso.h, bit.h+  includes:            stat.h, sortop.h, ordiso.h, simple.h, bit.h+  install-includes:    stat.h, sortop.h, ordiso.h, simple.h, bit.h
tests/Properties.hs view
@@ -153,6 +153,28 @@ prop_ordiso2 =     forAll perm2 $ \(u,v) -> u `Sym.ordiso` v  ==  (Sym.inverse u `Sym.act` v == Sym.idperm v) +segments :: [a] -> [[a]]+segments [] = [[]]+segments (x:xs) = segments xs ++ map (x:) (inits xs)++nonEmptySegments :: [a] -> [[a]]+nonEmptySegments = drop 1 . segments++properSegments :: [a] -> [[a]]+properSegments xs = [ ys | ys@(_:_:_) <- init $ segments xs ]++properIntervals :: Ord a => [a] -> [[a]]+properIntervals xs = [ ys | ys <- yss, sort ys `elem` zss ]+    where+      yss = properSegments xs+      zss = properSegments $ sort xs++simple :: Ord a => [a] -> Bool+simple = null . properIntervals++prop_simple =+    forAll (resize 50 perm) $ \w -> Sym.simple w == simple w+ prop_unrankPerm =     forAll perm $ \w ->     forAll (choose (0, product [1..fromIntegral (length w) - 1])) $ \r ->@@ -161,35 +183,37 @@ prop_stackSort = forAll perm $ \v -> Sym.stackSort v == stack v  prop_stackSort_231 =-    forAll perm $ \v -> (Sym.stackSort v == Sym.idperm v) == (Sym.avoids [Sym.st "231"] v)+    forAll perm $ \v ->+        (Sym.stackSort v == Sym.idperm v) == (v `Sym.avoids` [Sym.st "231"])  prop_bubbleSort = forAll perm $ \v -> Sym.bubbleSort v == bubble v  prop_bubbleSort_231_321 =-    forAll perm $ \v -> (Sym.bubbleSort v == Sym.idperm v) == (Sym.avoids [Sym.st "231", Sym.st "321"] v)+    forAll perm $ \v ->+        (Sym.bubbleSort v == Sym.idperm v) == (v `Sym.avoids` [Sym.st "231", Sym.st "321"])  prop_subperm_copies p =-    forAll (resize 21 perm) $ \w -> and [ subperm m (Sym.st w) == p | m <- Sym.copies p w ]+    forAll (resize 21 perm) $ \w -> and [ subperm m (Sym.st w) == p | m <- Sym.copiesOf p w ]  prop_copies =     forAll (resize  6 arbitrary) $ \p ->     forAll (resize 12 perm)      $ \w ->-        sort (Sym.copies p w) == sort (map I.fromList $ copies (Sym.toList p) w)+        sort (Sym.copiesOf p w) == sort (map I.fromList $ copies (Sym.toList p) w)  prop_copies_self =-    forAll perm $ \v -> Sym.copies (Sym.st v) v == [SV.fromList [0 .. length v - 1]]+    forAll perm $ \v -> Sym.copiesOf (Sym.st v) v == [SV.fromList [0 .. length v - 1]]  prop_copies_d8 (Symmetry (f,_)) =     forAll (resize  6 arbitrary) $ \p ->     forAll (resize 20 perm)      $ \w ->         let p' = f p             w' = Sym.generalize f w-        in length (Sym.copies p w) == length (Sym.copies p' w')+        in length (Sym.copiesOf p w) == length (Sym.copiesOf p' w')  prop_avoiders_avoid =     forAll (resize 20 arbitrary) $ \ws ->     forAll (resize  6 arbitrary) $ \ps ->-        all (Sym.avoids ps) $ Sym.avoiders ps (ws :: [Sym.StPerm])+        all (`Sym.avoids` ps) $ Sym.avoiders ps (ws :: [Sym.StPerm])  prop_avoiders_idempotent =     forAll (resize 18 arbitrary) $ \vs ->@@ -284,6 +308,7 @@     , ("inverse",                        check prop_inverse)     , ("ordiso/1",                       check prop_ordiso1)     , ("ordiso/2",                       check prop_ordiso2)+    , ("simple",                         check prop_simple)     , ("unrankPerm",                     check prop_unrankPerm)     , ("stackSort",                      check prop_stackSort)     , ("stackSort/231",                  check prop_stackSort_231)@@ -433,8 +458,9 @@ ep = fst . last . filter (\(k,ys) -> all (k<=) ys) . zip [0..] . inits . st  des, asc, inv, lmin, lmax, rmin, rmax, peak, vall :: [Int] -> Int-dasc, ddes, maj, comp, ep :: [Int] -> Int+dasc, ddes, maj, comp, ep, dim :: [Int] -> Int +dim w = maximum $ 0 : [ i | (i,x) <- zip [0..] (st w), i /= x ] maj w = sum [ i | (i,x,y) <- zip3 [1..] w (tail w), x > y ] des  = length . descents asc  = length . ascents@@ -464,14 +490,15 @@ prop_vall = forAll perm $ \w -> vall w == S.vall w prop_dasc = forAll perm $ \w -> dasc w == S.dasc w prop_ddes = forAll perm $ \w -> ddes w == S.ddes w-prop_ep   = forAll perm $ \w -> ep  w == S.ep  w+prop_ep   = forAll perm $ \w -> ep   w == S.ep  w prop_lir  = forAll perm $ \w -> lir  w == S.lir  w prop_ldr  = forAll perm $ \w -> ldr  w == S.ldr  w prop_rir  = forAll perm $ \w -> rir  w == S.rir  w prop_rdr  = forAll perm $ \w -> rdr  w == S.rdr  w prop_comp = forAll perm $ \w -> comp w == S.comp w+prop_dim  = forAll perm $ \w -> dim  w == S.dim  w -prop_inv_21 = forAll perm $ \w -> S.inv w == length (Sym.copies (Sym.st "21") w)+prop_inv_21 = forAll perm $ \w -> S.inv w == length (Sym.copiesOf (Sym.st "21") w)  testsStat =     [ ("asc",    check prop_asc)@@ -496,6 +523,7 @@     , ("rir",    check prop_rir)     , ("rdr",    check prop_rdr)     , ("comp",   check prop_comp)+    , ("dim",    check prop_dim)     , ("inv/21", check prop_inv_21)     ]