binary-search 0.0 → 0.1

raw patch · 8 files changed

+277/−104 lines, 8 filesdep +QuickCheckdep +binary-searchdep +containersdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, binary-search, containers, directory, doctest, filepath, hspec

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Numeric/Search.hs +49/−0
• Numeric/Search/Combinator/Monadic.hs +113/−0
• Numeric/Search/Combinator/Pure.hs +3/−0
• binary-search.cabal +46/−9
• search-test.hs +0/−95
• test/PureSpec.hs +41/−0
• test/Spec.hs +1/−0
• test/doctests.hs +24/−0

@@ -0,0 +1,49 @@+-- | This package provides combinators to construct many variants of+-- binary search.  Most generally, it provides the binary search over+-- predicate of the form @('Eq' b, 'Monad' m) => a -> m b@ . The other+-- searches are derived as special cases of this function.+--+-- 'BinarySearch' assumes two things;+--+-- 1. @b@, the codomain of 'PredicateM' belongs to type class 'Eq'.+--+-- 2. Each value of @b@ form a convex set in the codomain space of the+-- PredicateM. That is, if for certain pair @(left, right) :: (a, a)@+-- satisfies @pred left == val && pred right == val@, then also @pred+-- x == val@ for all @x@ such that @left <= x <= right@ .+++module Numeric.Search (+-- * Pure combinators+-- $pureCombinators++-- ** Types+Range,+-- ** Searchers++-- ** Combinators++-- * Monadic combinators+-- $monadicCombinators++-- ** Types+BinarySearchM,+PredicateM,+InitializerM,+CutterM,++-- ** Searchers+searchWithM+-- ** Combinators++) where++import Numeric.Search.Combinator.Pure+import Numeric.Search.Combinator.Monadic++{- $pureCombinators+   These are pure.+-}+{- $monadicCombinators+   These are monadic.+ -}

@@ -0,0 +1,113 @@+-- | Monadic binary search combinators.++{-# LANGUAGE ScopedTypeVariables #-}++module Numeric.Search.Combinator.Monadic where++import           Control.Applicative((<$>))+import           Data.Sequence as Seq+import           Prelude hiding (init, pred)++-- | The generalized type for binary search functions.+type BinarySearchM m a b =+  InitializerM m a b ->+  CutterM m a b ->+  PredicateM m a b ->+  m (Seq (Range a b))++-- | 'BookEnd' comes in order [LEnd, REnd, LEnd, REnd ...], and+-- represents the ongoing state of the search results.+-- Two successive 'BookEnd' @LEnd x1 y1@, @REnd x2 y1@ represents a+-- claim that @pred x == y1@ for all @x@ such that @x1 <= x <= x2@ .+-- Like this:+--+-- > is (x^2 > 20000) ?+-- >+-- > LEnd    REnd  LEnd     REnd+-- > 0        100  200       300+-- > |_ False _|    |_ True  _|++data BookEnd a b+      = REnd !a !b+      | LEnd !a !b+      deriving (Eq, Show)++-- | 'Range' @((x1,x2),y)@ denotes that @pred x == y@ for all+-- @x1 <= x <= x2@ .+type Range a b = ((a,a),b)++-- | 'PredicateM' @m a b@ calculates the predicate in the context @m@.+type PredicateM m a b = a -> m b++-- | 'InitializerM' generates the initial set of ranges.+type InitializerM m a b = PredicateM m a b -> m (Seq (BookEnd a b))++-- | 'CutterM' @p x1 x2@ decides if we should further investigate the+-- gap between @x1@ and @x2@. If so, it gives a new value @x3@ wrapped+-- in a 'Just'. 'CutterM' may optionally use the predicate.+type CutterM m a b = PredicateM m a b -> a -> a -> m (Maybe a)+++-- | an initializer with the initial range specified.+initConstM :: (Monad m) => a -> a -> InitializerM m a b+initConstM x1 x2 pred = do+  y1 <- pred x1+  y2 <- pred x2+  return $ Seq.fromList [LEnd x1 y1, REnd x1 y1,LEnd x2 y2, REnd x2 y2]++-- | an initializer that searches for the full bound.+initBoundedM :: (Monad m, Bounded a) => InitializerM m a b+initBoundedM = initConstM minBound maxBound++-- | a cutter for integral types.+cutIntegralM :: (Monad m, Integral a) => CutterM m a b+cutIntegralM _ x1 x2+  | x1+1 >= x2 = return Nothing+  | otherwise  = return $ Just ((x1+1)`div`2 + x2 `div`2)++-- | The most generalized version of search.+searchWithM :: forall m a b. (Functor m, Monad m, Eq b) => BinarySearchM m a b+searchWithM init cut pred = do+  seq0 <- init pred+  finalize <$> go seq0+  where+    go :: Seq (BookEnd a b) -> m (Seq (BookEnd a b))+    go seq0 = case viewl seq0 of+      EmptyL -> return seq0+      (x1 :< seq1) -> do+        let skip = (x1 <|) <$> go seq1+        case viewl seq1 of+          EmptyL -> skip+          (x2 :< seq2) -> case (x1,x2) of+            (REnd a1 b1, LEnd a2 b2) -> case b1==b2 of+              True  -> go seq2 -- merge the two regions+              False ->  do+                y1 <- drillDown a1 b1 a2 b2+                y2 <- go seq2+                return $ y1 >< y2+            _ -> skip++    -- precondition : b1 /= b2+    drillDown :: a -> b -> a -> b -> m (Seq (BookEnd a b))+    drillDown x1 y1 x2 y2 = do+      mc <- cut pred x1 x2+      case mc of+        Nothing -> return $ Seq.fromList [REnd x1 y1, LEnd x2 y2]+        Just x3 -> do+          y3 <- pred x3+          case () of+            _ | y3==y1 -> drillDown x3 y3 x2 y2+            _ | y3==y2 -> drillDown x1 y1 x3 y3+            _ -> do+              y1 <-  drillDown x1 y1 x3 y3+              y2 <-  drillDown x3 y3 x2 y2+              return $ y1 >< y2++    finalize :: Seq (BookEnd a b) -> Seq (Range a b)+    finalize seqE = case viewl seqE of+      EmptyL -> Seq.empty+      (x1 :< seqE1) -> case viewl seqE1 of+        EmptyL -> finalize seqE1+        (x2 :< seqE2) -> case (x1,x2) of+          (LEnd x1 y1, REnd x2 y2) | y1==y2 -> ((x1,x2), y1) <| finalize seqE2+          _                                 -> finalize seqE1

@@ -0,0 +1,3 @@+-- | Pure counterpart for binary search.++module Numeric.Search.Combinator.Pure where

@@ -1,11 +1,11 @@ Name:           binary-search-Version:        0.0+Version:        0.1 Build-Depends:  base Build-Type:     Simple License:        BSD3 license-file:   LICENSE-Author:         Ross Paterson <ross@soi.city.ac.uk>-Maintainer:     Ross Paterson <ross@soi.city.ac.uk>+Author:         Ross Paterson <ross@soi.city.ac.uk>, Takayuki Muranushi <muranushi@gmail.com>+Maintainer:     Takayuki Muranushi <muranushi@gmail.com>    Category:       Algorithms Synopsis:       Binary and exponential searches Description:    These modules address the problem of finding the boundary@@ -13,9 +13,46 @@                 of exponential and binary searches.  Variants are provided                 for searching within bounded and unbounded intervals of                 both 'Integer' and bounded integral types.-Exposed-Modules:-                Numeric.Search.Bounded-                Numeric.Search.Integer-                Numeric.Search.Range-Extra-Source-Files:-                search-test.hs+cabal-version:      >=1.8++library+  exposed-modules:  Numeric.Search+                    Numeric.Search.Bounded+                    Numeric.Search.Integer+                    Numeric.Search.Range+                    Numeric.Search.Combinator.Monadic+                    Numeric.Search.Combinator.Pure++  Ghc-Options:      -Wall++  build-depends:    base >=4.5 && < 5+                  , containers >= 0.4++Test-Suite doctest+  Type: exitcode-stdio-1.0+  HS-Source-Dirs: test+  Ghc-Options: -threaded -Wall+  Main-Is: doctests.hs+  Build-Depends:    base+                  , directory >= 1.1+                  , filepath >= 1.2+                  , doctest >= 0.9.3++Test-Suite spec+  Type: exitcode-stdio-1.0+  Hs-Source-Dirs: test+  Ghc-Options: -Wall+  Main-Is: Spec.hs+  Other-Modules:    PureSpec+                    +  Build-Depends:    base >=4.5 && < 5+                  , binary-search++                  , hspec >= 1.3+                  , QuickCheck >= 2.5++++Source-Repository head+  Type: git+  Location: https://github.com/nushio3/binary-search

@@ -1,95 +0,0 @@-module Main (main) where--import Test.QuickCheck-import Numeric.Search.Bounded as B-import Numeric.Search.Integer as I-import Numeric.Search.Range--main :: IO ()-main = flip mapM_ tests $ \ (Test n t) -> do-	putStrLn $ "Testing: " ++ n-	t--data Test = Test String (IO ())--mkTest :: Testable a => String -> a -> Test-mkTest n t = Test n (test t)--tests :: [Test]-tests = [-	mkTest "searchIntegers" prop_searchIntegers,-	mkTest "searchIntegersFrom" prop_searchIntegersFrom,-	mkTest "searchIntegersTo" prop_searchIntegersTo,-	mkTest "searchIntegersTo (const False)" prop_searchIntegersToF,-	mkTest "searchFromTo" prop_searchFromTo,-	mkTest "searchFromTo (const False)" prop_searchFromToF,-	mkTest "searchBounded" prop_searchBounded,-	mkTest "searchBounded (const False)" prop_searchBoundedF,-	mkTest "searchBoundedFrom" prop_searchBoundedFrom,-	mkTest "searchBoundedFrom (const False)" prop_searchBoundedFromF,-	mkTest "searchBoundedTo" prop_searchBoundedTo,-	mkTest "searchBoundedTo (const False)" prop_searchBoundedToF]---- Every upward closed predicate is equivalent to either (const False),--- or (>= n) for some n.--prop_searchIntegers :: Integer -> Bool-prop_searchIntegers n =-	I.search (>= n)  ==  n---- I.search (const False) does not terminate----	I.searchFrom p l  ==  I.search (\ i -> i >= l && p i)--prop_searchIntegersFrom :: Integer -> Integer -> Bool-prop_searchIntegersFrom n l =-	I.searchFrom (>= n) l  ==  max l n---- I.searchFrom (const False) l does not terminate----	I.searchTo p h  ==  if n > h then Nothing else Just n---		let k = I.search (\ i -> i > h || p i)---		in if k <= h then Just k else Nothing--prop_searchIntegersTo :: Integer -> Integer -> Bool-prop_searchIntegersTo n h =-	I.searchTo (>= n) h  ==  if n <= h then Just n else Nothing--prop_searchIntegersToF :: Integer -> Bool-prop_searchIntegersToF h =-	I.searchTo (const False) h  ==  Nothing----	searchFromTo p l h  ==  I.search (\ i -> i < l || i <= h && p i)--prop_searchFromTo :: Int -> Int -> Int -> Bool-prop_searchFromTo n l h =-	searchFromTo (>= n) l h  ==  if k <= h then Just k else Nothing-  where k = max n l--prop_searchFromToF :: Int -> Int -> Bool-prop_searchFromToF l h =-	searchFromTo (const False) l h  ==  Nothing--prop_searchBounded :: Int -> Bool-prop_searchBounded n =-	B.search (>= n)  ==  Just n--prop_searchBoundedF :: Bool-prop_searchBoundedF =-	B.search (const False :: Int -> Bool)  ==  Nothing--prop_searchBoundedFrom :: Int -> Int -> Bool-prop_searchBoundedFrom n l =-	B.searchFrom (>= n) l  ==  Just (max l n) --prop_searchBoundedFromF :: Int -> Bool-prop_searchBoundedFromF l =-	B.searchFrom (const False) l  ==  Nothing--prop_searchBoundedTo :: Int -> Int -> Bool-prop_searchBoundedTo n h =-	B.searchTo (>= n) h  ==  if n <= h then Just n else Nothing--prop_searchBoundedToF :: Int -> Bool-prop_searchBoundedToF h =-	B.searchTo (const False) h  ==  Nothing

@@ -0,0 +1,41 @@+module PureSpec (spec) where++import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Numeric.Search.Bounded as B+import Numeric.Search.Integer as I+import Numeric.Search.Range++spec :: Spec+spec = do+  describe "Integer search" $ do+    prop "finds n when search for (>= n)" $          +      \n -> I.search (>= n)  ==  (n :: Integer)+    prop "finds (max l n) when search for (>= n) in range (>= l)" $          +      \n l -> I.searchFrom (>= n) l  ==  max l n+    prop "finds n when search for (>=n) in range (<=h), iff n <= h." $  +      \n h -> I.searchTo (>= n) h  ==  if n <= h then Just (n :: Integer) else Nothing++  describe "Range search" $ do+    prop "returns Nothing for always failing predicate." $+      \l h -> searchFromTo (const False) l (h :: Int)  ==  Nothing+    prop "finds n given that n is within the range." $+      \n l h -> searchFromTo (>= n) l h  == +         let k = max n l in  if k <= h then Just (k::Int) else Nothing++  describe "Bounded search" $ do+    prop "always finds n when searched for (>=n), by default." $+      \n -> B.search (>= n)  ==  Just (n :: Int)+    it "fails when given always failing predicate." $  +      B.search (const False :: Int -> Bool)  `shouldBe` Nothing+    it "finds the lower bound when given an always-holding predicate." $+      B.search (const True :: Int -> Bool)  `shouldBe` Just minBound+    prop "finds (max l n) for lower-bounded search." $ +      \l n -> B.searchFrom (>= n) l  ==  Just (max l (n::Int))+    prop "finds Nothing for always-failing predicate with a bound." $+      \l -> B.searchFrom (const False) (l::Int)  ==  Nothing+    prop "finds n for upper-bounded search, iff n is within the bound." $ +      \n h ->  B.searchTo (>= n) h  ==  if n <= h then Just (n::Int) else Nothing+    prop "finds Nothing for always-failing predicate with a bound." $ +      \h -> B.searchTo (const False) (h::Int)  ==  Nothing+

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

@@ -0,0 +1,24 @@+module Main where++import Control.Applicative+import Control.Monad+import Test.DocTest+import System.Directory+import System.FilePath++findHs :: FilePath -> IO [FilePath]+findHs dir = do+  fs <- map (dir </>) <$>+    filter (`notElem` ["..","."]) <$>+    getDirectoryContents dir+  subDirs <- filterM doesDirectoryExist fs+  files1 <- filter ((`elem` [".hs", ".lhs"]) . takeExtension) <$>+    filterM doesFileExist fs+  files2 <- concat <$> mapM findHs subDirs+  return $ files1 ++ files2++main :: IO ()+main = do+  files <- findHs "Numeric"+  putStrLn $ "testing: " ++ unwords files+  doctest files