Merge branch 'master' into mvecsReplicate

1 files changed, 62 insertions, 16 deletions

diff --git a/test/Tests/C.hs b/test/Tests/C.hs
index 8703957..2d35cd9 100644
--- a/test/Tests/C.hs
+++ b/test/Tests/C.hs
@@ -44,8 +44,8 @@ fineTol = 1e-8
 debugCoverage :: Bool
 debugCoverage = False
 
-prop_sum_nonempty :: Property
-prop_sum_nonempty = property $ genRank $ \outrank@(SNat @n) -> do
+gen_red_nonempty :: (forall n. SNat (n + 1) -> SNat n -> OR.Array (n + 1) Double -> PropertyT IO ()) -> Property
+gen_red_nonempty f = property $ genRank $ \outrank@(SNat @n) -> do
   -- Test nonempty _results_. The first dimension of the input is allowed to be 0, because then OR.rerank doesn't fail yet.
   let inrank = SNat @(n + 1)
   sh <- forAll $ genShR inrank
@@ -54,11 +54,10 @@ prop_sum_nonempty = property $ genRank $ \outrank@(SNat @n) -> do
   arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList sh) <$>
            genStorables (Range.singleton (shrSize sh))
                         (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
-  let rarr = rfromOrthotope inrank arr
-  almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
+  f inrank outrank arr
 
-prop_sum_empty :: Property
-prop_sum_empty = property $ genRank $ \outrankm1@(SNat @nm1) -> do
+gen_red_empty :: (forall n. SNat (n + 1) -> OR.Array (n + 1) Double -> PropertyT IO ()) -> Property
+gen_red_empty f = property $ genRank $ \outrankm1@(SNat @nm1) -> do
   -- We only need to test shapes where the _result_ is empty; the rest is handled by 'random nonempty' above.
   _outrank :: SNat n <- return $ SNat @(nm1 + 1)
   let inrank = SNat @(n + 1)
@@ -70,11 +69,10 @@ prop_sum_empty = property $ genRank $ \outrankm1@(SNat @nm1) -> do
   guard (0 `elem` (shrToList $ shrTail sh))
   -- traceM ("sh: " ++ show sh ++ " -> " ++ show (shrSize sh))
   let arr = OR.fromList @(n + 1) @Double (shrToList sh) []
-  let rarr = rfromOrthotope inrank arr
-  OR.toList (rtoOrthotope (rsumOuter1Prim rarr)) === []
+  f inrank arr
 
-prop_sum_lasteq1 :: Property
-prop_sum_lasteq1 = property $ genRank $ \outrank@(SNat @n) -> do
+gen_red_lasteq1 :: (forall n. SNat (n + 1) -> SNat n -> OR.Array (n + 1) Double -> PropertyT IO ()) -> Property
+gen_red_lasteq1 f = property $ genRank $ \outrank@(SNat @n) -> do
   let inrank = SNat @(n + 1)
   outsh <- forAll $ genShR outrank
   guard (all (> 0) $ shrToList outsh)
@@ -82,11 +80,10 @@ prop_sum_lasteq1 = property $ genRank $ \outrank@(SNat @n) -> do
   arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList insh) <$>
            genStorables (Range.singleton (shrSize insh))
                         (\w -> fromIntegral w / fromIntegral (maxBound :: Word64))
-  let rarr = rfromOrthotope inrank arr
-  almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
+  f inrank outrank arr
 
-prop_sum_replicated :: Bool -> Property
-prop_sum_replicated doTranspose = property $
+gen_red_replicated :: Bool -> (forall n. SNat (n + 1) -> SNat n -> OR.Array (n + 1) Double -> PropertyT IO ()) -> Property
+gen_red_replicated doTranspose f = property $
   genRank $ \inrank1@(SNat @m) ->
   genRank $ \outrank@(SNat @nm1) -> do
     inrank2 :: SNat n <- return $ SNat @(nm1 + 1)
@@ -109,8 +106,50 @@ prop_sum_replicated doTranspose = property $
       if doTranspose then do perm <- forAll $ genPermR (fromSNat' inrank2)
                              return $ OR.transpose perm arr
                      else return arr
-    let rarr = rfromOrthotope inrank2 arrTrans
-    almostEq 1e-8 (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arrTrans)
+    f inrank2 outrank arrTrans
+
+
+prop_sum_nonempty :: Property
+prop_sum_nonempty = gen_red_nonempty $ \inrank outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
+
+prop_sum_empty :: Property
+prop_sum_empty = gen_red_empty $ \inrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  OR.toList (rtoOrthotope (rsumOuter1Prim rarr)) === []
+
+prop_sum_lasteq1 :: Property
+prop_sum_lasteq1 = gen_red_lasteq1 $ \inrank outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
+
+prop_sum_replicated :: Bool -> Property
+prop_sum_replicated doTranspose = gen_red_replicated doTranspose $ \inrank outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq 1e-8 (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr)
+
+
+prop_sumall_nonempty :: Property
+prop_sumall_nonempty = gen_red_nonempty $ \inrank _outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq fineTol (rsumAllPrim rarr) (OR.sumA arr)
+
+prop_sumall_empty :: Property
+prop_sumall_empty = gen_red_empty $ \inrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  rsumAllPrim rarr === 0.0
+
+prop_sumall_lasteq1 :: Property
+prop_sumall_lasteq1 = gen_red_lasteq1 $ \inrank _outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq fineTol (rsumAllPrim rarr) (OR.sumA arr)
+
+prop_sumall_replicated :: Bool -> Property
+prop_sumall_replicated doTranspose = gen_red_replicated doTranspose $ \inrank _outrank arr -> do
+  let rarr = rfromOrthotope inrank arr
+  almostEq 1e-6 (rsumAllPrim rarr) (OR.sumA arr)
+
 
 prop_negate_with :: forall f b. Show b
                  => ((forall n. f n -> SNat n -> PropertyT IO ()) -> PropertyT IO ())
@@ -139,6 +178,13 @@ tests = testGroup "C"
     ,testProperty "replicated" (prop_sum_replicated False)
     ,testProperty "replicated_transposed" (prop_sum_replicated True)
     ]
+  ,testGroup "sumAll"
+    [testProperty "nonempty" prop_sumall_nonempty
+    ,testProperty "empty" prop_sumall_empty
+    ,testProperty "last==1" prop_sumall_lasteq1
+    ,testProperty "replicated" (prop_sumall_replicated False)
+    ,testProperty "replicated_transposed" (prop_sumall_replicated True)
+    ]
   ,testGroup "negate"
     [testProperty "normalised" $ prop_negate_with
         (\k -> genRank (k (Const ())))