exp-pairs-0.1.4.0: tests/LinearForm.hs

{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module LinearForm where

import Data.Ratio

import Math.ExpPairs.LinearForm
import Math.ExpPairs.RatioInf

import Test.Tasty
import Test.Tasty.SmallCheck as SC
import Test.Tasty.QuickCheck as QC

import Instances ()

extractCoeffs :: Num t => LinearForm t -> (t, t, t)
extractCoeffs lf =
  ( evalLF (1, 0, 0) lf
  , evalLF (0, 1, 0) lf
  , evalLF (0, 0, 1) lf
  )

testPlus :: Rational -> Rational -> Rational -> Rational -> Rational -> Rational -> Bool
testPlus a b c d e f = a+d==ad && b+e==be && c+f==cf where
  l1 = LinearForm a b c
  l2 = LinearForm d e f
  (ad, be, cf) = extractCoeffs (l1 + l2)

testMinus :: Rational -> Rational -> Rational -> Rational -> Rational -> Rational -> Bool
testMinus a b c d e f = a-d==ad && b-e==be && c-f==cf where
  l1 = LinearForm a b c
  l2 = LinearForm d e f
  (ad, be, cf) = extractCoeffs (l1 - l2)

testFromInteger :: Integer -> Bool
testFromInteger a = evalLF (0, 0, 1) (fromInteger a) == a

testSubstitute1 :: LinearForm Rational -> Bool
testSubstitute1 a
  =  substituteLF (a, 0, 0) (LinearForm 1 0 0) == a
  && substituteLF (0, a, 0) (LinearForm 0 1 0) == a
  && substituteLF (0, 0, a) (LinearForm 0 0 1) == a

testSubstitute2 :: LinearForm Rational -> LinearForm Rational
                -> LinearForm Rational -> LinearForm Rational
                -> LinearForm Rational -> LinearForm Rational
                -> LinearForm Rational -> Bool
testSubstitute2 a1 a2 b1 b2 c1 c2 lf
  =  substituteLF (a1 + a2, b1 + b2, c1 + c2) lf
  == substituteLF (a1, b1, c1) lf + substituteLF (a2, b2, c2) lf

testNegateRF :: RationalForm Rational -> Integer -> Integer -> Integer -> Bool
testNegateRF rf k l m = case evalRF (k, l, m) rf of
  x@Finite{} -> x == negate (evalRF (k, l, m) (negate rf))
  _          -> True

testNegateVarsRF :: RationalForm Rational -> Integer -> Integer -> Integer -> Bool
testNegateVarsRF rf k l m =
  evalRF (k, l, m) rf == evalRF (-k, -l, -m) rf

testFromIntegerRF :: Integer -> Bool
testFromIntegerRF a = evalRF (0, 0, 1) (fromInteger a) == Finite (a % 1)

testCheckConstraint :: Integer -> Integer -> Integer -> Constraint Rational -> Bool
testCheckConstraint k l m c@(Constraint lf ineq)
  =  (ineq==Strict    && isZero || x || y)
  && (ineq==NonStrict && isZero || not (x && y))
  where
    x = checkConstraint (k, l, m) c
    y = checkConstraint (k, l, m) (Constraint (negate lf) ineq)
    isZero = evalLF (fromInteger k, fromInteger l, fromInteger m) lf == 0

testSuite :: TestTree
testSuite = testGroup "LinearForm"
  [ QC.testProperty "plus" testPlus
  , QC.testProperty "minus" testMinus
  , SC.testProperty "from integer LF" testFromInteger
  , QC.testProperty "from integer LF" testFromInteger
  , QC.testProperty "substitute component" testSubstitute1
  , QC.testProperty "substitution is linear" testSubstitute2
  , QC.testProperty "negate RF" testNegateRF
  , QC.testProperty "negate vars RF" testNegateVarsRF
  , SC.testProperty "from integer RF" testFromIntegerRF
  , QC.testProperty "from integer RF" testFromIntegerRF
  , QC.testProperty "constraint" testCheckConstraint
  ]