Operads 0.4 → 0.5
raw patch · 6 files changed
+58/−16 lines, 6 files
Files
- CHANGELOG +26/−0
- Math/Operad/MapOperad.hs +5/−6
- Math/Operad/OperadGB.hs +24/−7
- OperadTest.hs +1/−1
- Operads.cabal +1/−1
- examples/altDual.hs +1/−1
CHANGELOG view
@@ -1,3 +1,29 @@+Changes 0.4 -> 0.5+Wed Apr 29 11:12:12 CEST 2009 mik@stanford.edu+ * Preparing for v0.5++Wed Apr 29 11:11:53 CEST 2009 mik@stanford.edu+ * Reducing Groebner bases inline++Wed Apr 29 11:11:29 CEST 2009 mik@stanford.edu+ * Maximum degree could be run on empty lists++Wed Apr 29 10:34:31 CEST 2009 mik@stanford.edu+ * Flag choosable tracing.++Wed Apr 29 10:32:53 CEST 2009 mik@stanford.edu+ * Tweaking the map storage type to cache comparisons.++ Note that this change induces incompatibility in the induced Show instances.+ Hence, operad elements that were saved from 0.4 will not be easy to restore+ to 0.5. ++++Changes 0.3 -> 0.4+Tue Apr 28 23:13:15 CEST 2009 mik@stanford.edu+ * Changelog update.+ Tue Apr 28 23:12:25 CEST 2009 mik@stanford.edu * Automated testing with Cabal.
Math/Operad/MapOperad.hs view
@@ -5,23 +5,22 @@ module Math.Operad.MapOperad where -import qualified Data.Map as Map-import Data.Map (Map)+import qualified Math.Operad.Map as Map+import Math.Operad.Map (Map) import Data.Maybe-import Control.Arrow import Math.Operad.OrderedTree import Math.Operad.PPrint -- | 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 (OrderedTree a t) n) deriving (Eq, Ord, Show, Read)+newtype (Ord a, Show a, TreeOrdering t) => OperadElement a n t = OE (Map 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 (OrderedTree a t) n+extractMap :: (Ord a, Show a, TreeOrdering t) => OperadElement a n t -> Map a t n extractMap (OE m) = m -- | Arithmetic in the operad.@@ -40,7 +39,7 @@ -- | Apply a function to each monomial tree in the operad element. mapMonomials :: (Show a, Ord a, Show b, Ord b, Num n, TreeOrdering s, TreeOrdering t) => (OrderedTree a s -> OrderedTree b t) -> OperadElement a n s -> OperadElement b n t-mapMonomials f (OE m) = OE $ Map.fromListWith (+) $ map (first f) (Map.toList m)+mapMonomials f (OE m) = OE $ Map.mapKeysWith (+) f m -- | Fold a function over all monomial trees in an operad element, collating the results in a list. foldMonomials :: (Show a, Ord a, Num n, TreeOrdering t) =>
Math/Operad/OperadGB.hs view
@@ -23,7 +23,10 @@ import Math.Operad.OrderedTree ---import Debug.Trace+#ifdef TRACE+import Debug.Trace+import Math.Operad.PPrint+#endif -- * Fundamental data types and instances @@ -38,7 +41,7 @@ -- | The maximal operation degree of an operadic element maxOperationDegree :: (Ord a, Show a, TreeOrdering t, Num n) => OperadElement a n t -> Int-maxOperationDegree = maximum . operationDegrees+maxOperationDegree element = if null op then 0 else maximum op where op = operationDegrees element -- | Check that an element of a free operad is homogenous isHomogenous :: (Ord a, Show a, TreeOrdering t, Num n) => OperadElement a n t -> Bool@@ -368,6 +371,9 @@ lmg2 = leadingMonomial g2 cf12 = (leadingCoefficient g1) / (leadingCoefficient g2) gamma <- nub $ findAllBoundedLCM n lmg1 lmg2+#ifdef TRACE+ trace ("Found LCM: \n\t" ++ pp lmg1 ++ ", \n\t" ++ pp lmg2 ++ ": \n\t" ++ pp gamma ++ "\n") (return ())+#endif mg1 <- findAllEmbeddings lmg1 gamma mg2 <- findAllEmbeddings lmg2 gamma return $ (applyReconstruction mg1 g1) - (cf12 .*. (applyReconstruction mg2 g2))@@ -408,10 +414,17 @@ -- Return anything that survived the reduction. Keep the occurring operation degrees bounded. stepInitialOperadicBuchberger :: (Ord a, Show a, TreeOrdering t, Fractional n) => Int -> [OperadElement a n t] -> [OperadElement a n t] -> [OperadElement a n t]-stepInitialOperadicBuchberger maxD oldGb newGb = nub $ do+stepInitialOperadicBuchberger maxD oldGb newGb =+ nub $ + filter (not . isZero) $ + do spol <- findInitialSPolynomials maxD oldGb newGb guard $ maxOperationDegree spol <= maxD- let red = reduceCompletely spol (oldGb ++ newGb)+ let red = +#ifdef TRACE+ trace ("Reducing S-polynomial: " ++ pp spol ++ "\n") $+#endif+ reduceCompletely spol (oldGb ++ newGb) guard $ not . isZero $ red return red @@ -433,9 +446,13 @@ operadicBuchbergerAcc oldgb [] = oldgb operadicBuchbergerAcc oldgb new = if minimum (map maxOperationDegree new) > maxOD then oldgb else let- gbn = stepInitialOperadicBuchberger maxOD oldgb new- gbo = nub $ oldgb ++ new- gbc = gbn \\ gbo+ gbn = +#ifdef TRACE+ trace ("Stepping through\n") $+#endif+ stepInitialOperadicBuchberger maxOD oldgb new+ gbo = reduceBasis $ oldgb ++ new+ gbc = (reduceBasis (gbn ++ gbo)) \\ gbo in operadicBuchbergerAcc gbo gbc in nub $ operadicBuchbergerAcc [] gb
OperadTest.hs view
@@ -67,7 +67,7 @@ ac = [g1,g2] acGB = operadicBuchberger ac in ((3==) . length $ acGB) &&- (sort acGB) == (sort . read $ "[OE (fromList [(OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTLeaf 3]}]}) PathLex,1 % 1),(OT (DTVertex {vertexType = 2, subTrees = [DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTLeaf 2]},DTLeaf 3]}) PathLex,1 % 1)]),OE (fromList [(OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTLeaf 3]}]}) PathLex,(-1) % 1),(OT (DTVertex {vertexType = 2, subTrees = [DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTLeaf 3]},DTLeaf 2]}) PathLex,1 % 1)]),OE (fromList [(OT (DTVertex {vertexType = 2, subTrees = [DTLeaf 1,DTVertex {vertexType = 2, subTrees = [DTLeaf 2,DTVertex {vertexType = 2, subTrees = [DTLeaf 3,DTLeaf 4]}]}]}) PathLex,1 % 1)])]")+ (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)]))]")
Operads.cabal view
@@ -1,5 +1,5 @@ Name: Operads-Version: 0.4+Version: 0.5 Stability: alpha License: BSD3 License-file: LICENSE
examples/altDual.hs view
@@ -32,7 +32,7 @@ second_us = 1000000 main = do threadID <- forkIO func- threadDelay (600*second_us)+ threadDelay (300*second_us) killThread threadID