module Futhark.IR.Prop.RearrangeTests (tests) where

import Control.Applicative
import Futhark.IR.Prop.Rearrange
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Prelude

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"RearrangeTests" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    [TestTree]
isMapTransposeTests
      [TestTree] -> [TestTree] -> [TestTree]
forall a. [a] -> [a] -> [a]
++ [TestTree
isMapTransposeProp]

isMapTransposeTests :: [TestTree]
isMapTransposeTests :: [TestTree]
isMapTransposeTests =
  [ TestName -> Assertion -> TestTree
testCase ([TestName] -> TestName
unwords [TestName
"isMapTranspose", [Int] -> TestName
forall a. Show a => a -> TestName
show [Int]
perm, TestName
"==", Maybe (Int, Int, Int) -> TestName
forall a. Show a => a -> TestName
show Maybe (Int, Int, Int)
dres]) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
      [Int] -> Maybe (Int, Int, Int)
isMapTranspose [Int]
perm Maybe (Int, Int, Int) -> Maybe (Int, Int, Int) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe (Int, Int, Int)
dres
    | ([Int]
perm, Maybe (Int, Int, Int)
dres) <-
        [ ([Int
0, Int
1, Int
4, Int
5, Int
2, Int
3], (Int, Int, Int) -> Maybe (Int, Int, Int)
forall a. a -> Maybe a
Just (Int
2, Int
2, Int
2)),
          ([Int
1, Int
0, Int
4, Int
5, Int
2, Int
3], Maybe (Int, Int, Int)
forall a. Maybe a
Nothing),
          ([Int
1, Int
0], (Int, Int, Int) -> Maybe (Int, Int, Int)
forall a. a -> Maybe a
Just (Int
0, Int
1, Int
1)),
          ([Int
0, Int
2, Int
1], (Int, Int, Int) -> Maybe (Int, Int, Int)
forall a. a -> Maybe a
Just (Int
1, Int
1, Int
1)),
          ([Int
0, Int
1, Int
2], Maybe (Int, Int, Int)
forall a. Maybe a
Nothing),
          ([Int
1, Int
0, Int
2], Maybe (Int, Int, Int)
forall a. Maybe a
Nothing)
        ]
  ]

newtype Permutation = Permutation [Int]
  deriving (Permutation -> Permutation -> Bool
(Permutation -> Permutation -> Bool)
-> (Permutation -> Permutation -> Bool) -> Eq Permutation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permutation -> Permutation -> Bool
== :: Permutation -> Permutation -> Bool
$c/= :: Permutation -> Permutation -> Bool
/= :: Permutation -> Permutation -> Bool
Eq, Eq Permutation
Eq Permutation =>
(Permutation -> Permutation -> Ordering)
-> (Permutation -> Permutation -> Bool)
-> (Permutation -> Permutation -> Bool)
-> (Permutation -> Permutation -> Bool)
-> (Permutation -> Permutation -> Bool)
-> (Permutation -> Permutation -> Permutation)
-> (Permutation -> Permutation -> Permutation)
-> Ord Permutation
Permutation -> Permutation -> Bool
Permutation -> Permutation -> Ordering
Permutation -> Permutation -> Permutation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Permutation -> Permutation -> Ordering
compare :: Permutation -> Permutation -> Ordering
$c< :: Permutation -> Permutation -> Bool
< :: Permutation -> Permutation -> Bool
$c<= :: Permutation -> Permutation -> Bool
<= :: Permutation -> Permutation -> Bool
$c> :: Permutation -> Permutation -> Bool
> :: Permutation -> Permutation -> Bool
$c>= :: Permutation -> Permutation -> Bool
>= :: Permutation -> Permutation -> Bool
$cmax :: Permutation -> Permutation -> Permutation
max :: Permutation -> Permutation -> Permutation
$cmin :: Permutation -> Permutation -> Permutation
min :: Permutation -> Permutation -> Permutation
Ord, Int -> Permutation -> ShowS
[Permutation] -> ShowS
Permutation -> TestName
(Int -> Permutation -> ShowS)
-> (Permutation -> TestName)
-> ([Permutation] -> ShowS)
-> Show Permutation
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permutation -> ShowS
showsPrec :: Int -> Permutation -> ShowS
$cshow :: Permutation -> TestName
show :: Permutation -> TestName
$cshowList :: [Permutation] -> ShowS
showList :: [Permutation] -> ShowS
Show)

instance Arbitrary Permutation where
  arbitrary :: Gen Permutation
arbitrary = do
    Positive Int
n <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    [Int] -> Permutation
Permutation ([Int] -> Permutation) -> Gen [Int] -> Gen Permutation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Gen [Int]
forall a. [a] -> Gen [a]
shuffle [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

isMapTransposeProp :: TestTree
isMapTransposeProp :: TestTree
isMapTransposeProp = TestName -> (Permutation -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"isMapTranspose corresponds to a map of transpose" Permutation -> Bool
prop
  where
    prop :: Permutation -> Bool
    prop :: Permutation -> Bool
prop (Permutation [Int]
perm) =
      case [Int] -> Maybe (Int, Int, Int)
isMapTranspose [Int]
perm of
        Maybe (Int, Int, Int)
Nothing -> Bool
True
        Just (Int
r1, Int
r2, Int
r3) ->
          [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0,
              Int
r2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0,
              Int
r3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0,
              Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
perm,
              let ([Int]
mapped, [Int]
notmapped) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
r1 [Int]
perm
                  ([Int]
pretrans, [Int]
posttrans) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
r2 [Int]
notmapped
               in [Int]
mapped [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
posttrans [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
pretrans [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
0 .. [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
perm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]