orders (empty) → 0.1.0.0

raw patch · 5 files changed

+219/−0 lines, 5 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• Data/Lattice.hs +74/−0
• Data/PartialOrder.hs +92/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• orders.cabal +21/−0

@@ -0,0 +1,74 @@+module Data.Lattice where++import Data.Function+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Map (Map)+import qualified Data.Map as Map+import Data.PartialOrder++class Lattice a where+  lbot :: a+  ltop :: a+  ljoin :: a -> a -> a+  lmeet :: a -> a -> a++instance Lattice () where+  lbot = ()+  ltop = ()+  ljoin _ _ = ()+  lmeet _ _ = ()++instance (Lattice a, Lattice b) => Lattice (Either a b) where+  lbot = Left lbot+  ltop = Right ltop+  ljoin (Left a) (Left b) = Left $ ljoin a b+  ljoin (Left _) x@(Right _) = x+  ljoin x@(Right _) (Left _) = x+  ljoin (Right a) (Right b) = Right $ ljoin a b+  lmeet (Left a) (Left b) = Left $ lmeet a b+  lmeet x@(Left _) (Right _) = x+  lmeet (Right _) x@(Left _) = x+  lmeet (Right a) (Right b) = Right $ lmeet a b++instance (Lattice a, Lattice b) => Lattice (a,b) where+  lbot = (lbot,lbot)+  ltop = (ltop,ltop)+  ljoin (a1,b1) (a2,b2) = (ljoin a1 a2,ljoin b1 b2)+  lmeet (a1,b1) (a2,b2) = (lmeet a1 a2,lmeet b1 b2)++instance +  (Lattice a, Lattice b, Lattice c) +  => Lattice (a, b, c) +  where+    lbot = ungroup3 lbot+    ltop = ungroup3 ltop+    ljoin = ungroup3 .: ljoin `on` group3+    lmeet = ungroup3 .: lmeet `on` group3++instance+  (Lattice a, Lattice b, Lattice c, Lattice d)+  => Lattice (a, b, c, d)+  where+    lbot = ungroup4 lbot+    ltop = ungroup4 ltop+    ljoin = ungroup4 .: ljoin `on` group4+    lmeet = ungroup4 .: lmeet `on` group4++instance (Ord a) => Lattice (Set a) where+  lbot = Set.empty+  ltop = error "no representation of top set"+  ljoin = Set.union+  lmeet = Set.intersection++instance (Ord k, Lattice v) => Lattice (Map k v) where+  lbot = Map.empty+  ltop = error "no representation of top map"+  ljoin = Map.unionWith ljoin+  lmeet = Map.intersectionWith lmeet++lmeets :: (Lattice l) => [l] -> l+lmeets = foldr lmeet ltop++ljoins :: (Lattice l) => [l] -> l+ljoins = foldr ljoin lbot

@@ -0,0 +1,92 @@+module Data.PartialOrder where++import Data.Function+import Data.Map (Map)+import Data.Maybe+import Data.Set (Set)+import qualified Data.Map as Map+import qualified Data.Set as Set++-- minimal completion is pcompare or lte+class PartialOrder t where+  pcompare :: t -> t -> Maybe Ordering+  pcompare x y = case (lte x y, lte y x) of+    (True, True) -> Just EQ+    (True, False) -> Just LT+    (False, True) -> Just GT+    (False, False) -> Nothing+  comparable :: t -> t -> Bool+  comparable x y = isJust $ pcompare x y+  lte :: t -> t -> Bool+  lte x y =+    let c = pcompare x y +    in c == Just LT || c == Just EQ+  gte :: t -> t -> Bool+  gte x y =+    let c = pcompare x y+    in c == Just GT || c == Just EQ+  lt :: t -> t -> Bool+  lt x y = pcompare x y == Just LT+  gt :: t -> t -> Bool+  gt x y = pcompare x y == Just GT+  eq :: t -> t -> Bool+  eq x y = pcompare x y == Just EQ++instance PartialOrder () where +  pcompare _ _ = Just EQ++instance PartialOrder Bool where+  pcompare x y = Just $ compare x y++instance PartialOrder Int where+  pcompare x y = Just $ compare x y++instance PartialOrder Integer where+  pcompare x y = Just $ compare x y++instance (PartialOrder a, PartialOrder b) => PartialOrder (a, b) where+  pcompare (a1,b1) (a2,b2) =+    case pcompare a1 a2 of+      Just LT -> Just LT+      Just EQ -> pcompare b1 b2+      Just GT -> Just GT+      Nothing -> Nothing++group3 :: (a,b,c) -> ((a,b),c)+group3 (a,b,c) = ((a,b),c)++ungroup3 :: ((a,b),c) -> (a,b,c)+ungroup3 ((a,b),c) = (a,b,c)++group4 :: (a,b,c,d) -> ((a,b),c,d)+group4 (a,b,c,d) = ((a,b),c,d)++ungroup4 :: ((a,b),c,d) -> (a,b,c,d)+ungroup4 ((a,b),c,d) = (a,b,c,d)++(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(.:) = (.) . (.)++instance +  (PartialOrder a, PartialOrder b, PartialOrder c) +  => PartialOrder (a, b, c) +  where+    pcompare = pcompare `on` group3++instance+  (PartialOrder a, PartialOrder b, PartialOrder c, PartialOrder d)+  => PartialOrder (a, b, c, d)+  where+    pcompare = pcompare `on` group4++instance (PartialOrder a, PartialOrder b) => PartialOrder (Either a b) where+  pcompare (Left a1) (Left a2) = pcompare a1 a2+  pcompare (Left _) (Right _) = Just LT+  pcompare (Right _) (Left _) = Just GT+  pcompare (Right b1) (Right b2) = pcompare b1 b2++instance (Ord a) => PartialOrder (Set a) where+  lte = Set.isSubsetOf++instance (Ord k, PartialOrder v) => PartialOrder (Map k v) where+  lte = Map.isSubmapOfBy lte

@@ -0,0 +1,30 @@+Copyright (c) 2013, David Darais++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of David Darais nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,21 @@+-- Initial orders.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                orders+version:             0.1.0.0+synopsis:            basic orders+description:         support for partial orders and other stuffs+license:             BSD3+license-file:        LICENSE+author:              David Darais+maintainer:          david.darais@gmail.com+-- copyright:           +category:            Data+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     Data.Lattice, Data.PartialOrder+  -- other-modules:       +  build-depends:       base == 4.6.*+                     , containers == 0.5.*