{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module MultiPol
  ( Polynomial() 
  , CompactPolynomial()
  , compact
  , Monomial(..)
  , lone
  , constant
  , terms
  , (*^)
  , (^+^)
  , (^-^)
  , (^*^)
  , (^**^)
  , evalPoly
  , prettyPol
  , polytest 
  )
  where
import qualified Algebra.Additive as AlgAdd
import qualified Algebra.Module   as AlgMod
import qualified Algebra.Ring     as AlgRing
import           Data.Foldable    ( toList )
import           Data.Function    ( on )
import           Data.List        ( sortBy, groupBy )
import qualified Data.Sequence    as S
import           Data.Sequence    ( Seq, (><), (|>) )
import           Data.Text        ( Text, pack, intercalate, cons, snoc, append, unpack )
import           Data.Tuple.Extra ( (&&&) )

data Monomial a = Monomial 
  { 
    Monomial a -> a
coefficient :: a, 
    Monomial a -> Seq Int
powers      :: Seq Int
  }
    deriving (Int -> Monomial a -> ShowS
[Monomial a] -> ShowS
Monomial a -> String
(Int -> Monomial a -> ShowS)
-> (Monomial a -> String)
-> ([Monomial a] -> ShowS)
-> Show (Monomial a)
forall a. Show a => Int -> Monomial a -> ShowS
forall a. Show a => [Monomial a] -> ShowS
forall a. Show a => Monomial a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Monomial a] -> ShowS
$cshowList :: forall a. Show a => [Monomial a] -> ShowS
show :: Monomial a -> String
$cshow :: forall a. Show a => Monomial a -> String
showsPrec :: Int -> Monomial a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Monomial a -> ShowS
Show, Monomial a -> Monomial a -> Bool
(Monomial a -> Monomial a -> Bool)
-> (Monomial a -> Monomial a -> Bool) -> Eq (Monomial a)
forall a. Eq a => Monomial a -> Monomial a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Monomial a -> Monomial a -> Bool
$c/= :: forall a. Eq a => Monomial a -> Monomial a -> Bool
== :: Monomial a -> Monomial a -> Bool
$c== :: forall a. Eq a => Monomial a -> Monomial a -> Bool
Eq)

data Polynomial a = Zero
                  | M (Monomial a)
                  | Polynomial a :+: Polynomial a
                  | Polynomial a :*: Polynomial a
                    deriving (Int -> Polynomial a -> ShowS
[Polynomial a] -> ShowS
Polynomial a -> String
(Int -> Polynomial a -> ShowS)
-> (Polynomial a -> String)
-> ([Polynomial a] -> ShowS)
-> Show (Polynomial a)
forall a. Show a => Int -> Polynomial a -> ShowS
forall a. Show a => [Polynomial a] -> ShowS
forall a. Show a => Polynomial a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Polynomial a] -> ShowS
$cshowList :: forall a. Show a => [Polynomial a] -> ShowS
show :: Polynomial a -> String
$cshow :: forall a. Show a => Polynomial a -> String
showsPrec :: Int -> Polynomial a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Polynomial a -> ShowS
Show)
instance (AlgRing.C a, Eq a) => Eq (Polynomial a) where
  Polynomial a
p == :: Polynomial a -> Polynomial a -> Bool
== Polynomial a
q = (Monomial a -> a) -> [Monomial a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Monomial a -> a
forall a. Monomial a -> a
coefficient (Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials (Polynomial a -> [Monomial a]) -> Polynomial a -> [Monomial a]
forall a b. (a -> b) -> a -> b
$ Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^-^ Polynomial a
q) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
forall a. Monoid a => a
mempty
instance (AlgRing.C a, Eq a) => AlgAdd.C (Polynomial a) where
  Polynomial a
p + :: Polynomial a -> Polynomial a -> Polynomial a
+ Polynomial a
q = Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
addPolys Polynomial a
p Polynomial a
q
  zero :: Polynomial a
zero = Polynomial a
forall a. Polynomial a
Zero
  negate :: Polynomial a -> Polynomial a
negate = Polynomial a -> Polynomial a
forall a. (C a, Eq a) => Polynomial a -> Polynomial a
negatePol
instance (AlgRing.C a, Eq a) => AlgMod.C a (Polynomial a) where
  a
lambda *> :: a -> Polynomial a -> Polynomial a
*> Polynomial a
p = a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
p
instance (AlgRing.C a, Eq a) => AlgRing.C (Polynomial a) where
  Polynomial a
p * :: Polynomial a -> Polynomial a -> Polynomial a
* Polynomial a
q = Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
multiplyPols Polynomial a
p Polynomial a
q
  one :: Polynomial a
one = Int -> Polynomial a
forall a. (C a, Eq a) => Int -> Polynomial a
lone Int
0

newtype CompactPolynomial a = Compact (Polynomial a)
  deriving (CompactPolynomial a -> CompactPolynomial a -> Bool
(CompactPolynomial a -> CompactPolynomial a -> Bool)
-> (CompactPolynomial a -> CompactPolynomial a -> Bool)
-> Eq (CompactPolynomial a)
forall a.
(C a, Eq a) =>
CompactPolynomial a -> CompactPolynomial a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactPolynomial a -> CompactPolynomial a -> Bool
$c/= :: forall a.
(C a, Eq a) =>
CompactPolynomial a -> CompactPolynomial a -> Bool
== :: CompactPolynomial a -> CompactPolynomial a -> Bool
$c== :: forall a.
(C a, Eq a) =>
CompactPolynomial a -> CompactPolynomial a -> Bool
Eq)
instance (Eq a, Show a, AlgRing.C a) => Show (CompactPolynomial a) where
  show :: CompactPolynomial a -> String
show CompactPolynomial a
p = [(a, [Int])] -> String
forall a. Show a => a -> String
show ([(a, [Int])] -> String) -> [(a, [Int])] -> String
forall a b. (a -> b) -> a -> b
$ (Monomial a -> (a, [Int])) -> [Monomial a] -> [(a, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (Monomial a -> a
forall a. Monomial a -> a
coefficient (Monomial a -> a)
-> (Monomial a -> [Int]) -> Monomial a -> (a, [Int])
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& (Seq Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int])
-> (Monomial a -> Seq Int) -> Monomial a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers)) (Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials (Polynomial a -> [Monomial a]) -> Polynomial a -> [Monomial a]
forall a b. (a -> b) -> a -> b
$ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
p)
instance (AlgRing.C a, Eq a) => AlgAdd.C (CompactPolynomial a) where
  CompactPolynomial a
p + :: CompactPolynomial a -> CompactPolynomial a -> CompactPolynomial a
+ CompactPolynomial a
q = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact (Polynomial a -> CompactPolynomial a)
-> Polynomial a -> CompactPolynomial a
forall a b. (a -> b) -> a -> b
$ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^+^ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
q
  zero :: CompactPolynomial a
zero = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact Polynomial a
forall a. Polynomial a
Zero
  negate :: CompactPolynomial a -> CompactPolynomial a
negate = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact (Polynomial a -> CompactPolynomial a)
-> (CompactPolynomial a -> Polynomial a)
-> CompactPolynomial a
-> CompactPolynomial a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polynomial a -> Polynomial a
forall a. (C a, Eq a) => Polynomial a -> Polynomial a
negatePol (Polynomial a -> Polynomial a)
-> (CompactPolynomial a -> Polynomial a)
-> CompactPolynomial a
-> Polynomial a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact
instance (AlgRing.C a, Eq a) => AlgMod.C a (CompactPolynomial a) where
  a
lambda *> :: a -> CompactPolynomial a -> CompactPolynomial a
*> CompactPolynomial a
p = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact (Polynomial a -> CompactPolynomial a)
-> Polynomial a -> CompactPolynomial a
forall a b. (a -> b) -> a -> b
$ a
lambda a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
*^ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
p
instance (AlgRing.C a, Eq a) => AlgRing.C (CompactPolynomial a) where
  CompactPolynomial a
p * :: CompactPolynomial a -> CompactPolynomial a -> CompactPolynomial a
* CompactPolynomial a
q = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact (Polynomial a -> CompactPolynomial a)
-> Polynomial a -> CompactPolynomial a
forall a b. (a -> b) -> a -> b
$ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ CompactPolynomial a -> Polynomial a
forall a. CompactPolynomial a -> Polynomial a
fromCompact CompactPolynomial a
q
  one :: CompactPolynomial a
one = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
compact (Polynomial a -> CompactPolynomial a)
-> Polynomial a -> CompactPolynomial a
forall a b. (a -> b) -> a -> b
$ Int -> Polynomial a
forall a. (C a, Eq a) => Int -> Polynomial a
lone Int
0

fromCompact :: CompactPolynomial a -> Polynomial a
fromCompact :: CompactPolynomial a -> Polynomial a
fromCompact (Compact Polynomial a
p) = Polynomial a
p 

compact :: Polynomial a -> CompactPolynomial a
compact :: Polynomial a -> CompactPolynomial a
compact = Polynomial a -> CompactPolynomial a
forall a. Polynomial a -> CompactPolynomial a
Compact  

addPolys :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a -> Polynomial a
addPolys :: Polynomial a -> Polynomial a -> Polynomial a
addPolys Polynomial a
p Polynomial a
q = Polynomial a -> Polynomial a
forall a. (C a, Eq a) => Polynomial a -> Polynomial a
toCanonicalForm (Polynomial a -> Polynomial a) -> Polynomial a -> Polynomial a
forall a b. (a -> b) -> a -> b
$ Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a. Polynomial a -> Polynomial a -> Polynomial a
:+: Polynomial a
q

-- | Addition of two polynomials

(^+^) :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a -> Polynomial a
^+^ :: Polynomial a -> Polynomial a -> Polynomial a
(^+^) Polynomial a
p Polynomial a
q = Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a. C a => a -> a -> a
AlgAdd.+ Polynomial a
q

negatePol :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a
negatePol :: Polynomial a -> Polynomial a
negatePol Polynomial a
pol = case Polynomial a
pol of 
  Polynomial a
Zero -> Polynomial a
forall a. Polynomial a
Zero
  M Monomial a
monomial -> Monomial a -> Polynomial a
forall a. Monomial a -> Polynomial a
M (Monomial a -> Monomial a
forall a1. (C a1, Eq a1) => Monomial a1 -> Monomial a1
negateMonomial Monomial a
monomial)
  Polynomial a
pol -> [Monomial a] -> Polynomial a
forall a. (C a, Eq a) => [Monomial a] -> Polynomial a
fromListOfMonomials ((Monomial a -> Monomial a) -> [Monomial a] -> [Monomial a]
forall a b. (a -> b) -> [a] -> [b]
map Monomial a -> Monomial a
forall a1. (C a1, Eq a1) => Monomial a1 -> Monomial a1
negateMonomial (Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
pol))
  where
    negateMonomial :: forall a1. (AlgRing.C a1, Eq a1) => Monomial a1 -> Monomial a1
    negateMonomial :: Monomial a1 -> Monomial a1
negateMonomial Monomial a1
monomial = Monomial :: forall a. a -> Seq Int -> Monomial a
Monomial { 
      coefficient :: a1
coefficient = a1 -> a1
forall a. C a => a -> a
AlgAdd.negate (Monomial a1 -> a1
forall a. Monomial a -> a
coefficient Monomial a1
monomial), 
      powers :: Seq Int
powers = Monomial a1 -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a1
monomial
    }

-- | Substraction

(^-^) :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a -> Polynomial a
^-^ :: Polynomial a -> Polynomial a -> Polynomial a
(^-^) Polynomial a
p Polynomial a
q = Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a. C a => a -> a -> a
AlgAdd.- Polynomial a
q

multiplyPols :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a -> Polynomial a
multiplyPols :: Polynomial a -> Polynomial a -> Polynomial a
multiplyPols Polynomial a
p Polynomial a
q = Polynomial a -> Polynomial a
forall a. (C a, Eq a) => Polynomial a -> Polynomial a
toCanonicalForm (Polynomial a -> Polynomial a) -> Polynomial a -> Polynomial a
forall a b. (a -> b) -> a -> b
$ Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a. Polynomial a -> Polynomial a -> Polynomial a
:*: Polynomial a
q

-- | Multiply two polynomials

(^*^) :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a -> Polynomial a
^*^ :: Polynomial a -> Polynomial a -> Polynomial a
(^*^) Polynomial a
p Polynomial a
q = Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a. C a => a -> a -> a
AlgRing.* Polynomial a
q

-- | Power of a polynomial

(^**^) :: (AlgRing.C a, Eq a) => Polynomial a -> Int -> Polynomial a
^**^ :: Polynomial a -> Int -> Polynomial a
(^**^) Polynomial a
p Int
n = (Polynomial a -> Polynomial a -> Polynomial a)
-> [Polynomial a] -> Polynomial a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
(^*^) (Int -> Polynomial a -> [Polynomial a]
forall a. Int -> a -> [a]
replicate Int
n Polynomial a
p) 

scalePol :: (AlgRing.C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol :: a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
pol = if a
lambda a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero
  then Polynomial a
forall a. Polynomial a
Zero 
  else case Polynomial a
pol of
    Polynomial a
Zero -> Polynomial a
forall a. Polynomial a
Zero 
    M Monomial a
monomial -> Monomial a -> Polynomial a
forall a. Monomial a -> Polynomial a
M (Monomial a -> Monomial a
scaleMonomial Monomial a
monomial)
    Polynomial a
p :+: Polynomial a
q -> if Polynomial a
p Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
/= Polynomial a
forall a. Polynomial a
Zero Bool -> Bool -> Bool
&& Polynomial a
q Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
/= Polynomial a
forall a. Polynomial a
Zero
      then a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^+^ a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
q
      else if Polynomial a
p Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
== Polynomial a
forall a. Polynomial a
Zero
        then a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
q
        else a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
p
    Polynomial a
p :*: Polynomial a
q -> if Polynomial a
p Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
== Polynomial a
forall a. Polynomial a
Zero Bool -> Bool -> Bool
|| Polynomial a
q Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
== Polynomial a
forall a. Polynomial a
Zero
      then Polynomial a
forall a. Polynomial a
Zero
      else a -> Polynomial a -> Polynomial a
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
scalePol a
lambda Polynomial a
p Polynomial a -> Polynomial a -> Polynomial a
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ Polynomial a
q
  where
    scaleMonomial :: Monomial a -> Monomial a
scaleMonomial Monomial a
monomial = Monomial :: forall a. a -> Seq Int -> Monomial a
Monomial {
                                coefficient :: a
coefficient = a
lambda a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* Monomial a -> a
forall a. Monomial a -> a
coefficient Monomial a
monomial
                              , powers :: Seq Int
powers = Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a
monomial
                             }

-- | Scale polynomial by a scalar

(*^) :: (AlgRing.C a, Eq a) => a -> Polynomial a -> Polynomial a
*^ :: a -> Polynomial a -> Polynomial a
(*^) a
lambda Polynomial a
pol = a
lambda a -> Polynomial a -> Polynomial a
forall a v. C a v => a -> v -> v
AlgMod.*> Polynomial a
pol 

-- | Polynomial x_n

lone :: (AlgRing.C a, Eq a) => Int -> Polynomial a
lone :: Int -> Polynomial a
lone Int
n = Monomial a -> Polynomial a
forall a. Monomial a -> Polynomial a
M (a -> Seq Int -> Monomial a
forall a. a -> Seq Int -> Monomial a
Monomial a
forall a. C a => a
AlgRing.one Seq Int
pows)
  where
    pows :: Seq Int
pows = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
      then 
        Seq Int
forall a. Seq a
S.empty 
      else 
        Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
forall a. C a => a
AlgAdd.zero Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
forall a. C a => a
AlgRing.one

-- | Constant polynomial

constant :: (AlgRing.C a, Eq a) => a -> Polynomial a
constant :: a -> Polynomial a
constant a
x = Monomial a -> Polynomial a
forall a. Monomial a -> Polynomial a
M (a -> Seq Int -> Monomial a
forall a. a -> Seq Int -> Monomial a
Monomial a
x Seq Int
forall a. Seq a
S.empty)

growSequence :: Seq Int -> Int -> Seq Int 
growSequence :: Seq Int -> Int -> Seq Int
growSequence Seq Int
s Int
n = Seq Int
s Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< Seq Int
t
  where 
    m :: Int
m = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s 
    t :: Seq Int
t = Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Int
0
 
grow :: Int -> Monomial a -> Monomial a
grow :: Int -> Monomial a -> Monomial a
grow Int
n Monomial a
monom = a -> Seq Int -> Monomial a
forall a. a -> Seq Int -> Monomial a
Monomial (Monomial a -> a
forall a. Monomial a -> a
coefficient Monomial a
monom) (Seq Int -> Int -> Seq Int
growSequence (Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a
monom) Int
n)

nvariables :: Monomial a -> Int
nvariables :: Monomial a -> Int
nvariables Monomial a
monom = Seq Int -> Int
forall a. Seq a -> Int
S.length (Seq Int -> Int) -> Seq Int -> Int
forall a b. (a -> b) -> a -> b
$ Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a
monom

-- Build a polynomial from a list of monomials

fromListOfMonomials :: (AlgRing.C a, Eq a) => [Monomial a] -> Polynomial a
fromListOfMonomials :: [Monomial a] -> Polynomial a
fromListOfMonomials [Monomial a]
ms = if [Monomial a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Monomial a]
ms
                            then Polynomial a
forall a. Polynomial a
Zero
                            else (Polynomial a -> Polynomial a -> Polynomial a)
-> [Polynomial a] -> Polynomial a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Polynomial a -> Polynomial a -> Polynomial a
forall a. Polynomial a -> Polynomial a -> Polynomial a
(:+:) ((Monomial a -> Polynomial a) -> [Monomial a] -> [Polynomial a]
forall a b. (a -> b) -> [a] -> [b]
map Monomial a -> Polynomial a
forall a. Monomial a -> Polynomial a
M [Monomial a]
ms)

multMonomial :: (AlgRing.C a, Eq a) => Monomial a -> Monomial a -> Monomial a
multMonomial :: Monomial a -> Monomial a -> Monomial a
multMonomial (Monomial a
ca Seq Int
powsa) (Monomial a
cb Seq Int
powsb) =
  a -> Seq Int -> Monomial a
forall a. a -> Seq Int -> Monomial a
Monomial (a
ca a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
cb) ((Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Seq Int
powsa' Seq Int
powsb')
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
powsa) (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
powsb)
    powsa' :: Seq Int
powsa' = Seq Int -> Int -> Seq Int
growSequence Seq Int
powsa Int
n
    powsb' :: Seq Int
powsb' = Seq Int -> Int -> Seq Int
growSequence Seq Int
powsb Int
n

-- Polynomial to list of monomials

toListOfMonomials :: (AlgRing.C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials :: Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
pol = case Polynomial a
pol of
  Polynomial a
Zero -> []
  M Monomial a
monomial -> if Monomial a -> a
forall a. Monomial a -> a
coefficient Monomial a
monomial a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero then [] else [Monomial a
monomial]
  Polynomial a
p :+: Polynomial a
q -> [Monomial a] -> [Monomial a]
forall a. [Monomial a] -> [Monomial a]
harmonize ([Monomial a] -> [Monomial a]) -> [Monomial a] -> [Monomial a]
forall a b. (a -> b) -> a -> b
$ Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
p [Monomial a] -> [Monomial a] -> [Monomial a]
forall a. [a] -> [a] -> [a]
++ Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
q
  Polynomial a
p :*: Polynomial a
q -> [Monomial a] -> [Monomial a]
forall a. [Monomial a] -> [Monomial a]
harmonize ([Monomial a] -> [Monomial a]) -> [Monomial a] -> [Monomial a]
forall a b. (a -> b) -> a -> b
$ [Monomial a -> Monomial a -> Monomial a
forall a. (C a, Eq a) => Monomial a -> Monomial a -> Monomial a
multMonomial Monomial a
monoa Monomial a
monob | Monomial a
monoa <- Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
p,
                                                     Monomial a
monob <- Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
q]
  where
    harmonize :: [Monomial a] -> [Monomial a]
harmonize [Monomial a]
ms = (Monomial a -> Monomial a) -> [Monomial a] -> [Monomial a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Monomial a -> Monomial a
forall a. Int -> Monomial a -> Monomial a
grow ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Monomial a -> Int) -> [Monomial a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Monomial a -> Int
forall a. Monomial a -> Int
nvariables [Monomial a]
ms))) [Monomial a]
ms

-- | List of the terms of a polynomial 

terms :: (AlgRing.C a, Eq a) => Polynomial a -> [Monomial a]
terms :: Polynomial a -> [Monomial a]
terms Polynomial a
pol = case Polynomial a
pol of
  Polynomial a
Zero -> []
  M Monomial a
monomial -> [Monomial a
monomial]
  Polynomial a
p :+: Polynomial a
q -> Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
terms Polynomial a
p [Monomial a] -> [Monomial a] -> [Monomial a]
forall a. [a] -> [a] -> [a]
++ Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
terms Polynomial a
q
  Polynomial a
p :*: Polynomial a
q -> String -> [Monomial a]
forall a. HasCallStack => String -> a
error String
"that should not happen"

-- Polynomial to list of monomials, grouping the monomials with same powers

simplifiedListOfMonomials :: (AlgRing.C a, Eq a) => Polynomial a -> [Monomial a]
simplifiedListOfMonomials :: Polynomial a -> [Monomial a]
simplifiedListOfMonomials Polynomial a
pol = ([Monomial a] -> Monomial a) -> [[Monomial a]] -> [Monomial a]
forall a b. (a -> b) -> [a] -> [b]
map ((Monomial a -> Monomial a -> Monomial a)
-> [Monomial a] -> Monomial a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Monomial a -> Monomial a -> Monomial a
forall a. (C a, Eq a) => Monomial a -> Monomial a -> Monomial a
addMonomials) [[Monomial a]]
groups
  where
    groups :: [[Monomial a]]
groups = (Monomial a -> Monomial a -> Bool)
-> [Monomial a] -> [[Monomial a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Seq Int -> Seq Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Seq Int -> Seq Int -> Bool)
-> (Monomial a -> Seq Int) -> Monomial a -> Monomial a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers)
             ((Monomial a -> Monomial a -> Ordering)
-> [Monomial a] -> [Monomial a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Seq Int -> Seq Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq Int -> Seq Int -> Ordering)
-> (Monomial a -> Seq Int) -> Monomial a -> Monomial a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers) (Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
toListOfMonomials Polynomial a
pol))
    addMonomials :: forall a1. (AlgRing.C a1, Eq a1) => Monomial a1 -> Monomial a1 -> Monomial a1
    addMonomials :: Monomial a1 -> Monomial a1 -> Monomial a1
addMonomials Monomial a1
monoa Monomial a1
monob = Monomial :: forall a. a -> Seq Int -> Monomial a
Monomial {
                                coefficient :: a1
coefficient = Monomial a1 -> a1
forall a. Monomial a -> a
coefficient Monomial a1
monoa a1 -> a1 -> a1
forall a. C a => a -> a -> a
AlgAdd.+ Monomial a1 -> a1
forall a. Monomial a -> a
coefficient Monomial a1
monob
                              , powers :: Seq Int
powers = Monomial a1 -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a1
monoa
                              }

-- Canonical form of a polynomial (sum of monomials with distinct powers)

toCanonicalForm :: (AlgRing.C a, Eq a) => Polynomial a -> Polynomial a
toCanonicalForm :: Polynomial a -> Polynomial a
toCanonicalForm = [Monomial a] -> Polynomial a
forall a. (C a, Eq a) => [Monomial a] -> Polynomial a
fromListOfMonomials ([Monomial a] -> Polynomial a)
-> (Polynomial a -> [Monomial a]) -> Polynomial a -> Polynomial a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
simplifiedListOfMonomials

evalMonomial :: (AlgRing.C a, Eq a) => [a] -> Monomial a -> a
evalMonomial :: [a] -> Monomial a -> a
evalMonomial [a]
xyz Monomial a
monomial =
  Monomial a -> a
forall a. Monomial a -> a
coefficient Monomial a
monomial a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* [a] -> a
forall a. C a => [a] -> a
AlgRing.product ((a -> Integer -> a) -> [a] -> [Integer] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Integer -> a
forall a. C a => a -> Integer -> a
(AlgRing.^) [a]
xyz [Integer]
pows)
  where
    pows :: [Integer]
pows = Seq Integer -> [Integer]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Seq Int -> Seq Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a
monomial)

-- | Evaluates a polynomial

evalPoly :: (AlgRing.C a, Eq a) => Polynomial a -> [a] -> a
evalPoly :: Polynomial a -> [a] -> a
evalPoly Polynomial a
pol [a]
xyz = case Polynomial a
pol of
  Polynomial a
Zero -> a
forall a. C a => a
AlgAdd.zero
  M Monomial a
mono -> [a] -> Monomial a -> a
forall a. (C a, Eq a) => [a] -> Monomial a -> a
evalMonomial [a]
xyz Monomial a
mono
  Polynomial a
p :+: Polynomial a
q -> Polynomial a -> [a] -> a
forall a. (C a, Eq a) => Polynomial a -> [a] -> a
evalPoly Polynomial a
p [a]
xyz a -> a -> a
forall a. C a => a -> a -> a
AlgAdd.+ Polynomial a -> [a] -> a
forall a. (C a, Eq a) => Polynomial a -> [a] -> a
evalPoly Polynomial a
q [a]
xyz
  Polynomial a
p :*: Polynomial a
q -> String -> a
forall a. HasCallStack => String -> a
error String
"that should not happen" --evalPoly p xyz AlgRing.* evalPoly q xyz


polytest :: Bool
polytest :: Bool
polytest = Polynomial Double -> [Double] -> Double
forall a. (C a, Eq a) => Polynomial a -> [a] -> a
evalPoly Polynomial Double
poly [Double
2, Double
3, Double
4] Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
18816.0
  where
    x :: Polynomial Double
x = Int -> Polynomial Double
forall a. (C a, Eq a) => Int -> Polynomial a
lone Int
1 :: Polynomial Double
    y :: Polynomial Double
y = Int -> Polynomial Double
forall a. (C a, Eq a) => Int -> Polynomial a
lone Int
2 :: Polynomial Double
    z :: Polynomial Double
z = Int -> Polynomial Double
forall a. (C a, Eq a) => Int -> Polynomial a
lone Int
3 :: Polynomial Double
    poly :: Polynomial Double
poly = (Double
2 Double -> Polynomial Double -> Polynomial Double
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
*^ (Polynomial Double
xPolynomial Double -> Int -> Polynomial Double
forall a. (C a, Eq a) => Polynomial a -> Int -> Polynomial a
^**^Int
3 Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ Polynomial Double
y Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ Polynomial Double
z) Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^+^ (Polynomial Double
xPolynomial Double -> Int -> Polynomial Double
forall a. (C a, Eq a) => Polynomial a -> Int -> Polynomial a
^**^Int
2)) Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ (Double
4 Double -> Polynomial Double -> Polynomial Double
forall a. (C a, Eq a) => a -> Polynomial a -> Polynomial a
*^ Polynomial Double
x Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ Polynomial Double
y Polynomial Double -> Polynomial Double -> Polynomial Double
forall a.
(C a, Eq a) =>
Polynomial a -> Polynomial a -> Polynomial a
^*^ Polynomial Double
z)

prettyPowers :: String -> [Int] -> Text
prettyPowers :: String -> [Int] -> Text
prettyPowers String
var [Int]
pows = Text -> Text -> Text
append (String -> Text
pack String
x) (Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
string Char
')') 
  where
    x :: String
x = String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
var String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^"
    string :: Text
string = Text -> [Text] -> Text
intercalate (String -> Text
pack String
", ") ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int]
pows)

-- | Pretty form of a polynomial

prettyPol :: (AlgRing.C a, Eq a) => (a -> String) -> String -> Polynomial a -> String
prettyPol :: (a -> String) -> String -> Polynomial a -> String
prettyPol a -> String
prettyCoef String
var Polynomial a
p = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
stringTerms
  where
    stringTerms :: [Text]
stringTerms = (Monomial a -> Text) -> [Monomial a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Monomial a -> Text
stringTerm (Polynomial a -> [Monomial a]
forall a. (C a, Eq a) => Polynomial a -> [Monomial a]
terms Polynomial a
p)
    stringTerm :: Monomial a -> Text
stringTerm Monomial a
term = 
      Text -> Text -> Text
append (Text -> Char -> Text
snoc (Text -> Char -> Text
snoc (Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
stringCoef Char
')') Char
' ') Char
'*') (String -> [Int] -> Text
prettyPowers String
var [Int]
pows)
      where
        pows :: [Int]
pows = Seq Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int]) -> Seq Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Monomial a -> Seq Int
forall a. Monomial a -> Seq Int
powers Monomial a
term
        stringCoef :: Text
stringCoef = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
prettyCoef (Monomial a -> a
forall a. Monomial a -> a
coefficient Monomial a
term)