partialord (empty) → 0.0.0

raw patch · 8 files changed

+413/−0 lines, 8 filesdep +basedep +containersdep +hspecsetup-changed

Dependencies added: base, containers, hspec, partialord

Files

CHANGELOG.md +11/−0
LICENSE +30/−0
README.md +14/−0
Setup.hs +2/−0
partialord.cabal +59/−0
src/Data/PartialOrd.hs +277/−0
test/Data/PartialOrdSpec.hs +19/−0
test/Spec.hs +1/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Changelog for `partialord`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2023++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 Author name here 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.

+ README.md view

@@ -0,0 +1,14 @@+# partialord++A data structure supporting partial orders, and some helpful+associated routines.++## Other packages++An alternative package is already available, namely+  [partial-order](https://hackage.haskell.org/package/partial-order-0.2.0.0/docs/Data-PartialOrd.html).+Differences include:+* PartialOrd has a comparison valued in Maybe Ordering; we use a fresh+  type.+* Where types have several natural partial orderings, we provide+  newtypes rather than choosing one.

+ Setup.hs view

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

+ partialord.cabal view

@@ -0,0 +1,59 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           partialord+version:        0.0.0+synopsis:       Data structure supporting partial orders+description:    Please see README.md+category:       Data structures+homepage:       https://github.com/jcranch/partialord#readme+bug-reports:    https://github.com/jcranch/partialord/issues+author:         James Cranch+maintainer:     j.d.cranch@sheffield.ac.uk+copyright:      2023 James Cranch+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/jcranch/partialord++library+  exposed-modules:+      Data.PartialOrd+  other-modules:+      Paths_partialord+  autogen-modules:+      Paths_partialord+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , containers ==0.6.*+  default-language: Haskell2010++test-suite partialord-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.PartialOrdSpec+      Paths_partialord+  autogen-modules:+      Paths_partialord+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers ==0.6.*+    , hspec >=2.7 && <2.12+    , partialord+  default-language: Haskell2010

+ src/Data/PartialOrd.hs view

@@ -0,0 +1,277 @@+{-# LANGUAGE+      DerivingVia,+      PatternSynonyms,+      StandaloneDeriving+  #-}++-- | Partial orders+module Data.PartialOrd (+  -- * Comparisons in partial orders+  PartialOrdering(..),+  fromOrd,+  toMaybeOrd,+  fromMaybeOrd,+  fromLeqGeq,+  -- * Partial orderings+  PartialOrd(..),+  comparable,+  -- * Special partial orderings+  FullyOrd(..),+  Discrete(..),+  -- * Maxima and minima+  Maxima(..),+  maxima,+  Minima(..),+  minima,+  -- * Partial orders on lists+  Infix(..),+  Prefix(..),+  Suffix(..),+  Subseq(..),+  ) where++import Data.IntSet (IntSet)+import qualified Data.IntSet as IS+import Data.List (isInfixOf, isPrefixOf, isSuffixOf, isSubsequenceOf)+import Data.Monoid ()+import Data.Semigroup ()+import Data.Set (Set)+import qualified Data.Set as S+++-- | A data type representing relationships between two objects in a+-- poset: they can be related (by EQ', LT' or GT'; like EQ, LT or GT),+-- or unrelated (NT').+data PartialOrdering = EQ' | LT' | GT' | NT'+  deriving (Eq, Show)++-- | Convert an ordering into a partial ordering+fromOrd :: Ordering -> PartialOrdering+fromOrd EQ = EQ'+fromOrd LT = LT'+fromOrd GT = GT'++-- | Convert a partial ordering to an ordering+toMaybeOrd :: PartialOrdering -> Maybe Ordering+toMaybeOrd EQ' = Just EQ+toMaybeOrd LT' = Just LT+toMaybeOrd GT' = Just GT+toMaybeOrd NT' = Nothing++-- | Convert an ordering into a partial ordering+fromMaybeOrd :: Maybe Ordering -> PartialOrdering+fromMaybeOrd (Just EQ) = EQ'+fromMaybeOrd (Just LT) = LT'+fromMaybeOrd (Just GT) = GT'+fromMaybeOrd Nothing   = NT'++-- | Convert from `leq` and `geq` to a partial ordering+fromLeqGeq :: Bool -> Bool -> PartialOrdering+fromLeqGeq True True = EQ'+fromLeqGeq True False = LT'+fromLeqGeq False True = GT'+fromLeqGeq False False = NT'+++-- | A helper type for constructing partial orderings from total+-- orderings (using deriving via)+newtype FullyOrd a = FullyOrd {+  getOrd :: a+} deriving (Eq, Ord, Show)++instance (Ord a) => PartialOrd (FullyOrd a) where+  compare' (FullyOrd x) (FullyOrd y) = fromOrd $ compare x y+++-- | A helper type for constructing partial orderings where everything+-- is equal or incomparable.+newtype Discrete a = Discrete {+  getDiscrete :: a+} deriving (Eq, Show)++instance (Eq a) => PartialOrd (Discrete a) where+  compare' (Discrete x) (Discrete y)+    | x == y    = EQ'+    | otherwise = NT'+++-- | A comparison (less than or equal, greater than or equal) holds if+-- and only if it does on both arguments.+instance Semigroup PartialOrdering where+  NT' <> _   = NT'+  EQ' <> x   = x+  _   <> NT' = NT'+  x   <> EQ' = x+  LT' <> LT' = LT'+  GT' <> GT' = GT'+  _   <> _   = NT'++instance Monoid PartialOrdering where+  mempty = EQ'++-- | A typeclass expressing partially ordered types: any two elements+-- are related by a `PartialOrdering`.+class PartialOrd a where+  {-# MINIMAL compare' | leq #-}++  compare' :: a -> a -> PartialOrdering+  compare' a b = fromLeqGeq (a `leq` b) (a `geq` b)++  leq :: a -> a -> Bool+  a `leq` b = case compare' a b of+    LT' -> True+    EQ' -> True+    _   -> False++  geq :: a -> a -> Bool+  a `geq` b = b `leq` a++-- | Are they LT', EQ', GT'+comparable :: PartialOrd a => a -> a -> Bool+comparable a b = case compare' a b of+  NT' -> False+  _   -> True++-- | It's hard to imagine another sensible instance+deriving via FullyOrd Int instance PartialOrd Int++-- | It's hard to imagine another sensible instance+deriving via FullyOrd Integer instance PartialOrd Integer+++instance PartialOrd () where+  compare' _ _ = EQ'++-- | This is equivalent to+--+--   >   compare' (a,b) (c,d) = compare' a c <> compare' b d+--+--   but may be more efficient: if compare' a1 a2 is LT' or GT' we seek less+--   information about b1 and b2 (and this can be faster).+instance (PartialOrd a, PartialOrd b) => PartialOrd (a,b) where+  compare' (a1,b1) (a2,b2) = case compare' a1 a2 of+    NT' -> NT'+    EQ' -> compare' b1 b2+    LT' -> if b1 `leq` b2 then LT' else NT'+    GT' -> if b1 `geq` b2 then GT' else NT'+  (a1,b1) `leq` (a2,b2) = a1 `leq` a2 && b1 `leq` b2++instance (PartialOrd a, PartialOrd b, PartialOrd c) => PartialOrd (a,b,c) where+  compare' (a1,b1,c1) (a2,b2,c2) = compare' ((a1,b1),c1) ((a2,b2),c2)+  (a1,b1,c1) `leq` (a2,b2,c2) = a1 `leq` a2 && b1 `leq` b2 && c1 `leq` c2++instance (PartialOrd a, PartialOrd b, PartialOrd c, PartialOrd d) => PartialOrd (a,b,c,d) where+  compare' (a1,b1,c1,d1) (a2,b2,c2,d2) = compare' (((a1,b1),c1),d1) (((a2,b2),c2),d2)+  (a1,b1,c1,d1) `leq` (a2,b2,c2,d2) = a1 `leq` a2 && b1 `leq` b2 && c1 `leq` c2 && d1 `leq` d2++instance (PartialOrd a, PartialOrd b, PartialOrd c, PartialOrd d, PartialOrd e) => PartialOrd (a,b,c,d,e) where+  compare' (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = compare' ((((a1,b1),c1),d1),e1) ((((a2,b2),c2),d2),e2)+  (a1,b1,c1,d1,e1) `leq` (a2,b2,c2,d2,e2) = a1 `leq` a2 && b1 `leq` b2 && c1 `leq` c2 && d1 `leq` d2 && e1 `leq` e2+++instance Ord a => PartialOrd (Set a) where+  leq = S.isSubsetOf++  compare' u v = case compare (S.size u) (S.size v) of+    LT -> if S.isSubsetOf u v then LT' else NT'+    GT -> if S.isSubsetOf v u then GT' else NT'+    EQ -> if u == v then EQ' else NT'++instance PartialOrd IntSet where+  leq = IS.isSubsetOf++  compare' u v = case compare (IS.size u) (IS.size v) of+    LT -> if IS.isSubsetOf u v then LT' else NT'+    GT -> if IS.isSubsetOf u v then GT' else NT'+    EQ -> if u == v then EQ' else NT'+++-- | Lists partially ordered by infix inclusion+newtype Infix a = Infix {+  unInfix :: [a]+} deriving (Eq, Show)++instance Eq a => PartialOrd (Infix a) where+  Infix a `leq` Infix b = isInfixOf a b++-- | Lists partially ordered by prefix inclusion+newtype Prefix a = Prefix {+  unPrefix :: [a]+} deriving (Eq, Show)++instance Eq a => PartialOrd (Prefix a) where+  compare' (Prefix a) (Prefix b) = let+    inner [] [] = EQ'+    inner [] _ = LT'+    inner _ [] = GT'+    inner (x:xs) (y:ys)+      | x == y    = inner xs ys+      | otherwise = NT'+    in inner a b+  Prefix a `leq` Prefix b = isPrefixOf a b+++-- | Lists partially ordered by suffix inclusion+newtype Suffix a = Suffix {+  unSuffix :: [a]+} deriving (Eq, Show)++instance Eq a => PartialOrd (Suffix a) where+  Suffix a `leq` Suffix b = isSuffixOf a b+++-- | Lists partially ordered by the subsequence relation+newtype Subseq a = Subseq {+  unSubseq :: [a]+} deriving (Eq, Show)++instance Eq a => PartialOrd (Subseq a) where+  Subseq a `leq` Subseq b = isSubsequenceOf a b+++-- | Sets of incomparable elements, with a monoidal structure obtained+-- by taking the maximal ones.+--+-- Unfortunately, we need a full ordering for these to work (since+-- they use sets), though we don't assume this ordering has any+-- compatibility with the partial order. The monoid structures are+-- most efficient with pre-reduced sets as the left-hand argument.+newtype Maxima a = Maxima {+  maxSet :: Set a+}++instance (Ord a, PartialOrd a) => Semigroup (Maxima a) where+  Maxima s1 <> Maxima s2 = let+    noLarger s x = not . any ((== LT') . compare' x) $ S.toList s+    s2' = S.filter (noLarger s1) s2+    s1' = S.filter (noLarger s2') s1+    in Maxima $ S.union s1' s2'++instance (Ord a, PartialOrd a) => Monoid (Maxima a) where+  mempty = Maxima S.empty+  mappend = (<>)++-- | Find the maxima of a list (passing it through the machinery above)+maxima :: (Ord a, PartialOrd a) => [a] -> [a]+maxima = S.toList . maxSet . mconcat . fmap (Maxima . S.singleton)+++-- | As above, but with minima+newtype Minima a = Minima {+  minSet :: Set a+}++instance (Ord a, PartialOrd a) => Semigroup (Minima a) where+  Minima s1 <> Minima s2 = let+    noSmaller s x = not . any ((== GT') . compare' x) $ S.toList s+    s2' = S.filter (noSmaller s1) s2+    s1' = S.filter (noSmaller s2') s1+    in Minima $ S.union s1' s2'++instance (Ord a, PartialOrd a) => Monoid (Minima a) where+  mempty = Minima S.empty+  mappend = (<>)++-- | Find the minima of a list (passing it through the machinery above)+minima :: (Ord a, PartialOrd a) => [a] -> [a]+minima = S.toList . minSet . mconcat . fmap (Minima . S.singleton)

+ test/Data/PartialOrdSpec.hs view

@@ -0,0 +1,19 @@+module Data.PartialOrdSpec (spec) where++import Test.Hspec+import Data.PartialOrd+++spec :: Spec+spec = do++  describe "Maxima and minima" $ do++    it "should compute maxima" $ do+      maxima [(i,j) | i <- [1..10], j <- [1..10], i+j <= 10] `shouldBe`+        [(i :: Int,10-i) | i <- [1..9]]++    it "should compute minima" $ do+      minima [(i,j) | i <- [1..10], j <- [1..10], i+j >= 10] `shouldBe`+        [(i :: Int,10-i) | i <- [1..9]]+

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}