PartialFraction.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Test.MathObj.PartialFraction where

import qualified MathObj.PartialFraction      as PartialFraction
import qualified MathObj.Polynomial           as Poly
import qualified Number.Ratio                 as Ratio

import qualified Algebra.PrincipalIdealDomain as PID
-- import qualified Algebra.Ring                 as Ring
import qualified Algebra.Indexable            as Indexable
import qualified Algebra.Vector               as Vector
-- import Algebra.Vector((*>))

import qualified Algebra.Laws as Laws
import qualified Test.QuickCheck as QC

import Control.Monad.HT as M
import Test.NumericPrelude.Utility (testUnit)
import Test.QuickCheck (quickCheck)
import qualified Test.HUnit as HUnit


import NumericPrelude.Base as P
import NumericPrelude.Numeric as NP


{- * Properties for generic types -}

fractionConv :: (PID.C a, Indexable.C a) => [a] -> a -> Bool
fractionConv xs y =
   PartialFraction.toFraction (PartialFraction.fromFactoredFraction xs y) ==
   y % product xs

fractionConvAlt :: (PID.C a, Indexable.C a) => [a] -> a -> Bool
fractionConvAlt xs y =
   PartialFraction.fromFactoredFraction xs y ==
   PartialFraction.fromFactoredFractionAlt xs y

scaleInt :: (PID.C a, Indexable.C a) => a -> PartialFraction.T a -> Bool
scaleInt k a =
   PartialFraction.toFraction (PartialFraction.scaleInt k a) ==
   Ratio.scale k (PartialFraction.toFraction a)

add :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool
add = Laws.homomorphism PartialFraction.toFraction (+) (+)

sub :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool
sub = Laws.homomorphism PartialFraction.toFraction (-) (-)

mul :: (PID.C a, Indexable.C a) => PartialFraction.T a -> PartialFraction.T a -> Bool
mul = Laws.homomorphism PartialFraction.toFraction (*) (*)



{- * Properties for Integers -}

{- |
Arbitrary instance of that type generates irreducible elements for tests.
Choosing from a list of examples is a simple yet effective design.
If we would construct irreducible elements by a clever algorithm
we might obtain multiple primes only rarely.
-}
newtype SmallPrime = SmallPrime {intFromSmallPrime :: Integer}

type IntFraction = ([SmallPrime],Integer)

instance QC.Arbitrary SmallPrime where
   arbitrary =
      let primes = [2,3,5,7,11,13]
      in  fmap SmallPrime $ QC.elements (primes ++ map negate primes)

instance Show SmallPrime where
   show = show . intFromSmallPrime


fractionConvInt :: [SmallPrime] -> Integer -> Bool
fractionConvInt =
   fractionConv . map intFromSmallPrime

fractionConvAltInt :: [SmallPrime] -> Integer -> Bool
fractionConvAltInt =
   fractionConvAlt . map intFromSmallPrime

fromSmallPrimes :: IntFraction -> PartialFraction.T Integer
fromSmallPrimes (xs,y) =
   PartialFraction.fromFactoredFraction (map intFromSmallPrime xs) y


scaleIntInt :: Integer -> IntFraction -> Bool
scaleIntInt k a =
   scaleInt k (fromSmallPrimes a)

addInt :: IntFraction -> IntFraction -> Bool
addInt q0 q1 =
   add
      (fromSmallPrimes q0)
      (fromSmallPrimes q1)

subInt :: IntFraction -> IntFraction -> Bool
subInt q0 q1 =
   sub
      (fromSmallPrimes q0)
      (fromSmallPrimes q1)

mulInt :: IntFraction -> IntFraction -> Bool
mulInt q0 q1 =
   mul
      (fromSmallPrimes q0)
      (fromSmallPrimes q1)


intTests :: HUnit.Test
intTests =
   HUnit.TestLabel "integer" $
   HUnit.TestList $
   map testUnit $
      ("conversion between partial and ordinary fraction", quickCheck fractionConvInt) :
      ("two conversion routines from factored fractions", quickCheck fractionConvAltInt) :
      ("integer scaling", quickCheck scaleIntInt) :
      ("addition", quickCheck addInt) :
      ("subtraction", quickCheck subInt) :
      ("multiplication", quickCheck mulInt) :
      []


{- * Properties for Polynomials -}

newtype IrredPoly = IrredPoly {polyFromIrredPoly :: Poly.T Rational}

type RatPolynomial = Poly.T Rational
type PolyFraction = ([IrredPoly],RatPolynomial)

instance QC.Arbitrary IrredPoly where
   arbitrary =
      do poly <- QC.elements (map Poly.fromCoeffs [[2,3],[2,0,1],[3,0,1],[1,-3,0,1]])
         unit <- M.until (not. isZero) QC.arbitrary
         return (IrredPoly (unit Vector.*> poly))

instance Show IrredPoly where
   show = show . polyFromIrredPoly


fractionConvPoly :: [IrredPoly] -> RatPolynomial -> Bool
fractionConvPoly =
   fractionConv . map polyFromIrredPoly

fractionConvAltPoly :: [IrredPoly] -> RatPolynomial -> Bool
fractionConvAltPoly =
   fractionConvAlt . map polyFromIrredPoly

fromIrredPolys :: PolyFraction -> PartialFraction.T RatPolynomial
fromIrredPolys (xs,y) =
   PartialFraction.fromFactoredFraction (map polyFromIrredPoly xs) y


scaleIntPoly :: RatPolynomial -> PolyFraction -> Bool
scaleIntPoly k a =
   scaleInt k (fromIrredPolys a)

addPoly :: PolyFraction -> PolyFraction -> Bool
addPoly q0 q1 =
   add
      (fromIrredPolys q0)
      (fromIrredPolys q1)

subPoly :: PolyFraction -> PolyFraction -> Bool
subPoly q0 q1 =
   sub
      (fromIrredPolys q0)
      (fromIrredPolys q1)

mulPoly :: PolyFraction -> PolyFraction -> Bool
mulPoly q0 q1 =
   mul
      (fromIrredPolys q0)
      (fromIrredPolys q1)



polyTests :: HUnit.Test
polyTests =
   HUnit.TestLabel "polynomial" $
   HUnit.TestList $
   map testUnit $
{- this test fails, because addition may result in leading zero coefficients,
      that is, polynomial addition does not contain a normalization
      if it would contain one, we would exclude computable reals -}
-- wrong     ("conversion between partial and ordinary fraction", quickCheck fractionConvPoly) :
-- wrong     ("two conversion routines from factored fractions", quickCheck fractionConvAltPoly) :
-- too slow      ("integer scaling", quickCheck scaleIntPoly) :
-- too slow      ("addition", quickCheck addPoly) :
-- too slow      ("subtraction", quickCheck subPoly) :
-- too slow      ("multiplication", quickCheck mulPoly) :
      []


tests :: HUnit.Test
tests =
   HUnit.TestLabel "partial fraction" $
   HUnit.TestList $
      intTests :
--      polyTests :
      []