Hello community,
here is the log from the commit of package ghc-vector-algorithms for
openSUSE:Factory checked in at 2018-09-03 10:35:09
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-vector-algorithms (Old)
and /work/SRC/openSUSE:Factory/.ghc-vector-algorithms.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-vector-algorithms"
Mon Sep 3 10:35:09 2018 rev:8 rq:632493 version:0.7.0.4
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-vector-algorithms/ghc-vector-algorithms.changes
2018-08-20 16:21:01.332958205 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-vector-algorithms.new/ghc-vector-algorithms.changes
2018-09-03 10:35:09.752678695 +0200
@@ -1,0 +2,6 @@
+Thu Aug 30 15:29:21 UTC 2018 - psim...@suse.com
+
+- Update vector-algorithms to version 0.7.0.4.
+ Upstream does not provide a change log file.
+
+-------------------------------------------------------------------
Old:
----
vector-algorithms-0.7.0.1.tar.gz
vector-algorithms.cabal
New:
----
vector-algorithms-0.7.0.4.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-vector-algorithms.spec ++++++
--- /var/tmp/diff_new_pack.sfDL8U/_old 2018-09-03 10:35:10.208679871 +0200
+++ /var/tmp/diff_new_pack.sfDL8U/_new 2018-09-03 10:35:10.208679871 +0200
@@ -19,14 +19,13 @@
%global pkg_name vector-algorithms
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.7.0.1
+Version: 0.7.0.4
Release: 0
Summary: Efficient algorithms for vector arrays
License: BSD-3-Clause
Group: Development/Libraries/Haskell
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-primitive-devel
@@ -38,7 +37,8 @@
%endif
%description
-Efficient algorithms for vector arrays.
+Efficient algorithms for sorting vector arrays. At some stage other vector
+algorithms may be added.
%package devel
Summary: Haskell %{pkg_name} library development files
@@ -54,7 +54,6 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ vector-algorithms-0.7.0.1.tar.gz -> vector-algorithms-0.7.0.4.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/bench/Blocks.hs
new/vector-algorithms-0.7.0.4/bench/Blocks.hs
--- old/vector-algorithms-0.7.0.1/bench/Blocks.hs 2015-08-12
23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/bench/Blocks.hs 1970-01-01
01:00:00.000000000 +0100
@@ -1,62 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
-module Blocks where
-
-import Control.Monad
-import Control.Monad.ST
-
-import Data.Vector.Unboxed.Mutable
-
-import System.CPUTime
-
-import System.Random.MWC (GenIO, Variate(..))
-
--- Some conveniences for doing evil stuff in the ST monad.
--- All the tests get run in IO, but uvector stuff happens
--- in ST, so we temporarily coerce.
-clock :: IO Integer
-clock = getCPUTime
-
--- Strategies for filling the initial arrays
-rand :: Variate e => GenIO -> Int -> IO e
-rand g _ = uniform g
-
-ascend :: Num e => Int -> IO e
-ascend = return . fromIntegral
-
-descend :: Num e => e -> Int -> IO e
-descend m n = return $ m - fromIntegral n
-
-modulo :: Integral e => e -> Int -> IO e
-modulo m n = return $ fromIntegral n `mod` m
-
--- This is the worst case for the median-of-three quicksort
--- used in the introsort implementation.
-medianKiller :: Integral e => e -> Int -> IO e
-medianKiller m n'
- | n < k = return $ if even n then n + 1 else n + k
- | otherwise = return $ (n - k + 1) * 2
- where
- n = fromIntegral n'
- k = m `div` 2
-{-# INLINE medianKiller #-}
-
-initialize :: (Unbox e) => MVector RealWorld e -> Int -> (Int -> IO e) -> IO ()
-initialize arr len fill = init $ len - 1
- where init n = fill n >>= unsafeWrite arr n >> when (n > 0) (init $ n - 1)
-{-# INLINE initialize #-}
-
-speedTest :: (Unbox e) => Int
- -> (Int -> IO e)
- -> (MVector RealWorld e -> IO ())
- -> IO Integer
-speedTest n fill algo = do
- arr <- new n
- initialize arr n fill
- t0 <- clock
- algo arr
- t1 <- clock
- return $ t1 - t0
-{-# INLINE speedTest #-}
-
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/bench/Main.hs
new/vector-algorithms-0.7.0.4/bench/Main.hs
--- old/vector-algorithms-0.7.0.1/bench/Main.hs 2015-08-12 23:47:36.000000000
+0200
+++ new/vector-algorithms-0.7.0.4/bench/Main.hs 1970-01-01 01:00:00.000000000
+0100
@@ -1,201 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
-module Main (main) where
-
-import Prelude hiding (read, length)
-import qualified Prelude as P
-
-import Control.Monad.ST
-import Control.Monad.Error
-
-import Data.Char
-import Data.Ord (comparing)
-import Data.List (maximumBy)
-
-import Data.Vector.Unboxed.Mutable
-
-import qualified Data.Vector.Algorithms.Insertion as INS
-import qualified Data.Vector.Algorithms.Intro as INT
-import qualified Data.Vector.Algorithms.Heap as H
-import qualified Data.Vector.Algorithms.Merge as M
-import qualified Data.Vector.Algorithms.Radix as R
-import qualified Data.Vector.Algorithms.AmericanFlag as AF
-import qualified Data.Vector.Algorithms.Tim as T
-
-import System.Environment
-import System.Console.GetOpt
-import System.Random.MWC
-
-import Blocks
-
--- Does nothing. For testing the speed/heap allocation of the building blocks.
-noalgo :: (Unbox e) => MVector RealWorld e -> IO ()
-noalgo _ = return ()
-
--- Allocates a temporary buffer, like mergesort for similar purposes as noalgo.
-alloc :: (Unbox e) => MVector RealWorld e -> IO ()
-alloc arr | len <= 4 = arr `seq` return ()
- | otherwise = (new (len `div` 2) :: IO (MVector RealWorld Int)) >>
return ()
- where len = length arr
-
-displayTime :: String -> Integer -> IO ()
-displayTime s elapsed = putStrLn $
- s ++ " : " ++ show (fromIntegral elapsed / 1e12) ++ " seconds"
-
-run :: String -> IO Integer -> IO ()
-run s t = t >>= displayTime s
-
-sortSuite :: String -> GenIO -> Int -> (MVector RealWorld Int -> IO ()) -> IO
()
-sortSuite str g n sort = do
- putStrLn $ "Testing: " ++ str
- run "Random " $ speedTest n (rand g >=> modulo n) sort
- run "Sorted " $ speedTest n ascend sort
- run "Reverse-sorted " $ speedTest n (descend n) sort
- run "Random duplicates " $ speedTest n (rand g >=> modulo 1000) sort
- let m = 4 * (n `div` 4)
- run "Median killer " $ speedTest m (medianKiller m) sort
-
-partialSortSuite :: String -> GenIO -> Int -> Int
- -> (MVector RealWorld Int -> Int -> IO ()) -> IO ()
-partialSortSuite str g n k sort = sortSuite str g n (\a -> sort a k)
-
--- -----------------
--- Argument handling
--- -----------------
-
-data Algorithm = DoNothing
- | Allocate
- | InsertionSort
- | IntroSort
- | IntroPartialSort
- | IntroSelect
- | HeapSort
- | HeapPartialSort
- | HeapSelect
- | MergeSort
- | RadixSort
- | AmericanFlagSort
- | TimSort
- deriving (Show, Read, Enum, Bounded)
-
-data Options = O { algos :: [Algorithm], elems :: Int, portion :: Int, usage
:: Bool } deriving (Show)
-
-defaultOptions :: Options
-defaultOptions = O [] 10000 1000 False
-
-type OptionsT = Options -> Either String Options
-
-options :: [OptDescr OptionsT]
-options = [ Option ['A'] ["algorithm"] (ReqArg parseAlgo "ALGO")
- ("Specify an algorithm to be run. Options:\n" ++ algoOpts)
- , Option ['n'] ["num-elems"] (ReqArg parseN "INT")
- "Specify the size of arrays in algorithms."
- , Option ['k'] ["portion"] (ReqArg parseK "INT")
- "Specify the number of elements to partial sort/select
in\nrelevant algorithms."
- , Option ['?','v'] ["help"] (NoArg $ \o -> Right $ o { usage =
True })
- "Show options."
- ]
- where
- allAlgos :: [Algorithm]
- allAlgos = [minBound .. maxBound]
- algoOpts = fmt allAlgos
- fmt (x:y:zs) = '\t' : pad (show x) ++ show y ++ "\n" ++ fmt zs
- fmt [x] = '\t' : show x ++ "\n"
- fmt [] = ""
- size = (" " ++) . maximumBy (comparing P.length) . map show $
allAlgos
- pad str = zipWith const (str ++ repeat ' ') size
-
-parseAlgo :: String -> Options -> Either String Options
-parseAlgo "None" o = Right $ o { algos = [] }
-parseAlgo "All" o = Right $ o { algos = [DoNothing .. AmericanFlagSort] }
-parseAlgo s o = leftMap (\e -> "Unrecognized algorithm `" ++ e ++ "'")
- . fmap (\v -> o { algos = v : algos o }) $ readEither s
-
-leftMap :: (a -> b) -> Either a c -> Either b c
-leftMap f (Left a) = Left (f a)
-leftMap _ (Right c) = Right c
-
-parseNum :: (Int -> Options) -> String -> Either String Options
-parseNum f = leftMap (\e -> "Invalid numeric argument `" ++ e ++ "'") . fmap f
. readEither
-
-parseN, parseK :: String -> Options -> Either String Options
-parseN s o = parseNum (\n -> o { elems = n }) s
-parseK s o = parseNum (\k -> o { portion = k }) s
-
-readEither :: Read a => String -> Either String a
-readEither s = case reads s of
- [(x,t)] | all isSpace t -> Right x
- _ -> Left s
-
-runTest :: GenIO -> Int -> Int -> Algorithm -> IO ()
-runTest g n k alg = case alg of
- DoNothing -> sortSuite "no algorithm" g n noalgo
- Allocate -> sortSuite "allocate" g n alloc
- InsertionSort -> sortSuite "insertion sort" g n
insertionSort
- IntroSort -> sortSuite "introsort" g n
introSort
- IntroPartialSort -> partialSortSuite "partial introsort" g n k
introPSort
- IntroSelect -> partialSortSuite "introselect" g n k
introSelect
- HeapSort -> sortSuite "heap sort" g n heapSort
- HeapPartialSort -> partialSortSuite "partial heap sort" g n k
heapPSort
- HeapSelect -> partialSortSuite "heap select" g n k
heapSelect
- MergeSort -> sortSuite "merge sort" g n
mergeSort
- RadixSort -> sortSuite "radix sort" g n
radixSort
- AmericanFlagSort -> sortSuite "flag sort" g n flagSort
- TimSort -> sortSuite "tim sort" g n timSort
- _ -> putStrLn $ "Currently unsupported algorithm: " ++ show
alg
-
-mergeSort :: MVector RealWorld Int -> IO ()
-mergeSort v = M.sort v
-{-# NOINLINE mergeSort #-}
-
-introSort :: MVector RealWorld Int -> IO ()
-introSort v = INT.sort v
-{-# NOINLINE introSort #-}
-
-introPSort :: MVector RealWorld Int -> Int -> IO ()
-introPSort v k = INT.partialSort v k
-{-# NOINLINE introPSort #-}
-
-introSelect :: MVector RealWorld Int -> Int -> IO ()
-introSelect v k = INT.select v k
-{-# NOINLINE introSelect #-}
-
-heapSort :: MVector RealWorld Int -> IO ()
-heapSort v = H.sort v
-{-# NOINLINE heapSort #-}
-
-heapPSort :: MVector RealWorld Int -> Int -> IO ()
-heapPSort v k = H.partialSort v k
-{-# NOINLINE heapPSort #-}
-
-heapSelect :: MVector RealWorld Int -> Int -> IO ()
-heapSelect v k = H.select v k
-{-# NOINLINE heapSelect #-}
-
-insertionSort :: MVector RealWorld Int -> IO ()
-insertionSort v = INS.sort v
-{-# NOINLINE insertionSort #-}
-
-radixSort :: MVector RealWorld Int -> IO ()
-radixSort v = R.sort v
-{-# NOINLINE radixSort #-}
-
-flagSort :: MVector RealWorld Int -> IO ()
-flagSort v = AF.sort v
-{-# NOINLINE flagSort #-}
-
-timSort :: MVector RealWorld Int -> IO ()
-timSort v = T.sort v
-{-# NOINLINE timSort #-}
-
-main :: IO ()
-main = getArgs >>= \args -> withSystemRandom $ \gen ->
- case getOpt Permute options args of
- (fs, _, []) -> case foldl (>>=) (Right defaultOptions) fs of
- Left err -> putStrLn $ usageInfo err options
- Right opts | not (usage opts) ->
- mapM_ (runTest gen (elems opts) (portion opts)) (algos opts)
- | otherwise -> putStrLn $ usageInfo
"uvector-algorithms-bench" options
- (_, _, errs) -> putStrLn $ usageInfo (concat errs) options
-
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/bench/simple/Blocks.hs
new/vector-algorithms-0.7.0.4/bench/simple/Blocks.hs
--- old/vector-algorithms-0.7.0.1/bench/simple/Blocks.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/vector-algorithms-0.7.0.4/bench/simple/Blocks.hs 2018-08-24
13:13:24.000000000 +0200
@@ -0,0 +1,62 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Blocks where
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Vector.Unboxed.Mutable
+
+import System.CPUTime
+
+import System.Random.MWC (GenIO, Variate(..))
+
+-- Some conveniences for doing evil stuff in the ST monad.
+-- All the tests get run in IO, but uvector stuff happens
+-- in ST, so we temporarily coerce.
+clock :: IO Integer
+clock = getCPUTime
+
+-- Strategies for filling the initial arrays
+rand :: Variate e => GenIO -> Int -> IO e
+rand g _ = uniform g
+
+ascend :: Num e => Int -> IO e
+ascend = return . fromIntegral
+
+descend :: Num e => e -> Int -> IO e
+descend m n = return $ m - fromIntegral n
+
+modulo :: Integral e => e -> Int -> IO e
+modulo m n = return $ fromIntegral n `mod` m
+
+-- This is the worst case for the median-of-three quicksort
+-- used in the introsort implementation.
+medianKiller :: Integral e => e -> Int -> IO e
+medianKiller m n'
+ | n < k = return $ if even n then n + 1 else n + k
+ | otherwise = return $ (n - k + 1) * 2
+ where
+ n = fromIntegral n'
+ k = m `div` 2
+{-# INLINE medianKiller #-}
+
+initialize :: (Unbox e) => MVector RealWorld e -> Int -> (Int -> IO e) -> IO ()
+initialize arr len fill = initial $ len - 1
+ where initial n = fill n >>= unsafeWrite arr n >> when (n > 0) (initial $ n -
1)
+{-# INLINE initialize #-}
+
+speedTest :: (Unbox e) => Int
+ -> (Int -> IO e)
+ -> (MVector RealWorld e -> IO ())
+ -> IO Integer
+speedTest n fill algo = do
+ arr <- new n
+ initialize arr n fill
+ t0 <- clock
+ algo arr
+ t1 <- clock
+ return $ t1 - t0
+{-# INLINE speedTest #-}
+
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/bench/simple/Main.hs
new/vector-algorithms-0.7.0.4/bench/simple/Main.hs
--- old/vector-algorithms-0.7.0.1/bench/simple/Main.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/vector-algorithms-0.7.0.4/bench/simple/Main.hs 2018-08-24
13:13:24.000000000 +0200
@@ -0,0 +1,201 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Main (main) where
+
+import Prelude hiding (read, length)
+import qualified Prelude as P
+
+import Control.Monad.ST
+import Control.Monad.Error
+
+import Data.Char
+import Data.Ord (comparing)
+import Data.List (maximumBy)
+
+import Data.Vector.Unboxed.Mutable
+
+import qualified Data.Vector.Algorithms.Insertion as INS
+import qualified Data.Vector.Algorithms.Intro as INT
+import qualified Data.Vector.Algorithms.Heap as H
+import qualified Data.Vector.Algorithms.Merge as M
+import qualified Data.Vector.Algorithms.Radix as R
+import qualified Data.Vector.Algorithms.AmericanFlag as AF
+import qualified Data.Vector.Algorithms.Tim as T
+
+import System.Environment
+import System.Console.GetOpt
+import System.Random.MWC
+
+import Blocks
+
+-- Does nothing. For testing the speed/heap allocation of the building blocks.
+noalgo :: (Unbox e) => MVector RealWorld e -> IO ()
+noalgo _ = return ()
+
+-- Allocates a temporary buffer, like mergesort for similar purposes as noalgo.
+alloc :: (Unbox e) => MVector RealWorld e -> IO ()
+alloc arr | len <= 4 = arr `seq` return ()
+ | otherwise = (new (len `div` 2) :: IO (MVector RealWorld Int)) >>
return ()
+ where len = length arr
+
+displayTime :: String -> Integer -> IO ()
+displayTime s elapsed = putStrLn $
+ s ++ " : " ++ show (fromIntegral elapsed / 1e12) ++ " seconds"
+
+run :: String -> IO Integer -> IO ()
+run s t = t >>= displayTime s
+
+sortSuite :: String -> GenIO -> Int -> (MVector RealWorld Int -> IO ()) -> IO
()
+sortSuite str g n sort = do
+ putStrLn $ "Testing: " ++ str
+ run "Random " $ speedTest n (rand g >=> modulo n) sort
+ run "Sorted " $ speedTest n ascend sort
+ run "Reverse-sorted " $ speedTest n (descend n) sort
+ run "Random duplicates " $ speedTest n (rand g >=> modulo 1000) sort
+ let m = 4 * (n `div` 4)
+ run "Median killer " $ speedTest m (medianKiller m) sort
+
+partialSortSuite :: String -> GenIO -> Int -> Int
+ -> (MVector RealWorld Int -> Int -> IO ()) -> IO ()
+partialSortSuite str g n k sort = sortSuite str g n (\a -> sort a k)
+
+-- -----------------
+-- Argument handling
+-- -----------------
+
+data Algorithm = DoNothing
+ | Allocate
+ | InsertionSort
+ | IntroSort
+ | IntroPartialSort
+ | IntroSelect
+ | HeapSort
+ | HeapPartialSort
+ | HeapSelect
+ | MergeSort
+ | RadixSort
+ | AmericanFlagSort
+ | TimSort
+ deriving (Show, Read, Enum, Bounded)
+
+data Options = O { algos :: [Algorithm], elems :: Int, portion :: Int, usage
:: Bool } deriving (Show)
+
+defaultOptions :: Options
+defaultOptions = O [] 10000 1000 False
+
+type OptionsT = Options -> Either String Options
+
+options :: [OptDescr OptionsT]
+options = [ Option ['A'] ["algorithm"] (ReqArg parseAlgo "ALGO")
+ ("Specify an algorithm to be run. Options:\n" ++ algoOpts)
+ , Option ['n'] ["num-elems"] (ReqArg parseN "INT")
+ "Specify the size of arrays in algorithms."
+ , Option ['k'] ["portion"] (ReqArg parseK "INT")
+ "Specify the number of elements to partial sort/select
in\nrelevant algorithms."
+ , Option ['?','v'] ["help"] (NoArg $ \o -> Right $ o { usage =
True })
+ "Show options."
+ ]
+ where
+ allAlgos :: [Algorithm]
+ allAlgos = [minBound .. maxBound]
+ algoOpts = fmt allAlgos
+ fmt (x:y:zs) = '\t' : pad (show x) ++ show y ++ "\n" ++ fmt zs
+ fmt [x] = '\t' : show x ++ "\n"
+ fmt [] = ""
+ size = (" " ++) . maximumBy (comparing P.length) . map show $
allAlgos
+ pad str = zipWith const (str ++ repeat ' ') size
+
+parseAlgo :: String -> Options -> Either String Options
+parseAlgo "None" o = Right $ o { algos = [] }
+parseAlgo "All" o = Right $ o { algos = [DoNothing .. AmericanFlagSort] }
+parseAlgo s o = leftMap (\e -> "Unrecognized algorithm `" ++ e ++ "'")
+ . fmap (\v -> o { algos = v : algos o }) $ readEither s
+
+leftMap :: (a -> b) -> Either a c -> Either b c
+leftMap f (Left a) = Left (f a)
+leftMap _ (Right c) = Right c
+
+parseNum :: (Int -> Options) -> String -> Either String Options
+parseNum f = leftMap (\e -> "Invalid numeric argument `" ++ e ++ "'") . fmap f
. readEither
+
+parseN, parseK :: String -> Options -> Either String Options
+parseN s o = parseNum (\n -> o { elems = n }) s
+parseK s o = parseNum (\k -> o { portion = k }) s
+
+readEither :: Read a => String -> Either String a
+readEither s = case reads s of
+ [(x,t)] | all isSpace t -> Right x
+ _ -> Left s
+
+runTest :: GenIO -> Int -> Int -> Algorithm -> IO ()
+runTest g n k alg = case alg of
+ DoNothing -> sortSuite "no algorithm" g n noalgo
+ Allocate -> sortSuite "allocate" g n alloc
+ InsertionSort -> sortSuite "insertion sort" g n
insertionSort
+ IntroSort -> sortSuite "introsort" g n
introSort
+ IntroPartialSort -> partialSortSuite "partial introsort" g n k
introPSort
+ IntroSelect -> partialSortSuite "introselect" g n k
introSelect
+ HeapSort -> sortSuite "heap sort" g n heapSort
+ HeapPartialSort -> partialSortSuite "partial heap sort" g n k
heapPSort
+ HeapSelect -> partialSortSuite "heap select" g n k
heapSelect
+ MergeSort -> sortSuite "merge sort" g n
mergeSort
+ RadixSort -> sortSuite "radix sort" g n
radixSort
+ AmericanFlagSort -> sortSuite "flag sort" g n flagSort
+ TimSort -> sortSuite "tim sort" g n timSort
+ _ -> putStrLn $ "Currently unsupported algorithm: " ++ show
alg
+
+mergeSort :: MVector RealWorld Int -> IO ()
+mergeSort v = M.sort v
+{-# NOINLINE mergeSort #-}
+
+introSort :: MVector RealWorld Int -> IO ()
+introSort v = INT.sort v
+{-# NOINLINE introSort #-}
+
+introPSort :: MVector RealWorld Int -> Int -> IO ()
+introPSort v k = INT.partialSort v k
+{-# NOINLINE introPSort #-}
+
+introSelect :: MVector RealWorld Int -> Int -> IO ()
+introSelect v k = INT.select v k
+{-# NOINLINE introSelect #-}
+
+heapSort :: MVector RealWorld Int -> IO ()
+heapSort v = H.sort v
+{-# NOINLINE heapSort #-}
+
+heapPSort :: MVector RealWorld Int -> Int -> IO ()
+heapPSort v k = H.partialSort v k
+{-# NOINLINE heapPSort #-}
+
+heapSelect :: MVector RealWorld Int -> Int -> IO ()
+heapSelect v k = H.select v k
+{-# NOINLINE heapSelect #-}
+
+insertionSort :: MVector RealWorld Int -> IO ()
+insertionSort v = INS.sort v
+{-# NOINLINE insertionSort #-}
+
+radixSort :: MVector RealWorld Int -> IO ()
+radixSort v = R.sort v
+{-# NOINLINE radixSort #-}
+
+flagSort :: MVector RealWorld Int -> IO ()
+flagSort v = AF.sort v
+{-# NOINLINE flagSort #-}
+
+timSort :: MVector RealWorld Int -> IO ()
+timSort v = T.sort v
+{-# NOINLINE timSort #-}
+
+main :: IO ()
+main = getArgs >>= \args -> withSystemRandom $ \gen ->
+ case getOpt Permute options args of
+ (fs, _, []) -> case foldl (>>=) (Right defaultOptions) fs of
+ Left err -> putStrLn $ usageInfo err options
+ Right opts | not (usage opts) ->
+ mapM_ (runTest gen (elems opts) (portion opts)) (algos opts)
+ | otherwise -> putStrLn $ usageInfo "vector-algorithms-bench"
options
+ (_, _, errs) -> putStrLn $ usageInfo (concat errs) options
+
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/AmericanFlag.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/AmericanFlag.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/AmericanFlag.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/AmericanFlag.hs
2018-08-24 13:13:24.000000000 +0200
@@ -36,6 +36,8 @@
import Control.Monad
import Control.Monad.Primitive
+import Data.Proxy
+
import Data.Word
import Data.Int
import Data.Bits
@@ -51,31 +53,35 @@
import qualified Data.Vector.Algorithms.Insertion as I
+import Foreign.Storable
+
-- | The methods of this class specify the information necessary to sort
-- arrays using the default ordering. The name 'Lexicographic' is meant
-- to convey that index should return results in a similar way to indexing
-- into a string.
class Lexicographic e where
- -- | Given a representative of a stripe and an index number, this
- -- function should determine whether to stop sorting.
- terminate :: e -> Int -> Bool
+ -- | Computes the length of a representative of a stripe. It should take 'n'
+ -- passes to sort values of extent 'n'. The extent may not be uniform across
+ -- all values of the type.
+ extent :: e -> Int
+
-- | The size of the bucket array necessary for sorting es
- size :: e -> Int
+ size :: Proxy e -> Int
-- | Determines which bucket a given element should inhabit for a
-- particular iteration.
index :: Int -> e -> Int
instance Lexicographic Word8 where
- terminate _ n = n > 0
- {-# INLINE terminate #-}
+ extent _ = 1
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index _ n = fromIntegral n
{-# INLINE index #-}
instance Lexicographic Word16 where
- terminate _ n = n > 1
- {-# INLINE terminate #-}
+ extent _ = 2
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ (n `shiftR` 8) .&. 255
@@ -84,8 +90,8 @@
{-# INLINE index #-}
instance Lexicographic Word32 where
- terminate _ n = n > 3
- {-# INLINE terminate #-}
+ extent _ = 4
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ (n `shiftR` 24) .&. 255
@@ -96,8 +102,8 @@
{-# INLINE index #-}
instance Lexicographic Word64 where
- terminate _ n = n > 7
- {-# INLINE terminate #-}
+ extent _ = 8
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ (n `shiftR` 56) .&. 255
@@ -112,8 +118,8 @@
{-# INLINE index #-}
instance Lexicographic Word where
- terminate _ n = n > 7
- {-# INLINE terminate #-}
+ extent _ = sizeOf (0 :: Word)
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ (n `shiftR` 56) .&. 255
@@ -128,16 +134,16 @@
{-# INLINE index #-}
instance Lexicographic Int8 where
- terminate _ n = n > 0
- {-# INLINE terminate #-}
+ extent _ = 1
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index _ n = 255 .&. fromIntegral n `xor` 128
{-# INLINE index #-}
instance Lexicographic Int16 where
- terminate _ n = n > 1
- {-# INLINE terminate #-}
+ extent _ = 2
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ ((n `xor` minBound) `shiftR` 8) .&. 255
@@ -146,8 +152,8 @@
{-# INLINE index #-}
instance Lexicographic Int32 where
- terminate _ n = n > 3
- {-# INLINE terminate #-}
+ extent _ = 4
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ ((n `xor` minBound) `shiftR` 24) .&. 255
@@ -158,8 +164,8 @@
{-# INLINE index #-}
instance Lexicographic Int64 where
- terminate _ n = n > 7
- {-# INLINE terminate #-}
+ extent _ = 8
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = fromIntegral $ ((n `xor` minBound) `shiftR` 56) .&. 255
@@ -174,8 +180,8 @@
{-# INLINE index #-}
instance Lexicographic Int where
- terminate _ n = n > 7
- {-# INLINE terminate #-}
+ extent _ = sizeOf (0 :: Int)
+ {-# INLINE extent #-}
size _ = 256
{-# INLINE size #-}
index 0 n = ((n `xor` minBound) `shiftR` 56) .&. 255
@@ -190,8 +196,8 @@
{-# INLINE index #-}
instance Lexicographic B.ByteString where
- terminate b i = i >= B.length b
- {-# INLINE terminate #-}
+ extent = B.length
+ {-# INLINE extent #-}
size _ = 257
{-# INLINE size #-}
index i b
@@ -199,15 +205,43 @@
| otherwise = fromIntegral (B.index b i) + 1
{-# INLINE index #-}
+instance (Lexicographic a, Lexicographic b) => Lexicographic (a, b) where
+ extent (a,b) = extent a + extent b
+ {-# INLINE extent #-}
+ size _ = size (Proxy :: Proxy a) `max` size (Proxy :: Proxy b)
+ {-# INLINE size #-}
+ index i (a,b)
+ | i >= extent a = index i b
+ | otherwise = index i a
+ {-# INLINE index #-}
+
+instance (Lexicographic a, Lexicographic b) => Lexicographic (Either a b) where
+ extent (Left a) = 1 + extent a
+ extent (Right b) = 1 + extent b
+ {-# INLINE extent #-}
+ size _ = size (Proxy :: Proxy a) `max` size (Proxy :: Proxy b)
+ {-# INLINE size #-}
+ index 0 (Left _) = 0
+ index 0 (Right _) = 1
+ index n (Left a) = index (n-1) a
+ index n (Right b) = index (n-1) b
+ {-# INLINE index #-}
+
+-- | Given a representative of a stripe and an index number, this
+-- function determines whether to stop sorting.
+terminate :: Lexicographic e => e -> Int -> Bool
+terminate e i = i >= extent e
+{-# INLINE terminate #-}
+
-- | Sorts an array using the default ordering. Both Lexicographic and
-- Ord are necessary because the algorithm falls back to insertion sort
-- for sufficiently small arrays.
sort :: forall e m v. (PrimMonad m, MVector v e, Lexicographic e, Ord e)
=> v (PrimState m) e -> m ()
-sort v = sortBy compare terminate (size e) index v
- where e :: e
- e = undefined
-{-# INLINE sort #-}
+sort v = sortBy compare terminate (size p) index v
+ where p :: Proxy e
+ p = Proxy
+{-# INLINABLE sort #-}
-- | A fully parameterized version of the sorting algorithm. Again, this
-- function takes both radix information and a comparison, because the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Common.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Common.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Common.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Common.hs
2018-08-24 13:13:24.000000000 +0200
@@ -18,6 +18,7 @@
import Control.Monad.Primitive
import Data.Vector.Generic.Mutable
+import Data.Word (Word)
import qualified Data.Vector.Primitive.Mutable as PV
@@ -46,3 +47,13 @@
| otherwise = return ()
{-# INLINE countLoop #-}
+midPoint :: Int -> Int -> Int
+midPoint a b =
+ toInt $ (toWord a + toWord b) `div` 2
+ where
+ toWord :: Int -> Word
+ toWord = fromIntegral
+
+ toInt :: Word -> Int
+ toInt = fromIntegral
+{-# INLINE midPoint #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Heap.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Heap.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Heap.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Heap.hs
2018-08-24 13:13:24.000000000 +0200
@@ -54,7 +54,7 @@
-- | Sorts an entire array using the default ordering.
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort = sortBy compare
-{-# INLINE sort #-}
+{-# INLINABLE sort #-}
-- | Sorts an entire array using a custom ordering.
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m
()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Insertion.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Insertion.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Insertion.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Insertion.hs
2018-08-24 13:13:24.000000000 +0200
@@ -34,7 +34,7 @@
-- | Sorts an entire array using the default comparison for the type
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort = sortBy compare
-{-# INLINE sort #-}
+{-# INLINABLE sort #-}
-- | Sorts an entire array using a given comparison
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m
()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Intro.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Intro.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Intro.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Intro.hs
2018-08-24 13:13:24.000000000 +0200
@@ -56,7 +56,7 @@
import Data.Bits
import Data.Vector.Generic.Mutable
-import Data.Vector.Algorithms.Common (Comparison)
+import Data.Vector.Algorithms.Common (Comparison, midPoint)
import qualified Data.Vector.Algorithms.Insertion as I
import qualified Data.Vector.Algorithms.Optimal as O
@@ -65,7 +65,7 @@
-- | Sorts an entire array using the default ordering.
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort = sortBy compare
-{-# INLINE sort #-}
+{-# INLINABLE sort #-}
-- | Sorts an entire array using a custom ordering.
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m
()
@@ -106,7 +106,7 @@
sort (d-1) l (mid - 1)
where
len = u - l
- c = (u + l) `div` 2
+ c = midPoint u l
{-# INLINE introsort #-}
-- | Moves the least k elements to the front of the array in
@@ -155,7 +155,7 @@
else if m < mid - 1
then go (n-1) l m (mid - 1)
else return ()
- where c = (u + l) `div` 2
+ where c = midPoint u l
{-# INLINE selectByBounds #-}
-- | Moves the least k elements to the front of the array, sorted.
@@ -207,7 +207,7 @@
go (n-1) mid m u
EQ -> isort (n-1) l m
LT -> go n l m (mid - 1)
- where c = (u + l) `div` 2
+ where c = midPoint u l
{-# INLINE partialSortByBounds #-}
partitionBy :: forall m v e. (PrimMonad m, MVector v e)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Merge.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Merge.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Merge.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Merge.hs
2018-08-24 13:13:24.000000000 +0200
@@ -27,7 +27,7 @@
import Data.Bits
import Data.Vector.Generic.Mutable
-import Data.Vector.Algorithms.Common (Comparison, copyOffset)
+import Data.Vector.Algorithms.Common (Comparison, copyOffset, midPoint)
import qualified Data.Vector.Algorithms.Optimal as O
import qualified Data.Vector.Algorithms.Insertion as I
@@ -35,7 +35,7 @@
-- | Sorts an array using the default comparison.
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort = sortBy compare
-{-# INLINE sort #-}
+{-# INLINABLE sort #-}
-- | Sorts an array using a custom comparison.
sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m
()
@@ -60,7 +60,7 @@
loop mid u
merge cmp (unsafeSlice l len src) buf (mid - l)
where len = u - l
- mid = (u + l) `shiftR` 1
+ mid = midPoint u l
{-# INLINE mergeSortWithBuf #-}
merge :: (PrimMonad m, MVector v e)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Radix.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Radix.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Radix.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Radix.hs
2018-08-24 13:13:24.000000000 +0200
@@ -186,7 +186,7 @@
where
e :: e
e = undefined
-{-# INLINE sort #-}
+{-# INLINABLE sort #-}
-- | Radix sorts an array using custom radix information
-- requires the number of passes to fully sort the array,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Search.hs
new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Search.hs
--- old/vector-algorithms-0.7.0.1/src/Data/Vector/Algorithms/Search.hs
2015-08-12 23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/src/Data/Vector/Algorithms/Search.hs
2018-08-24 13:13:24.000000000 +0200
@@ -39,7 +39,7 @@
import Data.Vector.Generic.Mutable
-import Data.Vector.Algorithms.Common (Comparison)
+import Data.Vector.Algorithms.Common (Comparison, midPoint)
-- | Finds an index in a given sorted vector at which the given element could
-- be inserted while maintaining the sortedness of the vector.
@@ -70,7 +70,7 @@
LT -> loop (k+1) u
EQ -> return k
GT -> loop l k
- where k = (u + l) `shiftR` 1
+ where k = midPoint u l
{-# INLINE binarySearchByBounds #-}
-- | Finds the lowest index in a given sorted vector at which the given element
@@ -136,7 +136,7 @@
loop !l !u
| u <= l = return l
| otherwise = unsafeRead vec k >>= \e -> if p e then loop l k else loop
(k+1) u
- where k = (u + l) `shiftR` 1
+ where k = midPoint u l
{-# INLINE binarySearchPBounds #-}
-- | Given a predicate that is guaranteed to be monotone on the vector elements
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/tests/properties/Tests.hs
new/vector-algorithms-0.7.0.4/tests/properties/Tests.hs
--- old/vector-algorithms-0.7.0.1/tests/properties/Tests.hs 2015-08-12
23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/tests/properties/Tests.hs 2018-08-24
13:13:24.000000000 +0200
@@ -117,15 +117,8 @@
check_permutation = do
qc $ label "introsort" . prop_permutation (INT.sort :: Algo Int ())
- qc $ label "intropartial" . prop_sized (const . prop_permutation)
- (INT.partialSort :: SizeAlgo Int ())
- qc $ label "introselect" . prop_sized (const . prop_permutation)
- (INT.select :: SizeAlgo Int ())
qc $ label "heapsort" . prop_permutation (H.sort :: Algo Int ())
- qc $ label "heappartial" . prop_sized (const . prop_permutation)
- (H.partialSort :: SizeAlgo Int ())
- qc $ label "heapselect" . prop_sized (const . prop_permutation)
- (H.select :: SizeAlgo Int ())
+
qc $ label "mergesort" . prop_permutation (M.sort :: Algo Int ())
qc $ label "timsort" . prop_permutation (T.sort :: Algo Int ())
qc $ label "radix I8" . prop_permutation (R.sort :: Algo Int8 ())
@@ -149,6 +142,17 @@
qc $ label "flag W64" . prop_permutation (AF.sort :: Algo Word64 ())
qc $ label "flag Word" . prop_permutation (AF.sort :: Algo Word ())
qc $ label "flag ByteString" . prop_permutation (AF.sort :: Algo
B.ByteString ())
+{-
+ qc $ label "intropartial" . prop_sized (const . prop_permutation)
+ (INT.partialSort :: SizeAlgo Int ())
+ qc $ label "introselect" . prop_sized (const . prop_permutation)
+ (INT.select :: SizeAlgo Int ())
+ qc $ label "heappartial" . prop_sized (const . prop_permutation)
+ (H.partialSort :: SizeAlgo Int ())
+ qc $ label "heapselect" . prop_sized (const . prop_permutation)
+ (H.select :: Algo Int ())
+-}
+
where
qc prop = quickCheckWith args prop
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/vector-algorithms-0.7.0.1/vector-algorithms.cabal
new/vector-algorithms-0.7.0.4/vector-algorithms.cabal
--- old/vector-algorithms-0.7.0.1/vector-algorithms.cabal 2015-08-12
23:47:36.000000000 +0200
+++ new/vector-algorithms-0.7.0.4/vector-algorithms.cabal 2018-08-24
13:13:24.000000000 +0200
@@ -1,15 +1,17 @@
name: vector-algorithms
-version: 0.7.0.1
+version: 0.7.0.4
license: BSD3
license-file: LICENSE
author: Dan Doel
maintainer: Dan Doel <dan.d...@gmail.com>
+ Erik de Castro Lopo <er...@mega-nerd.com>
copyright: (c) 2008,2009,2010,2011,2012,2013,2014,2015 Dan Doel
(c) 2015 Tim Baumann
-homepage: http://code.haskell.org/~dolio/
+homepage: https://github.com/erikd/vector-algorithms/
category: Data
synopsis: Efficient algorithms for vector arrays
-description: Efficient algorithms for vector arrays
+description: Efficient algorithms for sorting vector arrays. At some
stage
+ other vector algorithms may be added.
build-type: Simple
cabal-version: >= 1.9.2
@@ -36,18 +38,29 @@
description: Enable the quickcheck tests
default: True
+-- flag dump-simpl
+-- description: Dumps the simplified core during compilation
+-- default: False
+
+flag llvm
+ description: Build using llvm
+ default: False
+
source-repository head
- type: darcs
- location: http://hub.darcs.net/dolio/vector-algorithms
+ type: git
+ location: https://github.com/erikd/vector-algorithms/
library
hs-source-dirs: src
build-depends: base >= 4.5 && < 5,
- vector >= 0.6 && < 0.12,
+ vector >= 0.6 && < 0.13,
primitive >=0.3 && <0.7,
bytestring >= 0.9 && < 1.0
+ if ! impl (ghc >= 7.8)
+ build-depends: tagged >= 0.4 && < 0.9
+
exposed-modules:
Data.Vector.Algorithms.Optimal
Data.Vector.Algorithms.Insertion
@@ -63,9 +76,15 @@
Data.Vector.Algorithms.Common
ghc-options:
- -Odph
-funbox-strict-fields
+ -- Cabal/Hackage complains about these
+ -- if flag(dump-simpl)
+ -- ghc-options: -ddump-simpl -ddump-to-file
+
+ if flag(llvm)
+ ghc-options: -fllvm
+
include-dirs:
include
@@ -81,8 +100,8 @@
if flag(InternalChecks)
cpp-options: -DVECTOR_INTERNAL_CHECKS
-executable vector-algorithms-bench
- hs-source-dirs: bench
+executable simple-bench
+ hs-source-dirs: bench/simple
if !flag(bench)
buildable: False
@@ -93,7 +112,14 @@
Blocks
build-depends: base, mwc-random, vector, vector-algorithms, mtl
- ghc-options: -Wall -Odph
+ ghc-options: -Wall
+
+ -- Cabal/Hackage complains about these
+ -- if flag(dump-simpl)
+ -- ghc-options: -ddump-simpl -ddump-to-file
+
+ if flag(llvm)
+ ghc-options: -fllvm
test-suite properties
hs-source-dirs: tests/properties
@@ -115,3 +141,6 @@
QuickCheck >= 2,
vector,
vector-algorithms
+
+ if flag(llvm)
+ ghc-options: -fllvm
