packages feed

partial-order (empty) → 0.1.2

raw patch · 5 files changed

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

Dependencies added: HUnit, base, containers, partial-order, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2016 Moritz Schulte+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 nokee nor the names of its+  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 HOLDER 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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ partial-order.cabal view
@@ -0,0 +1,47 @@+name:                partial-order+version:             0.1.2+synopsis:            Provides typeclass suitable for types admitting a partial order+description:         This packages provides the PartialOrd typeclass suitable for+                     types admitting a partial order.++                     The only module exposed by this package is+                     Data.PartialOrd. Along with the PartialOrd+                     typeclass and some utility functions for working+                     with partially ordered types, it exports+                     instances for certain numeric types along with+                     instances for lists and sets.+homepage:            https://github.com/mtesseract/haskell-partial-order+license:             BSD3+license-file:        LICENSE+author:              Moritz Schulte+maintainer:          mtesseract@silverratio.net+copyright:           (c) 2016 Moritz Schulte+category:            Data+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.PartialOrd+  build-depends:       base >= 4.7 && < 5+                     , containers >= 0.5.0.0 && < 0.6+  default-language:    Haskell2010++test-suite partial-order-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , partial-order+                     , HUnit >= 1.3.0.0 && < 1.4.0.0+                     , test-framework >= 0.8.1.1+                     , test-framework-hunit+                     , test-framework-quickcheck2+                     , containers >= 0.5.0.0 && < 0.6+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+ location: https://github.com/mtesseract/haskell-partial-order
+ src/Data/PartialOrd.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE NoImplicitPrelude #-}++{-|+Module      : Data.PartialOrd+Description : Provides the PartialOrd Typeclass.+Copyright   : (c) 2016 Moritz Schulte+License     : BSD3+Maintainer  : mtesseract@silverratio.net+Stability   : experimental+Portability : POSIX++This module provides the `PartialOrd' typeclass suitable for types+admitting a partial order.++Along with the `PartialOrd' typeclass and some utility functions for+working with partially ordered types, it exports implementations for+the numeric types several numeric types, lists and sets.+-}++module Data.PartialOrd+  ( PartialOrd(..)+  , maxima, minima+  , elem, notElem+  , nub ) where++import Data.Bool+import Data.Maybe+import Prelude (Int, Integer, Float, Double, ($), Integral)+import qualified Data.Ord as Ord+import qualified Data.Eq as Eq+import qualified Data.List as List+import qualified Data.Set as Set+import qualified Data.Foldable as Foldable++class PartialOrd a where++  -- | Less-than-or-equal relation.+  (<=) :: a -> a -> Bool++  -- | Bigger-than-or-equal relation. Defined in terms of `<='.+  (>=) :: a -> a -> Bool+  a >= a' = a' <= a++  -- | Equality relation. Defined in terms of `<='.+  (==) :: a -> a -> Bool+  a == a' = a <= a' && a' <= a++  -- | Inequality relation. Defined in terms of `=='.+  (/=) :: a -> a -> Bool+  a /= a' = not (a == a')++  -- | Less-than relation relation. Defined in terms of `<=' and `/='.+  (<) :: a -> a -> Bool+  a < a' = a <= a' && (a /= a')++  -- | Bigger-than relation. Defined in terms of `<=` and `/='.+  (>) :: a -> a -> Bool+  a > a' = a' <= a && (a /= a')++  -- | Compare function, returning either `Just' an `Ordering' or+  -- `Nothing'.+  compare :: a -> a -> Maybe Ord.Ordering+  compare a a' = if | a == a'   -> Just Ord.EQ+                    | a <= a'   -> Just Ord.LT+                    | a >= a'   -> Just Ord.GT+                    | otherwise -> Nothing++  {-# MINIMAL (<=) #-}+  +-- | Derive the partial order from the total order for the following+-- types:+instance PartialOrd Int where+  (<=) = (Ord.<=)+  +instance PartialOrd Integer where+  (<=) = (Ord.<=)+  +instance PartialOrd Double where+  (<=) = (Ord.<=)++instance PartialOrd Float where+  (<=) = (Ord.<=)++-- | Define the partial order in terms of the subset relation.+instance (Ord.Ord a) => PartialOrd (Set.Set a) where+  (<=) = Set.isSubsetOf++-- | Define the partial order in terms of the sublist relation.+instance PartialOrd a => PartialOrd [a] where+  (<=) = isSublistOf++-- | Return True if the first list is a sublist of the second list.+isSublistOf :: PartialOrd a => [a] -> [a] -> Bool+isSublistOf [] _ = True+isSublistOf (a:as) a' = a `elem` a' && as `isSublistOf` a'++-- | Compute the list of all elements that are not less than any other+-- element in the list.+maxima :: PartialOrd a => [a] -> [a]+maxima as = nub $ extrema (<=) as++-- | Compute the list of all elements that are not bigger than any+-- other element in the list.+minima :: PartialOrd a => [a] -> [a]+minima as = nub $ extrema (>=) as++extrema :: PartialOrd a => (a -> a -> Bool) -> [a] -> [a]+extrema f as = List.filter isExtremal as+  where isExtremal a =+          -- Return true if there exists no a' in as \ {a} such that+          --   a `f` a'.+          let as' = List.filter (/= a) as+          in not (Foldable.any (a `f`) as')++-- | Version of the traditional elem function using the PartialOrd+-- notion of equality.+elem :: (PartialOrd a, Foldable.Foldable t) => a -> t a -> Bool+elem x xs = Foldable.any (x ==) xs++-- | Version of the traditional notElem function using the PartialOrd+-- notion of equality.+notElem :: (PartialOrd a, Foldable.Foldable t) => a -> t a -> Bool+notElem x xs = not $ elem x xs++-- | Version of the traditional nub function using the PartialOrd+-- notion of equality.+nub :: PartialOrd a => [a] -> [a]+nub as = List.reverse $ Foldable.foldl' collect [] as+  where collect uniques a =+          if a `elem` uniques+          then uniques+          else a : uniques
+ test/Spec.hs view
@@ -0,0 +1,218 @@+module Main where++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Data.List+import Data.Ord+import qualified Data.Set as S+import qualified Data.PartialOrd as PO+import Test.HUnit ((@?=))++main :: IO ()+main = defaultMain tests++tests :: [Test.Framework.Test]+tests =+  [ testGroup "Number Properties"+    [+      testProperty "Int"+      (prop_num :: Integer -> Integer -> Bool)+    , testProperty "Integer"+      (prop_num :: Int     -> Int     -> Bool)+    , testProperty "Double"+      (prop_num :: Double  -> Double  -> Bool)+    , testProperty "Float"+      (prop_num :: Float   -> Float   -> Bool)+    ]+  , testGroup "List Properties"+    [+      testProperty "=="+      (\ a b -> compareBinFuns (equal isSublistOf) (PO.==)+                               (a :: [Int]) (b :: [Int]))+    , testProperty "== (sort)"+      (\ a -> let a' = sort a :: [Int]+              in compareBinFuns (equal isSublistOf) (PO.==)+                                (reverse a') a')+    , testProperty "/="+      (\ a b -> compareBinFuns (notEqual isSublistOf) (PO./=)+                               (a :: [Int]) (b :: [Int]))+    , testProperty "<="+      (\ a b -> compareBinFuns isSublistOf (PO.<=)+                               (a :: [Int]) (b :: [Int]))+    , testProperty ">="+      (\ a b -> compareBinFuns (geq isSublistOf) (PO.>=)+                               (a :: [Int]) (b :: [Int]))+    , testProperty "<"+      (\ a b -> compareBinFuns (less isSublistOf) (PO.<)+                               (a :: [Int]) (b :: [Int]))+    , testProperty ">"+      (\ a b -> compareBinFuns (greater isSublistOf) (PO.>)+                               (a :: [Int]) (b :: [Int]))+    , testProperty "transitivity"+      (\ a b c -> prop_trans (a :: [Int])+                             (b :: [Int])+                             (c :: [Int]))+    , testProperty "antisymmetry"+      (\ a b -> prop_antisymmetry (a :: [Int]) (b :: [Int]))+    ]+  , testGroup "Set Properties"+    [+      testProperty "=="+      (\ a b -> compareBinFuns (equal S.isSubsetOf) (PO.==)+                (a :: S.Set Int) (b :: S.Set Int))+    , testProperty "/="+      (\ a b -> compareBinFuns (notEqual S.isSubsetOf) (PO./=)+                               (a :: S.Set Int) (b :: S.Set Int))+    , testProperty "<="+      (\ a b -> compareBinFuns S.isSubsetOf (PO.<=)+                               (a :: S.Set Int) (b :: S.Set Int))+    , testProperty ">="+      (\ a b -> compareBinFuns (geq S.isSubsetOf) (PO.>=)+                               (a :: S.Set Int) (b :: S.Set Int))+    , testProperty "<"+      (\ a b -> compareBinFuns (less S.isSubsetOf) (PO.<)+                               (a :: S.Set Int) (b :: S.Set Int))+    , testProperty ">"+      (\ a b -> compareBinFuns (greater S.isSubsetOf) (PO.>)+                               (a :: S.Set Int) (b :: S.Set Int))+    , testProperty "transitivity"+      (\ a b c -> prop_trans (a :: S.Set Int)+                             (b :: S.Set Int)+                             (c :: S.Set Int))+    , testProperty "antisymmetry"+      (\ a b -> prop_antisymmetry (a :: S.Set Int) (b :: S.Set Int))+    ]++  , testGroup "Maxima & Minima"+    [+      testProperty "maxima exist"+      (prop_extrema_exist (PO.maxima :: [Int] -> [Int]))+    , testProperty "minima exist"+      (prop_extrema_exist (PO.minima :: [Int] -> [Int]))+    , testProperty "minima are minimal"+      (prop_extrema_extremal (PO.minima :: [[Int]] -> [[Int]]) isSuplistOf)+    , testProperty "maxima are maximal"+      (prop_extrema_extremal (PO.maxima :: [[Int]] -> [[Int]]) isSublistOf)+    , testProperty "Unique maximum for Ord types"+      (prop_unique_extremum (PO.maxima :: [Int] -> [Int]) maximum)+    , testProperty "Unique minimum for Ord types"+      (prop_unique_extremum (PO.minima :: [Int] -> [Int]) minimum)+    ]+  , testGroup "Known Extrema"+    (map (\ (idx, extrema) ->+             let label = "extremal cases (" ++ show idx ++ ")"+             in testCase label (test_known_extrema extrema))+      (zip [1..] knownExtrema))+  ]++test_known_extrema :: PO.PartialOrd a => ([a], [a], [a]) -> IO ()+test_known_extrema (as, asMax, asMin) =+  ((equal isSublistOf) (PO.maxima as) asMax+    && (equal isSublistOf) (PO.minima as) asMin) @?= True++knownExtrema :: [([[Int]], [[Int]], [[Int]])]+knownExtrema = [ ( [ [], [1, 2, 3], [4, 5], [], [4, 5]+                   , [3, 4], [0], [0, 1, 2, 3, 4, 6] ]+                 , [ [ 0, 1, 2, 3, 4, 6], [4, 5] ]+                 , [ [] ] )+               , ( [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ]+                 , [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ]+                 , [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ] )+               , ( []+                 , []+                 , [] )+               , ( [ [ 1, 2 ], [ 2, 1 ] ]+                   , [ [ 1, 2 ] ]+                   , [ [ 1, 2 ] ] )+               , ( [ [ 1, 2 ], [ 2, 3 ] ]+                   , [ [ 1, 2 ], [ 2, 3 ] ]+                   , [ [ 1, 2 ], [ 2, 3 ] ] )+               , ( [ [ 0 ], [ 0, 0 ] ]+                 , [ [ 0 ] ]+                 , [ [ 0 ] ] )+               , ( [ [ 1 ], [ 1 ], [ 1 ] ]+                 , [ [ 1 ] ]+                 , [ [ 1 ] ] )+               , ( [ [ ], [ -1, -2, -3 ] ]+                 , [ [ -3, -2, -1 ] ]+                 , [ [ ] ] )+               ]++prop_trans :: PO.PartialOrd a => a -> a -> a -> Bool+prop_trans a b c =+  case (a PO.<= b, b PO.<= c) of+    (True, True) -> a PO.<= c+    _ -> True++prop_antisymmetry :: PO.PartialOrd a => a -> a -> Bool+prop_antisymmetry a b =+  if a PO.<= b+  then a PO.== b || not (a PO.>= b)+  else True+  +prop_unique_extremum :: Ord a => ([a] -> [a]) -> ([a] -> a) -> [a] -> Bool+prop_unique_extremum _ _ [] = True+prop_unique_extremum computeExtrema computeExtremum as =+  case computeExtrema as of+    [extremum] -> extremum == computeExtremum as+    _ -> False+  +prop_extrema_extremal :: Eq a =>+                         ([a] -> [a]) -> (a -> a -> Bool) -> [a] -> Bool+prop_extrema_extremal computeExtrema relation as =+  let extrema  = computeExtrema as+      extrema' = filter (isBiggerExtremum extrema) as+  in null extrema'+  where -- Returns True if a < a' where a' is in extrema.+        isBiggerExtremum extrema a =+          notNull $ filter (\ e -> (less relation) e a) extrema++        notNull = not . null++prop_extrema_exist :: Eq a => ([a] -> [a]) -> [a] -> Bool+prop_extrema_exist f as =+  null as || (not . null) (f as)++prop_num :: (Num a, Ord a) => a -> a -> Bool+prop_num x y =+  case x `compare` y of+    LT -> x < y+    GT -> x > y+    EQ -> x == y++-- Check if two given binary functions agree on the given input.+compareBinFuns :: Eq c =>+                  (a -> b -> c) -> (a -> b -> c) -> a -> b -> Bool+compareBinFuns f g a b = (a `f` b) == (a `g` b)++-- Implement equality given less-or-equal relation.+equal :: (a -> a -> Bool) -> a -> a -> Bool+equal leq a b = a `leq` b && b `leq` a++-- Implement inequality given less-or-equal relation.+notEqual :: (a -> a -> Bool) -> a -> a -> Bool+notEqual leq a b = not $ equal leq a b++-- Implement greater-or-equal given a less-or-equal relation.+geq :: (a -> a -> Bool) -> a -> a -> Bool+geq = flip++-- Implement strictly-less given a less or-equal relation.+less :: (a -> a -> Bool) -> a -> a -> Bool+less leq a b = (a `leq` b) && notEqual leq a b++  -- Implement strictly-greater given less-or-equal relation.+greater :: (a -> a -> Bool) -> a -> a -> Bool+greater leq a b = less leq b a++-- Check if each element of the first list is also an element of the+-- second list.+isSublistOf :: PO.PartialOrd a => [a] -> [a] -> Bool+isSublistOf [] bs = True+isSublistOf (a:as) bs = a `PO.elem` bs && as `isSublistOf` bs++-- Check if each element of the second list is also an element of the+-- first list.+isSuplistOf :: PO.PartialOrd a => [a] -> [a] -> Bool+isSuplistOf = flip isSublistOf