Operads 0.6 → 0.7
raw patch · 7 files changed
+137/−22 lines, 7 filesdep −QuickCheck
Dependencies removed: QuickCheck
Files
- CHANGELOG +28/−0
- Math/Operad/Map.hs +2/−3
- Math/Operad/MapOperad.hs +13/−2
- Math/Operad/OperadGB.hs +9/−1
- Math/Operad/OrderedTree.hs +59/−9
- OperadTest.hs +18/−1
- Operads.cabal +8/−6
CHANGELOG view
@@ -1,3 +1,31 @@+Changes 0.6 -> 0.7+Sun May 3 22:18:13 CEST 2009 mik@stanford.edu+ * Stopped building test file - bug report from dons++++Changes 0.5 -> 0.6+Thu Apr 30 10:25:29 CEST 2009 mik@stanford.edu+ * ForestLex implemented++Thu Apr 30 09:13:50 CEST 2009 mik@stanford.edu+ * Path sequence comparisons have trees around if they need them.++Thu Apr 30 09:12:30 CEST 2009 mik@stanford.edu+ * Added flag controlling which Map data structure to use.++Thu Apr 30 09:11:16 CEST 2009 mik@stanford.edu+ * Adding and interleaving reductions in the Buchberger algorithm++Wed Apr 29 11:41:03 CEST 2009 mik@stanford.edu+ * Hackage rerelease - forgot to include one vital module.++Wed Apr 29 11:40:48 CEST 2009 mik@stanford.edu+ * Optimized order comparison++Wed Apr 29 11:14:59 CEST 2009 mik@stanford.edu+ * Changelog update+ Changes 0.4 -> 0.5 Wed Apr 29 11:12:12 CEST 2009 mik@stanford.edu * Preparing for v0.5
Math/Operad/Map.hs view
@@ -23,9 +23,8 @@ dot (ST _ _ pdt) = pdt instance (Ord a, Show a, TreeOrdering t) => Ord (StoredTree a t) where- compare (ST pathseq pathperm (OT _ o)) (ST pathseq' pathperm' (OT _ _)) = - comparePathSequence o (pathseq,pathperm) (pathseq', pathperm')--- where _ = ordering :: t+ compare (ST pathseq pathperm (OT t o)) (ST pathseq' pathperm' (OT s _)) = + comparePathSequence o t (pathseq,pathperm) s (pathseq', pathperm') data (Ord a, Show a, TreeOrdering t) => Map a t v = TM (M.Map (StoredTree a t) v) deriving (Show, Read, Eq, Ord)
Math/Operad/MapOperad.hs view
@@ -5,22 +5,33 @@ module Math.Operad.MapOperad where +#ifndef USE_OLDMAP import qualified Math.Operad.Map as Map import Math.Operad.Map (Map)+#else +import qualified Data.Map as Map+import Data.Map (Map)+#endif import Data.Maybe import Math.Operad.OrderedTree import Math.Operad.PPrint +#ifndef USE_OLDMAP+type MonomialMap a t n = Map a t n+#else+type MonomialMap a t n = Map (OrderedTree a t) n+#endif+ -- | The type carrying operadic elements. An element in an operad is an associative array -- with keys being labeled trees and values being their coefficients. -newtype (Ord a, Show a, TreeOrdering t) => OperadElement a n t = OE (Map a t n) deriving (Eq, Ord, Show, Read)+newtype (Ord a, Show a, TreeOrdering t) => OperadElement a n t = OE (MonomialMap a t n) deriving (Eq, Ord, Show, Read) instance (Ord a, Show a, Show n, TreeOrdering t) => PPrint (OperadElement a n t) where pp (OE m) = if str == "" then "0" else str where str = Map.foldWithKey (\k a result -> result ++ "\n+" ++ show a ++ "*" ++ pp k) "" m -- | Extracting the internal structure of the an element of the free operad.-extractMap :: (Ord a, Show a, TreeOrdering t) => OperadElement a n t -> Map a t n+extractMap :: (Ord a, Show a, TreeOrdering t) => OperadElement a n t -> MonomialMap a t n extractMap (OE m) = m -- | Arithmetic in the operad.
Math/Operad/OperadGB.hs view
@@ -452,7 +452,15 @@ -- | Reduces a list of elements with respect to all other elements occurring in that same list. reduceBasis :: (Ord a, Show a, TreeOrdering t, Fractional n) => [OperadElement a n t] -> [OperadElement a n t]-reduceBasis gb = map (\g -> reduceCompletely g (gb \\ [g])) gb+reduceBasis gb = let+ reduceAcc ngb [] = ngb+ reduceAcc ngb (g:gs) = let+ ng = reduceCompletely g ngb+ ngb' = if isZero ng then ngb else ng:ngb+ in + reduceAcc ngb' gs+ in+ reduceAcc [] (reverse . sortBy (comparing leadingMonomial) $ gb) -- ** Low degree bases
Math/Operad/OrderedTree.hs view
@@ -96,8 +96,9 @@ -- | The type class that parametrizes types implementing tree orderings. class (Eq t, Show t) => TreeOrdering t where treeCompare :: (Ord a, Show a) => t -> DecoratedTree a -> DecoratedTree a -> Ordering- treeCompare o t1 t2 = comparePathSequence o (orderedPathSequence t1) (orderedPathSequence t2)- comparePathSequence :: (Ord a, Show a) => t -> ([[a]],Shuffle) -> ([[a]],Shuffle) -> Ordering+ treeCompare o t1 t2 = comparePathSequence o t1 (orderedPathSequence t1) t2 (orderedPathSequence t2)+ comparePathSequence :: (Ord a, Show a) => + t -> DecoratedTree a -> ([[a]],Shuffle) -> DecoratedTree a -> ([[a]],Shuffle) -> Ordering ordering :: t -- | Finding the path sequences. cf. Dotsenko-Khoroshkin.@@ -125,8 +126,8 @@ instance TreeOrdering RPathLex where treeCompare o s t = if (nLeaves s) /= (nLeaves t) then comparing nLeaves s t else if s == t then EQ - else comparePathSequence o (orderedPathSequence s) (orderedPathSequence t)- comparePathSequence _ (paths,perms) (patht,permt) = let+ else comparePathSequence o s (orderedPathSequence s) t (orderedPathSequence t)+ comparePathSequence _ _ (paths,perms) _ (patht,permt) = let clS = zipWith (comparing length) paths patht coS = zipWith compare paths patht cS = zipWith (\comp1 comp2 -> if comp1 == EQ then comp2 else reverseOrder comp1) clS coS@@ -142,8 +143,8 @@ instance TreeOrdering PathLex where treeCompare o s t = if (nLeaves s) /= (nLeaves t) then comparing nLeaves s t else if s == t then EQ - else comparePathSequence o (orderedPathSequence s) (orderedPathSequence t)- comparePathSequence _ (paths,perms) (patht,permt) = let+ else comparePathSequence o s (orderedPathSequence s) t (orderedPathSequence t)+ comparePathSequence _ _ (paths,perms) _ (patht,permt) = let clS = zipWith (comparing length) paths patht coS = zipWith compare paths patht cs = zipWith (\comp1 comp2 -> if comp1 == EQ then comp2 else comp1) clS coS@@ -152,14 +153,63 @@ else compare perms permt ordering = PathLex +data PathRLex = PathRLex deriving (Eq, Ord, Show, Read)+instance TreeOrdering PathRLex where+ treeCompare o s t = if (nLeaves s) /= (nLeaves t) then comparing nLeaves s t+ else if s == t then EQ + else comparePathSequence o s (orderedPathSequence s) t (orderedPathSequence t)+ comparePathSequence _ _ (paths,perms) _ (patht,permt) = let+ clS = zipWith (comparing length) paths patht+ coS = zipWith compare paths patht+ cs = zipWith (\comp1 comp2 -> if comp1 == EQ then comp2 else comp1) clS coS+ in+ if any (/= EQ) cs then head (filter (/=EQ) cs)+ else reverseOrder $ compare perms permt+ ordering = PathRLex++data RPathRLex = RPathRLex deriving (Eq, Ord, Show, Read)+instance TreeOrdering RPathRLex where+ treeCompare o s t = if (nLeaves s) /= (nLeaves t) then comparing nLeaves s t+ else if s == t then EQ + else comparePathSequence o s (orderedPathSequence s) t (orderedPathSequence t)+ comparePathSequence _ _ (paths,perms) _ (patht,permt) = let+ clS = zipWith (comparing length) paths patht+ coS = zipWith compare paths patht+ cS = zipWith (\comp1 comp2 -> if comp1 == EQ then comp2 else reverseOrder comp1) clS coS+ in+ if any (/= EQ) cS then head (filter (/=EQ) cS)+ else reverseOrder $ compare perms permt+ ordering = RPathRLex+ -- | Forest lexicographic ordering. Currently not implemented. data ForestLex = ForestLex deriving (Eq, Ord, Show) - instance TreeOrdering ForestLex where- comparePathSequence = error "Forest lexicographic ordering is not yet implemented."+ treeCompare o s t = comparePathSequence o s (orderedPathSequence s) t (orderedPathSequence t)+ comparePathSequence _ (DTLeaf k) _ (DTLeaf l) _ = compare l k+ comparePathSequence _ (DTLeaf _) _ _ _ = LT+ comparePathSequence _ _ _ (DTLeaf _) _ = GT+ comparePathSequence o s (paths, perms) t (patht, permt) = let+ c1 = compare (vertexArity s) (vertexArity t)+ c2 = compare (vertexType s) (vertexType t)+ ls = map (sort . leafOrder) (sortBy (comparing minimalLeaf) (subTrees s))+ lt = map (sort . leafOrder) (sortBy (comparing minimalLeaf) (subTrees t))+ c3s = zipWith (\sl tl -> case comparing length sl tl of + LT -> LT+ GT -> GT+ EQ -> reverseOrder $ compare sl tl) ls lt+ c3f = filter (/= EQ) c3s+ c4f = filter (/= EQ) $ zipWith + (treeCompare o) + (sortBy (comparing minimalLeaf) (subTrees s))+ (sortBy (comparing minimalLeaf) (subTrees t)) + in+ if c1 /= EQ then c1 + else if c2 /= EQ then c2 + else if not (null c3f) then head c3f + else if null c4f then EQ + else head c4f ordering = ForestLex- -- ** Utility functions on trees --
OperadTest.hs view
@@ -70,7 +70,23 @@ (sort acGB) == (sort . read $ "[OE (TM (fromList [(ST [[2],[2,2],[2,2]] [1,2,3] (OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTLeaf 3]}]}) PathLex),1 % 1),(ST [[2,2],[2,2],[2]] [1,2,3] (OT (DTVertex {vertexType = 2, subTrees = [DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTLeaf 2]},DTLeaf 3]}) PathLex),1 % 1)])),OE (TM (fromList [(ST [[2],[2,2],[2,2]] [1,2,3] (OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTLeaf 3]}]}) PathLex),(-1) % 1),(ST [[2,2],[2],[2,2]] [1,3,2] (OT (DTVertex {vertexType = 2, subTrees = [DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTLeaf 3]},DTLeaf 2]}) PathLex),1 % 1)])),OE (TM (fromList [(ST [[2],[2,2],[2,2,2],[2,2,2]] [1,2,3,4] (OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTVertex {vertexType = 2, subTrees = [DTLeaf 3,DTLeaf 4]}]}]}) PathLex),1 % 1)]))]") +prop_noncom = let+ x = corolla 1 [1]+ y = corolla 2 [1]+ x2y = nsCompose 1 x (nsCompose 1 x y)+ xy2 = nsCompose 1 x (nsCompose 1 y y)+ xy = nsCompose 1 x y+ yx = nsCompose 1 y x+ one = head $ subTrees x+ ox2y = oet x2y :: OperadElement Integer Rational PathLex+ oxy2 = oet xy2 :: OperadElement Integer Rational PathLex+ oxy = oet xy :: OperadElement Integer Rational PathLex+ oyx = oet yx :: OperadElement Integer Rational PathLex+ oone = oet one :: OperadElement Integer Rational PathLex+ gb = [ox2y-oone, oxy2-oone, oxy-oyx]+ in (sort . operadicBuchberger $ gb) == (sort . read $ "[OE (TM (fromList [(ST [[]] [1] (OT (DTLeaf 1) PathLex),(-1) % 1),(ST [[1,1,1]] [1] (OT (DTVertex {vertexType = 1, subTrees = [DTVertex {vertexType = 1, subTrees = [DTVertex {vertexType = 1, subTrees = [DTLeaf 1]}]}]}) PathLex),1 % 1)])),OE (TM (fromList [(ST [[1]] [1] (OT (DTVertex {vertexType = 1, subTrees = [DTLeaf 1]}) PathLex),(-1) % 1),(ST [[2]] [1] (OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1]}) PathLex),1 % 1)])),OE (TM (fromList [(ST [[1,2]] [1] (OT (DTVertex {vertexType = 1, subTrees = [DTVertex {vertexType = 2, subTrees = [DTLeaf 1]}]}) PathLex),1 % 1),(ST [[2,1]] [1] (OT (DTVertex {vertexType = 2, subTrees = [DTVertex {vertexType = 1, subTrees = [DTLeaf 1]}]}) PathLex),(-1) % 1)]))]" :: [OperadElement Integer Rational PathLex]) + prop_preliekoszul = let a = corolla 2 [1,2] b = corolla 1 [1,2]@@ -139,5 +155,6 @@ -} ("Anticommutative has 3 element basis",test prop_anticom), -- ("Pre-Lie with the wrong order",test prop_prelie),- ("Pre-Lie is Koszul",test prop_preliekoszul)+ ("Pre-Lie is Koszul",test prop_preliekoszul),+ ("Sample non-commutative algebra grobner basis",test prop_noncom) ]
Operads.cabal view
@@ -1,5 +1,5 @@ Name: Operads-Version: 0.6+Version: 0.7 Stability: alpha License: BSD3 License-file: LICENSE@@ -12,7 +12,7 @@ Package-URL: http://hackage.haskell.org/packages/archive/Operads/0.4/Operads-0.4.tar.gz Build-Type: Simple Cabal-Version: >=1.2-Extra-source-files: README CHANGELOG examples/preLieBad.hs examples/example.hs examples/altDual.hs+Extra-source-files: README CHANGELOG examples/preLieBad.hs examples/example.hs examples/altDual.hs OperadTest.hs Synopsis: Groebner basis computation for Operads. Description: This is an implementation of the operadic Buchberger algorithm from Vladimir Dotsenko & @@ -148,12 +148,12 @@ Description: Use the head bag based storage for formal linear combinations. Default: False -Executable OperadTest- Main-is: OperadTest.hs- Extensions: CPP- Build-Depends: QuickCheck+Flag UseOldMap+ Description: Don't use the Data.Map wrapper class Math.Operad.Map. This will slow down computation.+ Default: False + Library Build-Depends: base, array, mtl, containers Exposed-Modules: Math.Operad@@ -165,3 +165,5 @@ CPP-Options: -DUSE_MAPOPERAD if flag(polybag) CPP-Options: -DUSE_POLYBAG+ if flag(useoldmap)+ CPP-Options: -DUSE_OLDMAP