1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
{-# LANGUAGE RankNTypes, TypeOperators, FlexibleContexts, TypeApplications #-}
module Main (main) where
import Properties
import Util
import Test.QuickCheck
import Control.Monad
import Control.Monad.ST
import Data.Int
import Data.Word
import qualified Data.ByteString as B
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as BoxedMV
import qualified Data.Vector.Generic as G
import Data.Vector.Generic.Mutable (MVector)
import qualified Data.Vector.Generic.Mutable as MV
import qualified Data.Vector.Algorithms.Insertion as INS
import qualified Data.Vector.Algorithms.Intro as INT
import qualified Data.Vector.Algorithms.Merge as M
import qualified Data.Vector.Algorithms.Radix as R
import qualified Data.Vector.Algorithms.Heap as H
import qualified Data.Vector.Algorithms.Optimal as O
import qualified Data.Vector.Algorithms.AmericanFlag as AF
import qualified Data.Vector.Algorithms.Tim as T
import qualified Data.Vector.Algorithms.Search as SR
type Algo e r = forall s mv. MVector mv e => mv s e -> ST s r
type SizeAlgo e r = forall s mv. MVector mv e => mv s e -> Int -> ST s r
type BoundAlgo e r = forall s mv. MVector mv e => mv s e -> Int -> Int -> ST s r
type MonoAlgo e r = forall s . BoxedMV.MVector s e -> ST s r
newtype WrappedAlgo e r = WrapAlgo { unWrapAlgo :: Algo e r }
newtype WrappedSizeAlgo e r = WrapSizeAlgo { unWrapSizeAlgo :: SizeAlgo e r }
newtype WrappedBoundAlgo e r = WrapBoundAlgo { unWrapBoundAlgo :: BoundAlgo e r }
newtype WrappedMonoAlgo e r = MonoAlgo { unWrapMonoAlgo :: MonoAlgo e r }
args = stdArgs
{ maxSuccess = 1000
, maxDiscardRatio = 2
}
check_Int_sort = forM_ algos $ \(name,algo) ->
quickCheckWith args (label name . prop_fullsort (unWrapAlgo algo))
where
algos :: [(String, WrappedAlgo Int ())]
algos = [ ("introsort", WrapAlgo INT.sort)
, ("insertion sort", WrapAlgo INS.sort)
, ("merge sort", WrapAlgo M.sort)
, ("heapsort", WrapAlgo H.sort)
, ("timsort", WrapAlgo T.sort)
]
check_Int_sortUniq = forM_ algos $ \(name,algo) ->
quickCheckWith args (label name . prop_full_sortUniq (unWrapMonoAlgo algo))
where
algos :: [(String, WrappedMonoAlgo Int (Vector Int))]
algos = [ ("intro_sortUniq", MonoAlgo (runFreeze INT.sortUniq))
, ("insertion sortUniq", MonoAlgo (runFreeze INS.sortUniq))
, ("merge sortUniq", MonoAlgo (runFreeze M.sortUniq))
, ("heap_sortUniq", MonoAlgo (runFreeze H.sortUniq))
, ("tim_sortUniq", MonoAlgo (runFreeze T.sortUniq))
]
check_Int_partialsort = forM_ algos $ \(name,algo) ->
quickCheckWith args (label name . prop_partialsort (unWrapSizeAlgo algo))
where
algos :: [(String, WrappedSizeAlgo Int ())]
algos = [ ("intro-partialsort", WrapSizeAlgo INT.partialSort)
, ("heap partialsort", WrapSizeAlgo H.partialSort)
]
check_Int_select = forM_ algos $ \(name,algo) ->
quickCheckWith args (label name . prop_select (unWrapSizeAlgo algo))
where
algos :: [(String, WrappedSizeAlgo Int ())]
algos = [ ("intro-select", WrapSizeAlgo INT.select)
, ("heap select", WrapSizeAlgo H.select)
]
check_nub = quickCheckWith args (label "nub Int" . (prop_nub @Int))
check_radix_sorts = do
qc (label "radix Word8" . prop_fullsort (R.sort :: Algo Word8 ()))
qc (label "radix Word16" . prop_fullsort (R.sort :: Algo Word16 ()))
qc (label "radix Word32" . prop_fullsort (R.sort :: Algo Word32 ()))
qc (label "radix Word64" . prop_fullsort (R.sort :: Algo Word64 ()))
qc (label "radix Word" . prop_fullsort (R.sort :: Algo Word ()))
qc (label "radix Int8" . prop_fullsort (R.sort :: Algo Int8 ()))
qc (label "radix Int16" . prop_fullsort (R.sort :: Algo Int16 ()))
qc (label "radix Int32" . prop_fullsort (R.sort :: Algo Int32 ()))
qc (label "radix Int64" . prop_fullsort (R.sort :: Algo Int64 ()))
qc (label "radix Int" . prop_fullsort (R.sort :: Algo Int ()))
qc (label "radix (Int, Int)" . prop_fullsort (R.sort :: Algo (Int, Int) ()))
qc (label "flag Word8" . prop_fullsort (AF.sort :: Algo Word8 ()))
qc (label "flag Word16" . prop_fullsort (AF.sort :: Algo Word16 ()))
qc (label "flag Word32" . prop_fullsort (AF.sort :: Algo Word32 ()))
qc (label "flag Word64" . prop_fullsort (AF.sort :: Algo Word64 ()))
qc (label "flag Word" . prop_fullsort (AF.sort :: Algo Word ()))
qc (label "flag Int8" . prop_fullsort (AF.sort :: Algo Int8 ()))
qc (label "flag Int16" . prop_fullsort (AF.sort :: Algo Int16 ()))
qc (label "flag Int32" . prop_fullsort (AF.sort :: Algo Int32 ()))
qc (label "flag Int64" . prop_fullsort (AF.sort :: Algo Int64 ()))
qc (label "flag Int" . prop_fullsort (AF.sort :: Algo Int ()))
qc (label "flag ByteString" . prop_fullsort (AF.sort :: Algo B.ByteString ()))
where
qc algo = quickCheckWith args algo
{-
check_schwartzian = do
quickCheckWith args (prop_schwartzian i2w INS.sortBy)
where
i2w :: Int -> Word
i2w = fromIntegral
-}
check_stable = do quickCheckWith args (label "merge sort" . prop_stable M.sortBy)
quickCheckWith args (label "radix sort" . prop_stable_radix R.sortBy)
quickCheckWith args (label "tim sort" . prop_stable T.sortBy)
check_optimal = do qc . label "size 2" $ prop_optimal 2 O.sort2ByOffset
qc . label "size 3" $ prop_optimal 3 O.sort3ByOffset
qc . label "size 4" $ prop_optimal 4 O.sort4ByOffset
where
qc = quickCheck
check_permutation = do
qc $ label "introsort" . prop_permutation (INT.sort :: Algo Int ())
qc $ label "heapsort" . prop_permutation (H.sort :: Algo 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 ())
qc $ label "radix I16" . prop_permutation (R.sort :: Algo Int16 ())
qc $ label "radix I32" . prop_permutation (R.sort :: Algo Int32 ())
qc $ label "radix I64" . prop_permutation (R.sort :: Algo Int64 ())
qc $ label "radix Int" . prop_permutation (R.sort :: Algo Int ())
qc $ label "radix W8" . prop_permutation (R.sort :: Algo Word8 ())
qc $ label "radix W16" . prop_permutation (R.sort :: Algo Word16 ())
qc $ label "radix W32" . prop_permutation (R.sort :: Algo Word32 ())
qc $ label "radix W64" . prop_permutation (R.sort :: Algo Word64 ())
qc $ label "radix Word" . prop_permutation (R.sort :: Algo Word ())
qc $ label "flag I8" . prop_permutation (AF.sort :: Algo Int8 ())
qc $ label "flag I16" . prop_permutation (AF.sort :: Algo Int16 ())
qc $ label "flag I32" . prop_permutation (AF.sort :: Algo Int32 ())
qc $ label "flag I64" . prop_permutation (AF.sort :: Algo Int64 ())
qc $ label "flag Int" . prop_permutation (AF.sort :: Algo Int ())
qc $ label "flag W8" . prop_permutation (AF.sort :: Algo Word8 ())
qc $ label "flag W16" . prop_permutation (AF.sort :: Algo Word16 ())
qc $ label "flag W32" . prop_permutation (AF.sort :: Algo Word32 ())
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 (\x -> const (prop_permutation x))
(INT.partialSort :: SizeAlgo Int ())
qc $ label "introselect" . prop_sized (\x -> const (prop_permutation x))
(INT.select :: SizeAlgo Int ())
qc $ label "heappartial" . prop_sized (\x -> const (prop_permutation x))
(H.partialSort :: SizeAlgo Int ())
qc $ label "heapselect" . prop_sized (\x -> const (prop_permutation x))
(H.select :: SizeAlgo Int ())
where
qc prop = quickCheckWith args prop
check_corners = do
qc "introsort empty" $ prop_empty (INT.sort :: Algo Int ())
qc "intropartial empty" $ prop_sized_empty (INT.partialSort :: SizeAlgo Int ())
qc "introselect empty" $ prop_sized_empty (INT.select :: SizeAlgo Int ())
qc "heapsort empty" $ prop_empty (H.sort :: Algo Int ())
qc "heappartial empty" $ prop_sized_empty (H.partialSort :: SizeAlgo Int ())
qc "heapselect empty" $ prop_sized_empty (H.select :: SizeAlgo Int ())
qc "mergesort empty" $ prop_empty (M.sort :: Algo Int ())
qc "timsort empty" $ prop_empty (T.sort :: Algo Int ())
qc "radixsort empty" $ prop_empty (R.sort :: Algo Int ())
qc "flagsort empty" $ prop_empty (AF.sort :: Algo Int ())
where
qc s prop = quickCheckWith (stdArgs { maxSuccess = 2 }) (label s prop)
type SAlgo e r = forall s mv. MVector mv e => mv s e -> e -> ST s r
type BoundSAlgo e r = forall s mv. MVector mv e => mv s e -> e -> Int -> Int -> ST s r
check_search_range = do
qc $ (label "binarySearchL" .)
. prop_search_inrange (SR.binarySearchLByBounds compare :: BoundSAlgo Int Int)
qc $ (label "binarySearchL lo-bound" .)
. prop_search_lowbound (SR.binarySearchL :: SAlgo Int Int)
qc $ (label "binarySearch" .)
. prop_search_inrange (SR.binarySearchByBounds compare :: BoundSAlgo Int Int)
qc $ (label "binarySearchR" .)
. prop_search_inrange (SR.binarySearchRByBounds compare :: BoundSAlgo Int Int)
qc $ (label "binarySearchR hi-bound" .)
. prop_search_upbound (SR.binarySearchR :: SAlgo Int Int)
where
qc prop = quickCheckWith args prop
main = do putStrLn "Int tests:"
check_Int_sort
check_Int_sortUniq
check_Int_partialsort
check_Int_select
putStrLn "Radix sort tests:"
check_radix_sorts
-- putStrLn "Schwartzian transform (Int -> Word):"
-- check_schwartzian
putStrLn "Stability:"
check_stable
putStrLn "Optimals:"
check_optimal
putStrLn "Permutation:"
check_permutation
putStrLn "Search in range:"
check_search_range
putStrLn "Corner cases:"
check_corners
putStrLn "Algorithms:"
check_nub
|
