SizeCompare (empty) → 0.1
raw patch · 4 files changed
+217/−0 lines, 4 filesdep +basedep +containerssetup-changed
Dependencies added: base, containers
Files
- LICENSE +16/−0
- Setup.hs +2/−0
- SizeCompare.cabal +34/−0
- src/Data/SizeCompare.hs +165/−0
+ LICENSE view
@@ -0,0 +1,16 @@+<SizeCompare, fast comparison for egeral haskell containers.>+Copyright (C) 2010 Bram Schuur++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation, either version 3 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ SizeCompare.cabal view
@@ -0,0 +1,34 @@+Name: SizeCompare+Version: 0.1+License: GPL+License-file: LICENSE+Author: Bram Schuur+Maintainer: bschuur@cs.uu.nl+Build-Type: Simple+Cabal-Version: >=1.2+Category: Data+Synopsis: Fast size comparison for standard containers.+Description: SizeCompare is a small library providing size comparison functions standard Haskell data-types.+ Size compare runs in O(min(n,m)) for both arguments, possibly faster.++ Instead of measuring both containers and comparing the result, SizeCompare iteratively deconstructs both+ sides of the equality equation until a conclusion can be made.++ A common expression like:++ length xs > 0++ runs O(n) in the length of the list. Sizecompare runs (O(1)) in this particular case:++ xs |>| 0+ + This is still an initial version of the library and updates may follow after some more profiling.++Library + Build-Depends: base >= 3 && < 5, containers >= 0.2+ Exposed-modules: Data.SizeCompare+ ghc-options: -Wall+ hs-source-dirs: src+++
+ src/Data/SizeCompare.hs view
@@ -0,0 +1,165 @@+module Data.SizeCompare((|==|),(|<|),(|<=|),(|>|),(|>=|),Sizeable(..)) where+import Prelude+import Data.Map as M+import Data.Set as S++-- | Provides functionality for smartly measuring the size of a container+class Sizeable a where+ -- | Returns (Just size) for containers with O(1) size lookup, otherwise Nothing+ cSize :: a -> Maybe Int+ -- | Reduces a container by 1 element, resulting in Nothing when finished+ reduce :: a -> Maybe a+ ++infix 5 |==|+infix 5 |<|+infix 5 |<=|+infix 5 |>|+infix 5 |>=|++-- | Equality on the size of containers+(|==|)::(Sizeable a, Sizeable b) => a -> b -> Bool+x |==| y = case cSize x of + Nothing -> case cSize y of+ Nothing -> findEqBoth (reduce x) (reduce y)+ (Just yt) -> findEqLeft (reduce x) yt+ Just xt -> case cSize y of+ Nothing -> findEqRight xt (reduce y)+ (Just yt) -> xt == yt+ where findEqLeft::(Sizeable a) => Maybe a -> Int -> Bool+ findEqLeft Nothing yt = yt == 0+ findEqLeft (Just xt) yt = findEqLeft (reduce xt) (yt-1)+ + findEqRight::(Sizeable b) => Int -> Maybe b -> Bool+ findEqRight xt Nothing = xt == 0+ findEqRight xt (Just yt) = findEqRight (xt-1) (reduce yt) ++ findEqBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool+ findEqBoth Nothing Nothing = True+ findEqBoth (Just xt) (Just yt) = findEqBoth (reduce xt) (reduce yt)+ findEqBoth _ _ = False++-- | Defines Smaller Than on the size of containers+(|<|)::(Sizeable a, Sizeable b) => a -> b -> Bool+x |<| y = case cSize x of + Nothing -> case cSize y of+ Nothing -> findLtBoth (reduce x) (reduce y)+ (Just yt) -> findLtLeft (reduce x) yt+ Just xt -> case cSize y of+ Nothing -> findLtRight xt (reduce y)+ (Just yt) -> xt < yt+ where findLtLeft::(Sizeable a) => Maybe a -> Int -> Bool+ findLtLeft _ 0 = False+ findLtLeft Nothing _ = True+ findLtLeft (Just xt) yt = findLtLeft (reduce xt) (yt-1)+ + findLtRight::(Sizeable b) => Int -> Maybe b -> Bool+ findLtRight _ Nothing = False + findLtRight 0 _ = True+ findLtRight xt (Just yt) = findLtRight (xt-1) (reduce yt) ++ findLtBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool+ findLtBoth _ Nothing = False+ findLtBoth Nothing _ = True + findLtBoth (Just xt) (Just yt) = findLtBoth (reduce xt) (reduce yt)++-- | Defines Smaller Than or Equal on the size of containers+(|<=|)::(Sizeable a, Sizeable b) => a -> b -> Bool+x |<=| y = case cSize x of + Nothing -> case cSize y of+ Nothing -> findLtEBoth (reduce x) (reduce y)+ (Just yt) -> findLtELeft (reduce x) yt+ Just xt -> case cSize y of+ Nothing -> findLtERight xt (reduce y)+ (Just yt) -> xt <= yt+ where findLtELeft::(Sizeable a) => Maybe a -> Int -> Bool + findLtELeft Nothing _ = True+ findLtELeft _ 0 = False+ findLtELeft (Just xt) yt = findLtELeft (reduce xt) (yt-1)+ + findLtERight::(Sizeable b) => Int -> Maybe b -> Bool+ findLtERight 0 _ = True+ findLtERight _ Nothing = False+ findLtERight xt (Just yt) = findLtERight (xt-1) (reduce yt) ++ findLtEBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool+ findLtEBoth Nothing _ = True+ findLtEBoth _ Nothing = False+ findLtEBoth (Just xt) (Just yt) = findLtEBoth (reduce xt) (reduce yt)++-- | Defines Greater Than on the size of containers+(|>|)::(Sizeable a, Sizeable b) => a -> b -> Bool+x |>| y = case cSize x of + Nothing -> case cSize y of+ Nothing -> findGtBoth (reduce x) (reduce y)+ (Just yt) -> findGtLeft (reduce x) yt+ Just xt -> case cSize y of+ Nothing -> findGtRight xt (reduce y)+ (Just yt) -> xt > yt+ where findGtLeft::(Sizeable a) => Maybe a -> Int -> Bool+ findGtLeft Nothing _ = False+ findGtLeft _ 0 = True+ findGtLeft (Just xt) yt = findGtLeft (reduce xt) (yt-1)+ + findGtRight::(Sizeable b) => Int -> Maybe b -> Bool+ findGtRight 0 _ = False + findGtRight _ Nothing = True+ findGtRight xt (Just yt) = findGtRight (xt-1) (reduce yt) ++ findGtBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool+ findGtBoth Nothing _ = False+ findGtBoth _ Nothing = True + findGtBoth (Just xt) (Just yt) = findGtBoth (reduce xt) (reduce yt)++-- | Defines Greate Than or Equal on the size of containers+(|>=|)::(Sizeable a, Sizeable b) => a -> b -> Bool+x |>=| y = case cSize x of + Nothing -> case cSize y of+ Nothing -> findGtEBoth (reduce x) (reduce y)+ (Just yt) -> findGtELeft (reduce x) yt+ Just xt -> case cSize y of+ Nothing -> findGtERight xt (reduce y)+ (Just yt) -> xt >= yt+ where findGtELeft::(Sizeable a) => Maybe a -> Int -> Bool + findGtELeft _ 0 = True+ findGtELeft Nothing _ = False+ findGtELeft (Just xt) yt = findGtELeft (reduce xt) (yt-1)+ + findGtERight::(Sizeable b) => Int -> Maybe b -> Bool+ findGtERight _ Nothing = True+ findGtERight 0 _ = False + findGtERight xt (Just yt) = findGtERight (xt-1) (reduce yt) ++ findGtEBoth::(Sizeable a, Sizeable b) => Maybe a -> Maybe b -> Bool+ findGtEBoth _ Nothing = True+ findGtEBoth Nothing _ = False + findGtEBoth (Just xt) (Just yt) = findGtEBoth (reduce xt) (reduce yt)++-- | Sizeable instance for Int, make sure to add typing to integer constants, like: (0::Int).+instance Sizeable Int where + reduce 0 = Nothing+ reduce x = Just (x-1)+ cSize x = Just (max x (-1))++-- | Sizeable for Lists+instance Sizeable [a] where+ reduce [] = Nothing+ reduce (_:xs) = Just xs+ cSize _ = Nothing++-- | Sizeable for Sets+instance Sizeable (S.Set a) where+ reduce s | S.null s = Nothing+ | otherwise = Just (S.deleteMin s)+ cSize = Just . S.size++-- | Sizeable for Maps+instance Sizeable (M.Map a b) where+ reduce m | M.null m = Nothing+ | otherwise = Just (M.deleteAt 0 m) + cSize = Just . M.size+++++