module Algorithms.LogarithmicMethodSpec where import Algorithms.LogarithmicMethod import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (mapMaybe) import Data.Semigroup import Data.Semigroup.Foldable import Data.List.Util import Test.Hspec import Test.QuickCheck -------------------------------------------------------------------------------- spec :: Spec spec = describe "Logarithmic method successor test" $ do it "successor test" $ property $ \q (xs :: [Int]) -> successor q (fromList xs) `shouldBe` minimum1 [ x | x <- xs, x >= q] it "merge test" $ property $ \q (xs :: [Int]) (ys :: [Int]) -> successor q ((fromList xs) <> (fromList ys)) `shouldBe` successor q (fromList $ xs <> ys) newtype DummySucc a = Dummy (NonEmpty a) deriving (Show,Eq,Functor,Foldable,Foldable1,Traversable) instance Ord a => LogarithmicMethodDS DummySucc a where build = Dummy . NonEmpty.sort successor' :: Ord a => a -> DummySucc a -> Maybe (Min a) successor' q (Dummy xs) = case NonEmpty.dropWhile (< q) xs of [] -> Nothing (s:_) -> Just (Min s) successor :: Ord a => a -> InsertionOnly DummySucc a -> Maybe a successor q = fmap getMin . queryWith (successor' q) fromList :: Ord a => [a] -> InsertionOnly DummySucc a fromList = foldr insert empty