diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,16 @@ + +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 . + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/SizeCompare.cabal b/SizeCompare.cabal new file mode 100644 --- /dev/null +++ b/SizeCompare.cabal @@ -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 + + + diff --git a/src/Data/SizeCompare.hs b/src/Data/SizeCompare.hs new file mode 100644 --- /dev/null +++ b/src/Data/SizeCompare.hs @@ -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 + + + + +