dph-lifted-vseg: fix edge case in concatl when the last segment is empty
[packages/dph.git] / dph-test / test / PData / PRFuns.hs
1 {-# LANGUAGE UndecidableInstances #-}
2
3 import DPH.Arbitrary
4 import DPH.Testsuite
5
6 import Data.Array.Parallel.Base (Tag)
7 import Data.Array.Parallel.Pretty
8 import Data.Array.Parallel.PArray (PA)
9 import Data.Array.Parallel.PArray.PData (PArray(..), PData, PDatas, PR(..))
10 import Data.Array.Parallel.PArray.PData.Base ()
11
12 import Data.Array.Parallel.PArray.PData.Nested
13 ( concatPR, concatlPR
14 , unconcatPR
15 , appendlPR
16 , unsafeFlattenPR)
17
18 import Text.PrettyPrint as T
19 import GHC.Exts
20 import Control.Monad
21 import Data.Vector (Vector)
22 import Prelude as P
23 import qualified Data.Vector as V
24 import qualified Data.Array.Parallel.Unlifted as U
25 import qualified Data.Array.Parallel.PArray as PA
26 import qualified DPH.Operators.List as L
27
28 -- NOTE:
29 -- The 'b' element type contains one less level of nesting compared with the
30 -- 'a' type. We use 'b' when we're checking properties of functions that
31 -- already require nested arrays, such as "concat".
32
33 {-
34 $(testcases [ "" <@ [t| ( Int, PArray Int, PArray (PArray Int)
35 , (), PArray ()
36 , (Int, Int), PArray (Int, Int), PArray (PArray Int, PArray Int)) |]
37
38 , "b" <@ [t| ( Int, PArray Int ) |]
39 ]
40 -}
41
42
43 $(testcases [ "" <@ [t| PArray Int |]
44 , "b" <@ [t| PArray Int |]
45 , "c" <@ [t| Int |]
46 ]
47
48 [d|
49 -- PR Dictionary functions --------------------------------------------------
50 -- All the functions defined in the PR dictionary should be tested in this
51 -- section. The functions appear in the same order as in the class
52
53
54 -- Converting arrays to and from lists.
55 -- * If this doesn't work then we'll be generating invalid arbitrary arrays
56 -- for subsequent tests.
57 -- * Note that converting a nested array to and from a list is more involved
58 -- than converting a flat array, as we need to construct segment descriptors.
59 prop_toFromVector :: (PR a, Eq a) => Vector a -> Bool
60 prop_toFromVector vec
61 = let arr = fromVectorPR vec
62 in validPR arr
63 && vec == toVectorPR arr
64
65
66 -- | Check that the arbitrary arrays we're getting are valid.
67 --- * The arbitrary instance constructs arrays by using other array operators
68 -- so if they're broken the all the subseqent tests will fail as well.
69 prop_valid :: PR a => PData a -> Bool
70 prop_valid pdata
71 = validPR pdata
72
73 {-
74 -- | Define an array that maps all indices to the same element.
75 -- The array size must be > 0.
76 prop_replicate :: (PR a, Eq a) => a -> Property
77 prop_replicate x
78 = forAll (choose (1, 100)) $ \n
79 -> let arr = replicatePR n x
80 in validPR arr
81 && V.replicate n x == toVectorPR arr
82
83
84 -- | Segmented replicate.
85 prop_replicates :: (PR a, Eq a) => Vector a -> Property
86 prop_replicates vec
87 = forAll (liftM V.fromList $ vectorOf (V.length vec) (choose (0, 10))) $ \repCounts
88 -> let vec' = V.concat $ V.toList
89 $ V.zipWith V.replicate repCounts vec
90
91 segd = U.lengthsToSegd $ U.fromList $ V.toList repCounts
92 arr' = replicatesPR segd (fromVectorPR vec)
93 in validPR arr'
94 && vec' == toVectorPR arr'
95
96
97 -- | Take a single element from an array.
98 prop_index :: (PR a, Eq a) => PData a -> Property
99 prop_index pdata
100 = lengthPR pdata > 0
101 ==> forAll (choose (0, lengthPR pdata - 1)) $ \ix
102 -> toVectorPR pdata V.! ix
103 == indexPR pdata ix
104
105
106 ---------------------------------------------------------
107 -- TODO: indexl
108 ---------------------------------------------------------
109
110
111 -- | Extract a single slice from a single array.
112 prop_extract :: (PR a, Eq a) => Vector a -> Property
113 prop_extract vec
114 = forAll (arbitrarySliceSpec (V.length vec)) $ \(SliceSpec ixStart lenSlice)
115 -> let vec' = V.slice ixStart lenSlice vec
116 arr' = extractPR (fromVectorPR vec) ixStart lenSlice
117
118 in validPR arr'
119 && vec' == toVectorPR arr'
120
121 prop_extract' :: (PR a, Eq a) => PData a -> Property
122 prop_extract' pdata
123 = forAll (arbitrarySliceSpec (lengthPR pdata)) $ \(SliceSpec ixStart lenSlice)
124 -> let vec' = V.slice ixStart lenSlice (toVectorPR pdata)
125 pdata' = extractPR pdata ixStart lenSlice
126
127 in validPR pdata'
128 && vec' == toVectorPR pdata'
129
130
131 -- | Extract many slices from a single array.
132 prop_extracts1 :: (PR a, Eq a) => PData a -> Property
133 prop_extracts1 pdata
134 = lengthPR pdata > 0
135 ==> forAll (choose (1, 10)) $ \sliceCount
136 -> forAll (replicateM sliceCount (arbitrarySliceSpec1 (lengthPR pdata))) $ \sliceSpecs'
137 -> let sliceSpecs = V.fromList sliceSpecs'
138 lens = V.map sliceSpecLen sliceSpecs
139 starts = V.map sliceSpecStart sliceSpecs
140 sources = V.replicate (V.length sliceSpecs) 0
141
142 vec = toVectorPR pdata
143 vec' = V.concat $ V.toList
144 $ V.zipWith (\len start -> V.slice start len vec)
145 lens
146 starts
147
148 segd = U.lengthsToSegd $ V.convert lens
149 ssegd = U.mkSSegd (V.convert starts) (V.convert sources) segd
150 pdata' = extractsPR (singletondPR pdata) ssegd
151
152 in validPR pdata'
153 && vec' == toVectorPR pdata'
154
155
156 ---------------------------------------------------------
157 -- TODO: extracts_n, extract from multiple vectors
158 ---------------------------------------------------------
159
160
161 -- | Append two arrays.
162 prop_append :: (PR a, Eq a) => Vector a -> Vector a -> Bool
163 prop_append xs ys
164 = let vec' = xs V.++ ys
165 pdata' = fromVectorPR xs `appendPR` fromVectorPR ys
166
167 in validPR pdata'
168 && vec' == toVectorPR pdata'
169
170
171 ---------------------------------------------------------
172 -- TODO: appends, segmented append
173 ---------------------------------------------------------
174
175
176 -- | Filter an array based on some tags.
177 prop_packByTag
178 :: (PR a, Eq a, Arbitrary a, Show a)
179 => Len -> Vector a -> Property
180 prop_packByTag (Len n) zz
181 = forAll (liftM V.fromList $ vectorOf n (choose (0, 1))) $ \tags
182 -> forAll (liftM V.fromList $ vectorOf n arbitrary) $ \vec1
183 -> forAll (choose (0, 1)) $ \tag
184 -> let vec' = V.fromList
185 $ L.packByTag (V.toList $ vec1 `asTypeOf` zz)
186 (V.toList $ (tags :: Vector Tag))
187 tag
188
189 pdata' = packByTagPR (fromVectorPR vec1)
190 (U.fromList $ V.toList tags)
191 tag
192 in validPR pdata'
193 && vec' == toVectorPR pdata'
194
195
196 -- | Combine two arrays based on a selector.
197 prop_combine2
198 :: (PR a, Eq a, Arbitrary a, Show a)
199 => Selector -> Vector a-> Property
200 prop_combine2 (Selector vecTags) zz
201 = V.length vecTags >= 2
202 ==> even (V.length vecTags)
203 ==> forAll (liftM V.fromList $ vectorOf (V.length vecTags `div` 2) arbitrary) $ \vec1
204 -> forAll (liftM V.fromList $ vectorOf (V.length vecTags `div` 2) arbitrary) $ \vec2
205 -> let vec' = V.fromList
206 $ L.combine2 (V.toList vecTags)
207 (V.toList $ vec1 `asTypeOf` zz)
208 (V.toList $ vec2 `asTypeOf` zz)
209
210 sel2 = U.tagsToSel2 (U.fromList $ V.toList vecTags)
211 pdata' = combine2PR sel2 (fromVectorPR vec1) (fromVectorPR vec2)
212
213 in validPR pdata'
214 && vec' == toVectorPR pdata'
215
216
217 -- | Concatenate arrays that have been produced via combine.
218 -- When an nested array has been produced with combine, it's guaranteed to contain
219 -- multiple flat data arrays in its psegdata field. By concatenating it we test
220 -- that extractsPR handles this representation.
221 prop_combine2_concat
222 :: (PR b, PA b, Eq b, Arbitrary b, Show b)
223 => Selector -> Vector (Vector b) -> Property
224 prop_combine2_concat (Selector vecTags) zz
225 = V.length vecTags >= 2
226 ==> even (V.length vecTags)
227 ==> forAll (liftM V.fromList $ vectorOf (V.length vecTags `div` 2) arbitrary) $ \vec1
228 -> forAll (liftM V.fromList $ vectorOf (V.length vecTags `div` 2) arbitrary) $ \vec2
229 -> let vec' = V.fromList
230 $ L.combine2 (V.toList vecTags)
231 (V.toList $ vec1 `asTypeOf` zz)
232 (V.toList $ vec2 `asTypeOf` zz)
233 vec'' = V.concat (V.toList vec')
234
235 sel2 = U.tagsToSel2 (U.fromList $ V.toList vecTags)
236 pdata' = combine2PR sel2
237 (fromVectorPR $ V.map PA.fromVector vec1)
238 (fromVectorPR $ V.map PA.fromVector vec2)
239 pdata'' = concatPR pdata'
240
241 in validPR pdata''
242 && vec'' == toVectorPR pdata''
243
244
245 -- | Packing an array then immediately combining it should yield the original array.
246 prop_combine2_packByTag
247 :: (PR a, Eq a, Arbitrary a, Show a)
248 => Selector -> Vector a -> Property
249 prop_combine2_packByTag (Selector vecTags) zz
250 = V.length vecTags >= 2
251 ==> even (V.length vecTags)
252 ==> forAll (liftM V.fromList $ vectorOf (V.length vecTags) arbitrary) $ \vec
253 -> let
254 uarrTags = U.fromList $ V.toList vecTags
255 sel2 = U.tagsToSel2 uarrTags
256
257 pdata = fromVectorPR (vec `asTypeOf` zz)
258 pdata' = combine2PR sel2
259 (packByTagPR pdata uarrTags 0)
260 (packByTagPR pdata uarrTags 1)
261
262 in validPR pdata'
263 && toVectorPR pdata == toVectorPR pdata'
264
265
266 -- Derived Functions --------------------------------------------------------
267 -- These are PR functions that are not in the PR dictionary.
268 --
269 -}
270 -- | Concatenate arrays
271 prop_concat
272 :: (PR b, PA b, Eq b)
273 => VVector b -> Bool
274 prop_concat (VVector vec)
275 = let vec' = V.concat (V.toList vec)
276
277 pdata = fromVectorPR (V.map PA.fromVector vec)
278 pdata' = concatPR pdata
279
280 in validPR pdata'
281 && vec' == toVectorPR pdata'
282
283
284 -- | Lifted concat
285 prop_concatl
286 :: (PR c, PA c, Eq c)
287 => VVVector c -> Property
288 prop_concatl (VVVector vec)
289 = V.length vec >= 1
290 ==> let vec' = V.map join vec
291
292 pdata = fromVectorPR
293 $ V.map PA.fromVector
294 $ V.map (V.map PA.fromVector) vec
295
296 pdata' = concatlPR pdata
297
298 in validPR pdata'
299 && (V.map PA.fromVector vec') == toVectorPR pdata'
300
301
302 -- | Concat then unconcat
303 prop_concat_unconcat
304 :: (PR b, PA b, Eq b)
305 => VVector b -> Bool
306 prop_concat_unconcat (VVector vec)
307 = let pdata = fromVectorPR $ V.map PA.fromVector vec
308 pdata' = concatPR pdata
309
310 pdata'' = unconcatPR pdata pdata'
311 in validPR pdata''
312 && toVectorPR pdata == toVectorPR pdata''
313
314
315 -- | Lifted append
316 prop_appendl
317 :: (PR b, PA b, Eq b)
318 => VVector b -> VVector b -> Bool
319 prop_appendl (VVector vec1) (VVector vec2)
320 = let -- Ensure both input vectors have the same length,
321 -- which will be the lifting context.
322 len = min (V.length vec1) (V.length vec2)
323 vec1' = V.take len vec1
324 vec2' = V.take len vec2
325
326 -- Lifted append directly on the vectors.
327 vec' = V.map PA.fromVector $ V.zipWith (V.++) vec1' vec2'
328
329 -- Lifted append via a nested array.
330 pdata1 = fromVectorPR (V.map PA.fromVector vec1')
331 pdata2 = fromVectorPR (V.map PA.fromVector vec2')
332 pdata' = appendlPR pdata1 pdata2
333
334 in validPR pdata'
335 && vec' == toVectorPR pdata'
336
337
338 ---------------------------------------------------------
339 -- TODO: slicelPD
340 ---------------------------------------------------------
341
342
343 |])
344
345
346 -- TODO: shift this to D.A.P.BasePretty
347 instance (PprPhysical a, PprPhysical b)
348 => PprPhysical (a, b) where
349 pprp (x, y)
350 = vcat
351 [ text "Tuple2"
352 , T.nest 4 $ pprp x
353 , T.nest 4 $ pprp y]
354
355 -- Arbitrary PArrays ----------------------------------------------------------
356 instance (PprPhysical (PArray a), Arbitrary a, PR a)
357 => Arbitrary (PArray a) where
358 arbitrary
359 = do plan <- arbitrary
360 pdata <- arbitraryPDataFromExp plan
361 return $ wrapPDataAsPArray pdata
362
363
364 -- Arbitrary PData ------------------------------------------------------------
365 instance (PprPhysical (PData a), Arbitrary a, PR a)
366 => Arbitrary (PData a) where
367 arbitrary
368 = do plan <- arbitrary
369 arbitraryPDataFromExp plan
370
371
372 -- Exp ------------------------------------------------------------------------
373 -- | Generate a plan for building an arbitrary array.
374 -- If we create an array directly from a list, then the internal structure
375 -- is simpler than if it had been constructed by appending or concatenating
376 -- several other arrays. In our tests, we want to use arrays with complicated
377 -- internal structure, as these have more change of showing up bugs.
378 --
379 -- We split the plan generation from the actual array, so we can check
380 -- that the plan is covering the cases we want. We want arrays to be build
381 -- from a good mixture of different operators.
382 --
383 data Exp a
384 -- Generate a flat array of the given size.
385 = XArbitrary Int
386
387 -- Append two arbitrary arrays.
388 | XAppend (Exp a) (Exp a)
389
390 -- Concatenate a list of arbitrary arrays.
391 | XConcat [Exp a]
392
393 deriving instance
394 (Show a, Show (PData a), Show (PDatas a))
395 => Show (Exp a)
396
397 instance Arbitrary (Exp a) where
398 arbitrary
399 = sized $ \s ->
400 let aFlat
401 = do n <- choose (0, s)
402 return (XArbitrary n)
403
404 aAppend
405 = do liftM2 XAppend
406 (resize (s `div` 2) arbitrary)
407 (resize (s `div` 2) arbitrary)
408
409 aConcat
410 = do n <- choose (1, min 5 s)
411 liftM XConcat
412 (vectorOf n $ resize (s `div` n) arbitrary)
413
414 in -- If the size is small then just use a flat arary without invoking a
415 -- more complex operator. This allows our properties to test those
416 -- operators in isolation, before the array structure gets too
417 -- complicated.
418 if s <= 10
419 then aFlat
420 else oneof [aFlat, aAppend, aConcat]
421
422
423 -- | Generate some PData by using the operators described by the given plan.
424 arbitraryPDataFromExp :: (Arbitrary a, PR a) => Exp a -> Gen (PData a)
425 arbitraryPDataFromExp xx
426 = sized $ \s ->
427 case xx of
428 XArbitrary n
429 -> arbitraryFlatPData
430
431 XAppend exp1 exp2
432 -> do pdata1 <- arbitraryPDataFromExp exp1
433 pdata2 <- arbitraryPDataFromExp exp2
434 return $ appendPR pdata1 pdata2
435
436 XConcat exps
437 -> do pdatas <- mapM arbitraryPDataFromExp exps
438
439 return $ concatPR
440 $ fromVectorPR $ V.fromList
441 $ map wrapPDataAsPArray pdatas
442
443
444 -- | Generate an arbitrary PData just by converting a list.
445 -- The internal representation will only contain a single physical vector.
446 arbitraryFlatPData :: (Arbitrary a, PR a) => Gen (PData a)
447 arbitraryFlatPData
448 = sized $ \s
449 -> do xs <- resize (truncate $ (\x -> sqrt x * 2 ) $ fromIntegral s)
450 $ arbitrary
451
452 return $ fromVectorPR xs
453
454
455 wrapPDataAsPArray :: PR a => PData a -> PArray a
456 wrapPDataAsPArray pdata
457 = let !(I# n#) = lengthPR pdata
458 in PArray n# pdata