multivariant-0.1.0.1: test/Test.hs

{-# LANGUAGE RankNTypes #-}

import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit

import Test.Multivariant.Classes
import Test.Multivariant.Types.Cases
import Test.Multivariant.Types.Solution
--import qualified Task

import Data.Invertible.Bijection
import qualified Data.Invertible.Prelude as Inv
import qualified Data.Set as S

main = defaultMain tests

tests :: TestTree
tests = testGroup "Tests"
  [ solutionTest
  , casesTest
  , taskTest
  ]

alpha' :: Program p => p [[Integer]] [Integer]
alpha' = step (Inv.map $ sum :<->: (\x -> [x-1, 1]))

alpha :: (Program p, WithCornerCases p) => p [[Integer]] [Integer]
alpha = alpha'
        `withCornerCases` ([ [[1,2,3], [4,5,6]]
                           , []
                           ],
                           [ []
                           , [5]
                           ]
                          )

beta' :: Program p => p [Integer] Integer
beta' = step (sum :<->: (\x -> [x,0]))

beta :: (Program p, WithCornerCases p) => p [Integer] Integer
beta = beta'
       `withCornerCases` ([ [0,1,2]
                          , []
                          ],
                          [ 0
                          , 1
                          ]
                         )

gamma' :: (Program p, WithCornerCases p) => p [Integer] Integer
gamma' = step (product :<->: (\x -> [1,x]))

delta' :: (Program p, WithCornerCases p) => p ([Integer], Integer) [Integer]
delta' = step ((\(xs,y) -> map (*y) xs) :<->: (\xs -> (xs,1)))

id' :: (Program p, WithCornerCases p) => p a a
id' = step (id :<->: id)

solutionCasesCompatible :: Eq b
                        => (forall p. (Program p, WithCornerCases p) => p a b)
                        -> Bool
solutionCasesCompatible task = let
  sol = head $ getSolutions task
  cases = head $ getCases task
  in all (\(i,o) -> sol i == o) cases

casesTest :: TestTree
casesTest = testGroup "Cases interpreter"
  [ testCase "Alpha" $
    S.fromList (getCases alpha) @?= S.fromList [[ ([[1,2,3], [4,5,6]], [6,15])
                                                , ([], [])
                                                , ([], [])
                                                , ([[4,1]], [5])
                                                ]]
  , testCase "Beta" $
    S.fromList (getCases beta) @?= S.fromList [[ ([0,1,2], 3)
                                               , ([], 0)
                                               , ([0,0], 0)
                                               , ([1,0], 1)
                                               ]]
  , testCase "Alpha ~> Beta" $
    S.fromList (getCases $ alpha ~> beta) @?=
    S.fromList [[ ([[1,2,3], [4,5,6]], 21)
                , ([], 0)
                , ([], 0)
                , ([[4,1]], 5)
                , ([[-1,1],[0,1],[1,1]], 3)
                , ([], 0)
                , ([[-1,1],[-1,1]],0)
                , ([[0,1],[-1,1]],1)
                ]]
  , testGroup "Output in getCases is equal to getSolution on corresponding input"
    [ QC.testProperty "alpha ~> beta" $
      \(cs1,cs2) -> let task :: (Program p, WithCornerCases p) => p [[Integer]] Integer
                        task = alpha' `withCornerCases` cs1 ~> beta' `withCornerCases` cs2
                    in solutionCasesCompatible task
    , QC.testProperty "alpha ~> gamma" $
      \(cs1,cs2) -> let task :: (Program p, WithCornerCases p) => p [[Integer]] Integer
                        task = alpha' `withCornerCases` cs1 ~> gamma' `withCornerCases` cs2
                    in solutionCasesCompatible task
    , QC.testProperty "(alpha *** id) ~> delta" $
      \(cs1,cs2) -> let task :: (Program p, WithCornerCases p) => p ([[Integer]],Integer) [Integer]
                        task = (alpha' `withCornerCases` cs1 <***> id') ~> delta' `withCornerCases` cs2
                    in solutionCasesCompatible task
    , QC.testProperty "(alpha *** beta) ~> delta" $
      \(cs1,cs2) -> let task :: (Program p, WithCornerCases p) => p ([[Integer]],[Integer]) [Integer]
                        task = (alpha' <***> beta') `withCornerCases` cs1 ~> delta' `withCornerCases` cs2
                    in solutionCasesCompatible task
    ]
  ]

solutionTest :: TestTree
solutionTest = testGroup "Solution interpreter"
  [ testCase "Alpha" $
    map (head $ getSolutions alpha) [ [[1,2,3],[4,5,6]]
                                    , []
                                    , [[1,2],[3]]
                                    ] @?=
    [ [6,15]
    , []
    , [3,3]
    ]
  , testCase "Beta" $
    map (head $ getSolutions beta) [ [6,15]
                                   , []
                                   , [1,2,3]
                                   ] @?=
    [ 21, 0, 6 ]
  , testCase "Alpha ~> Beta" $
    map (head $ getSolutions $ alpha ~> beta) [ [[1,2,3],[4,5,6]]
                                              , []
                                              , [[1,2],[3]]
                                              ] @?=
    [ 21, 0, 6 ]
  ]

taskTest :: TestTree
taskTest = testGroup "Task"
  [ QC.testProperty "alpha" $
    \(i,o) -> let alpha' :: Program p => p [Integer] [Integer]
                  alpha' = step (Inv.map $ (\x -> x+5) :<->: (\x -> x-5))
                  sol = head $ solutions alpha'
              in biFrom sol (biTo sol i) == i && biTo sol (biFrom sol o) == o
  ]