module ADP.Fusion.QuickCheck where
import Control.Monad
import Control.Applicative
import Data.Array.Repa.Index
import Data.Array.Repa.Shape
import Data.Array.Repa.Arbitrary
import Debug.Trace
import qualified Data.Vector.Fusion.Stream as S
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import qualified Data.Vector.Unboxed as VU
import Test.QuickCheck
import Test.QuickCheck.All
import Test.QuickCheck.Monadic
import Data.List ((\\))
import System.IO.Unsafe
import Data.Array.Repa.Index.Subword
import Data.Array.Repa.Index.Point
import Data.Array.Repa.Index.Points
import qualified Data.PrimitiveArray as PA
import qualified Data.PrimitiveArray.Zero as PA
import ADP.Fusion
import ADP.Fusion.Table
import ADP.Fusion.Multi
prop_R sw@(Subword (i:.j)) = zs == ls where
zs = id <<< region xs ... S.toList $ sw
ls = [VU.slice i (ji) xs | i>=0, j<=100]
prop_RR sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< region xs % region xs ... S.toList $ sw
ls = [(VU.slice i (ki) xs, VU.slice k (jk) xs) | k <- [i..j]]
prop_RRR sw@(Subword (i:.j)) = (ji<=30) ==> zs == ls where
zs = (,,) <<< region xs % region xs % region xs ... S.toList $ sw
ls = [ ( VU.slice i (ki) xs
, VU.slice k (lk) xs
, VU.slice l (jl) xs
) | k <- [i..j], l <- [k..j]]
prop_SSS sw@(Subword (i:.j)) = zs == ls where
zs = (,,) <<< sregion 3 10 xs % sregion 3 10 xs % sregion 3 10 xs ... S.toList $ sw
ls = [ ( VU.slice i (ki) xs
, VU.slice k (lk) xs
, VU.slice l (jl) xs
) | k <- [i..j], l <- [k..j], minimum [ki,lk,jl] >=3, maximum [ki,lk,jl] <= 10]
prop_C sw@(Subword (i:.j)) = zs == ls where
zs = id <<< chr xs ... S.toList $ sw
ls = [xs VU.! i | i+1==j, i>=0, j<=100]
prop_CC sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< chr xs % chr xs ... S.toList $ sw
ls = [(xs VU.! i, xs VU.! (i+1)) | i+2==j]
prop_PlC sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< peekL xs % chr xs ... S.toList $ sw
ls = [(xs VU.! (j2), xs VU.! (j1)) | j>1, i+1==j]
prop_PrC sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< peekR xs % chr xs ... S.toList $ sw
ls = [(xs VU.! (j1), xs VU.! (j1)) | i+1==j]
prop_CPr sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< chr xs % peekR xs ... S.toList $ sw
ls = [(xs VU.! (j1), xs VU.! j) | i>=0, j<=99,i+1==j]
prop_CPl sw@(Subword (i:.j)) = zs == ls where
zs = (,) <<< chr xs % peekL xs ... S.toList $ sw
ls = [(xs VU.! (j1), xs VU.! (j1)) | i+1==j]
prop_CRC sw@(Subword (i:.j)) = zs == ls
where
zs = (,,) <<< chr xs % region xs % chr xs ... S.toList $ sw
ls = [(xs VU.! i, VU.slice (i+1) (ji2) xs , xs VU.! (j1)) |i+2<=j]
prop_CRRC sw@(Subword (i:.j)) = zs == ls
where
zs = (,,,) <<< chr xs % region xs % region xs % chr xs ... S.toList $ sw
ls = [ ( xs VU.! i
, VU.slice (i+1) (ki1) xs
, VU.slice k (jk1) xs
, xs VU.! (j1)
) | k <- [i+1 .. j1]]
prop_CRCRC sw@(Subword (i:.j)) = zs == ls where
zs = (,,,,) <<< chr xs % region xs % chr xs % region xs % chr xs ... S.toList $ sw
ls = [ ( xs VU.! i
, VU.slice (i+1) (ki1) xs
, xs VU.! k
, VU.slice (k+1) (jk2) xs
, xs VU.! (j1)
) | k <- [i+1 .. j2] ]
prop_Interior1 sw@(Subword (i:.j)) = zs == ls where
zs = (,,) <<< chr xs % peekR xs % sregion 1 5 xs ... S.toList $ sw
ls = [ ( xs VU.! i
, xs VU.! (i+1)
, VU.slice (i+1) (ji1) xs
) | ji>=2, ji<=6
]
prop_Interior2 sw@(Subword (i:.j)) = zs == ls where
zs = (,,,,) <<< chr xs % peekR xs % sregion 1 5 xs % peekR xs % sregion 2 5 xs ... S.toList $ sw
ls = [ ( xs VU.! i
, xs VU.! (i+1)
, VU.slice (i+1) (ki1) xs
, xs VU.! k
, VU.slice k (jk) xs
) | ji>=4, ji<=11, k <- [i+2 .. (min j $ i+6)], jk>=2, jk<=5
]
prop_Interior3 sw@(Subword (i:.j)) = zs == ls where
zs = (,,,,,,) <<< chr xs % peekR xs % sregion 1 5 xs % peekR xs % sregion 2 5 xs % peekL xs % sregion 1 5 xs ... S.toList $ sw
ls = [ ( xs VU.! i
, xs VU.! (i+1)
, VU.slice (i+1) (ki1) xs
, xs VU.! k
, VU.slice k (lk) xs
, xs VU.! (l1)
, VU.slice l (jl) xs
) | i>= 0
, j<= 100
, k <- [i..j]
, l <- [k..j]
, ji>=5, ji<=16
, ki1>=1, ki1<=5
, lk>=2, lk<=5
, jl>=1, jl<=5
]
prop_Interior4 sw@(Subword (i:.j)) = zs == ls where
zs = (,,,,,,,,) <<< chr xs % peekR xs % sregion 1 5 xs % peekR xs % sregion 2 5 xs % peekL xs % sregion 1 5 xs % peekL xs % chr xs ... S.toList $ sw
ls = [ ( xs VU.! i
, xs VU.! (i+1)
, VU.slice (i+1) (ki1) xs
, xs VU.! k
, VU.slice k (lk) xs
, xs VU.! (l1)
, VU.slice l (jl1) xs
, xs VU.! (j2)
, xs VU.! (j1)
) | k <- [i..j]
, l <- [k..j]
, ji>=6, ji<=17
, ki1>=1, ki1<=5
, lk>=2, lk<=5
, jl1>=1, jl1<=5
]
prop_Interior5 sw@(Subword (i:.j)) = zs == ls where
zs = (,,,,,,,,,,) <<< peekL xs % chr xs % peekR xs % sregion 1 5 xs % peekR xs % sregion 2 5 xs % peekL xs % sregion 1 5 xs % peekL xs % chr xs % peekR xs ... S.toList $ sw
ls = [ ( xs VU.! (i1)
, xs VU.! i
, xs VU.! (i+1)
, VU.slice (i+1) (ki1) xs
, xs VU.! k
, VU.slice k (lk) xs
, xs VU.! (l1)
, VU.slice l (jl1) xs
, xs VU.! (j2)
, xs VU.! (j1)
, xs VU.! j
) | i>= 1
, j<= 99
, k <- [i..j]
, l <- [k..j]
, i>0, j1 < VU.length xs
, ji>=6, ji<=17
, ki1>=1, ki1<=5
, lk>=2, lk<=5
, jl1>=1, jl1<=5
]
prop_Mt sw@(Subword (i:.j)) = monadicIO $ do
mxs :: PA.MutArr IO (PA.Unboxed (Z:.Subword) Int) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw EmptyT mxs
zs <- run $ id <<< mt ... SM.toList $ sw
ls <- run $ sequence $ [(PA.readM mxs (Z:.sw)) | i<=j]
assert $ zs == ls
prop_MtC sw@(Subword (i:.j)) = monadicIO $ do
mxs :: (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int)) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw EmptyT mxs
zs <- run $ (,) <<< mt % chr xs ... SM.toList $ sw
ls <- run $ sequence $ [(PA.readM mxs (Z:.subword i (j1))) >>= \a -> return (a,xs VU.! (j1)) | i<j]
assert $ zs == ls
prop_CMt sw@(Subword (i:.j)) = monadicIO $ do
mxs :: (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int)) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw EmptyT mxs
zs <- run $ (,) <<< chr xs % mt ... SM.toList $ sw
ls <- run $ sequence $ [(PA.readM mxs (Z:.subword (i+1) j)) >>= \a -> return (xs VU.! i,a) | i<j]
assert $ zs == ls
prop_MtMt sw@(Subword (i:.j)) = monadicIO $ do
mxs :: (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int)) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw EmptyT mxs
zs <- run $ (,) <<< mt % mt ... SM.toList $ sw
ls <- run $ sequence $ [(PA.readM mxs (Z:.subword i k)) >>= \a -> PA.readM mxs (Z:.subword k j) >>= \b -> return (a,b) | k <- [i..j]]
assert $ zs == ls
prop_CMtCMtC sw@(Subword (i:.j)) = monadicIO $ do
mxs :: (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int)) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw EmptyT mxs
zs <- run $ (,,,,) <<< chr xs % mt % chr xs % mt % chr xs ... SM.toList $ sw
ls <- run $ sequence $ [ (PA.readM mxs (Z:.subword (i+1) k)) >>=
\a -> PA.readM mxs (Z:.subword (k+1) (j1)) >>=
\b -> return ( xs VU.! i
, a
, xs VU.! k
, b
, xs VU.! (j1)
)
| k <- [i+1..j2]]
assert $ zs == ls
prop_CMnCMnC sw@(Subword (i:.j)) = monadicIO $ do
mxs :: (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int)) <- run $ PA.fromListM (Z:. Subword (0:.0)) (Z:. Subword (0:.100)) [0 .. ]
let mt = mTblSw NonEmptyT mxs
zs <- run $ (,,,,) <<< chr xs % mt % chr xs % mt % chr xs ... SM.toList $ sw
ls <- run $ sequence $ [ (PA.readM mxs (Z:.subword (i+1) k)) >>=
\a -> PA.readM mxs (Z:.subword (k+1) (j1)) >>=
\b -> return ( xs VU.! i
, a
, xs VU.! k
, b
, xs VU.! (j1)
)
| k <- [i+2..j3]]
assert $ zs == ls
prop_Tc ix@(Z:.Subword(i:.j)) = zs == ls where
zs = id <<< (T:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i) | i>=0, j<= 100, i+1==j ]
prop_Tcc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = zs == ls where
zs = id <<< (T:!chr xs:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i:.xs VU.! k) | i>=0, j<=100, k>=0, j<=100, i+1==j, k+1==l ]
prop_TcTc ix@(Z:.Subword(i:.j)) = zs == ls where
zs = (,) <<< (T:!chr xs) % (T:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i,Z:.xs VU.! (i+1)) | i>=0, j<= 100, i+2==j ]
prop_TccTcc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = zs == ls where
zs = (,) <<< (T:!chr xs:!chr xs) % (T:!chr xs:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i:.xs VU.! k, Z:.xs VU.! (i+1):.xs VU.! (k+1)) | i>=0, j<=100, k>=0, j<=100, i+2==j, k+2==l ]
prop_Mt2 ix@(Z:.Subword(i:.j)) = monadicIO $ do
mxs :: PA.MutArr IO (PA.Unboxed (Z:.Subword) Int) <- run $ PA.fromListM (Z:.subword 0 0) (Z:.subword 0 100) [0 ..]
let mt = mTbl (Z:.EmptyT) mxs
zs <- run $ id <<< mt ... SM.toList $ ix
ls <- run $ sequence $ [ (PA.readM mxs (Z:.subword i j)) | i>=0, j<=100, i<=j ]
assert $ zs == ls
prop_MtMt2 ix@(Z:.Subword(i:.j)) = monadicIO $ do
mxs :: PA.MutArr IO (PA.Unboxed (Z:.Subword) Int) <- run $ PA.fromListM (Z:.subword 0 0) (Z:.subword 0 100) [0 ..]
let mt = mTbl (Z:.EmptyT) mxs
zs <- run $ (,) <<< mt % mt ... SM.toList $ ix
ls <- run $ sequence $ [ liftM2 (,) (PA.readM mxs (Z:.subword i k)) (PA.readM mxs (Z:.subword k j)) | i>=0, j<=100, k<-[i..j] ]
assert $ zs == ls
prop_MtMtMt2 ix@(Z:.Subword(i:.j)) = monadicIO $ do
mxs :: PA.MutArr IO (PA.Unboxed (Z:.Subword) Int) <- run $ PA.fromListM (Z:.subword 0 0) (Z:.subword 0 100) [0 ..]
let mt = mTbl (Z:.EmptyT) mxs
zs <- run $ (,,) <<< mt % mt % mt ... SM.toList $ ix
ls <- run $ sequence $ [ liftM3 (,,) (PA.readM mxs (Z:.subword i k)) (PA.readM mxs (Z:.subword k l)) (PA.readM mxs (Z:.subword l j)) | i>=0, j<=100, k<-[i..j], l<-[k..j] ]
assert $ zs == ls
prop_TcMtTc ix@(Z:.Subword(i:.j)) = monadicIO $ do
mxs :: PA.MutArr IO (PA.Unboxed (Z:.Subword) Int) <- run $ PA.fromListM (Z:.subword 0 0) (Z:.subword 0 100) [0 ..]
let mt = mTbl (Z:.EmptyT) mxs :: MTbl (Z:.Subword) (PA.MutArr IO (PA.Unboxed (Z:.Subword) Int))
zs <- run $ (,,) <<< (T:!chr xs) % mt % (T:!chr xs) ... SM.toList $ ix
ls <- run $ sequence $ [ (PA.readM mxs (Z:.subword (i+1) (j1)) >>= \z -> return (Z:.xs VU.! i,z,Z:.xs VU.! (j1))) | i>=0, j<=100, i+2<=j ]
assert $ zs == ls
prop_2dim ix@(Z:.TinySubword(i:.j):.TinySubword(k:.l)) = monadicIO $ do
mxs <- run $ pure $ mxsSwSw
let mt = mTbl (Z:.EmptyT:.EmptyT) mxs
zs <- run $ (,) <<< mt % mt ... SM.toList $ Z:.subword i j:.subword k l
ls <- run $ sequence $ [ liftM2 (,) (PA.readM mxs (Z:.subword i a:.subword k b)) (PA.readM mxs (Z:.subword a j:.subword b l)) | i>=0, j<=100, k>=0, l<=100, a<-[i..j], b<-[k..l] ]
assert $ zs==ls
prop_2dimCMCMC ix@(Z:.TinySubword(i:.j):.TinySubword(k:.l)) = monadicIO $ do
mxs <- run $ pure $ mxsSwSw
let mt = mTbl (Z:.EmptyT:.EmptyT) mxs
zs <- run $ (,,,,) <<< (T:!chr xs:!chr xs) % mt % (T:!chr xs:!chr xs) % mt % (T:!chr xs:!chr xs) ... SM.toList $ Z:.subword i j:.subword k l
ls <- run $ sequence $ [ liftM5 (,,,,) (pure $ Z:.xs VU.! i:.xs VU.! k)
(PA.readM mxs (Z:.subword (i+1) a:.subword (k+1) b))
(pure $ Z:.xs VU.! a:.xs VU.! b)
(PA.readM mxs (Z:.subword (a+1) (j1):.subword (b+1) (l1)))
(pure $ Z:.xs VU.! (j1):.xs VU.! (l1))
| ji>=3, lk>=3, i>=0, j<=100, k>=0, l<=100, a<-[i+1..j2], b<-[k+1..l2] ]
assert $ zs==ls
prop_P_Tt ix@(Z:.PointL (i:.j)) = zs == ls where
zs = id <<< (T:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i) | i+1==j ]
prop_P_CC ix@(Z:.PointL (i:.j)) = zs == ls where
zs = (,) <<< (T:!chr xs) % (T:!chr xs) ... S.toList $ ix
ls = [ (Z:.xs VU.! i, Z:.xs VU.! (i+1)) | i+2==j ]
prop_P_2dimCMCMC ix@(Z:.PointL(i:.j):.PointL(k:.l)) = monadicIO $ do
mxs <- run $ pure $ mxsPP
let mt = mTbl (Z:.EmptyT:.EmptyT) mxs
zs <- run $ (,,,,) <<< (T:!chr xs:!chr xs) % mt % (T:!chr xs:!chr xs) % mt % (T:!chr xs:!chr xs) ... SM.toList $ ix
ls <- run $ sequence $ [ liftM5 (,,,,) (pure $ Z:.xs VU.! i:.xs VU.! k)
(PA.readM mxs (Z:.pointL (i+1) a:.pointL (k+1) b))
(pure $ Z:.xs VU.! a:.xs VU.! b)
(PA.readM mxs (Z:.pointL (a+1) (j1):.pointL (b+1) (l1)))
(pure $ Z:.xs VU.! (j1):.xs VU.! (l1))
| ji>=3, lk>=3, i>=0, j<=100, k>=0, l<=100, a<-[i+1..j2], b<-[k+1..l2] ]
assert $ zs==ls
xs = VU.fromList [0 .. 99 :: Int]
mxsSwSw = unsafePerformIO $ zzz where
zzz :: IO (PA.MutArr IO (PA.Unboxed (Z:.Subword:.Subword) Int))
zzz = PA.fromListM (Z:.subword 0 0:.subword 0 0) (Z:.subword 0 100:.subword 0 100) [0 ..]
mxsPP = unsafePerformIO $ zzz where
zzz :: IO (PA.MutArr IO (PA.Unboxed (Z:.PointL:.PointL) Int))
zzz = PA.fromListM (Z:.pointL 0 0:.pointL 0 0) (Z:.pointL 0 100:.pointL 0 100) [0 ..]
options = stdArgs {maxSuccess = 1000}
customCheck = quickCheckWithResult options
allProps = $forAllProperties customCheck
newtype Small = Small Int
deriving (Show)
instance Arbitrary Small where
arbitrary = Small <$> choose (0,100)
shrink (Small i) = Small <$> shrink i
newtype TinySubword = TinySubword (Int:.Int)
deriving (Show)
instance Arbitrary TinySubword where
arbitrary = do a <- choose (0,20)
b <- choose (0,20)
return $ TinySubword $ min a b :. max a b
shrink (TinySubword (a:.b)) = [TinySubword (a:.b1) | a<b]
instance Arbitrary z => Arbitrary (z:.TinySubword) where
arbitrary = (:.) <$> arbitrary <*> arbitrary
shrink (z:.s) = (:.) <$> shrink z <*> shrink s