{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Data.Polynomial.Factorization.Rational
-- Copyright   :  (c) Masahiro Sakai 2013
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module ToySolver.Data.Polynomial.Factorization.Rational () where

import Data.List (foldl')
import Data.Ratio

import ToySolver.Data.Polynomial.Base (UPolynomial)
import qualified ToySolver.Data.Polynomial.Base as P
import ToySolver.Data.Polynomial.Factorization.Integer ()

instance P.Factor (UPolynomial Rational) where
  factor :: UPolynomial Rational -> [(UPolynomial Rational, Integer)]
factor UPolynomial Rational
0 = [(UPolynomial Rational
0,Integer
1)]
  factor UPolynomial Rational
p = [(Rational -> UPolynomial Rational
forall k v. (Eq k, Num k) => k -> Polynomial k v
P.constant Rational
c, Integer
1) | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
1] [(UPolynomial Rational, Integer)]
-> [(UPolynomial Rational, Integer)]
-> [(UPolynomial Rational, Integer)]
forall a. [a] -> [a] -> [a]
++ [(UPolynomial Rational, Integer)]
qs2
    where
      qs :: [(Polynomial Integer X, Integer)]
qs  = Polynomial Integer X -> [(Polynomial Integer X, Integer)]
forall a. Factor a => a -> [(a, Integer)]
P.factor (Polynomial Integer X -> [(Polynomial Integer X, Integer)])
-> Polynomial Integer X -> [(Polynomial Integer X, Integer)]
forall a b. (a -> b) -> a -> b
$ UPolynomial Rational -> Polynomial (PPCoeff Rational) X
forall k v.
(ContPP k, Ord v) =>
Polynomial k v -> Polynomial (PPCoeff k) v
P.pp UPolynomial Rational
p
      qs2 :: [(UPolynomial Rational, Integer)]
qs2 = [((Integer -> Rational)
-> Polynomial Integer X -> UPolynomial Rational
forall k1 k v.
(Eq k1, Num k1) =>
(k -> k1) -> Polynomial k v -> Polynomial k1 v
P.mapCoeff Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Polynomial Integer X
q, Integer
m) | (Polynomial Integer X
q,Integer
m) <- [(Polynomial Integer X, Integer)]
qs, Polynomial Integer X -> Integer
forall t. Degree t => t -> Integer
P.deg Polynomial Integer X
q Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0]
      c :: Rational
c   = Integer -> Rational
forall a. Real a => a -> Rational
toRational ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [(Monomial X -> Polynomial Integer X -> Integer
forall k v. (Num k, Ord v) => Monomial v -> Polynomial k v -> k
P.coeff Monomial X
forall v. Monomial v
P.mone Polynomial Integer X
q)Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
m | (Polynomial Integer X
q,Integer
m) <- [(Polynomial Integer X, Integer)]
qs, Polynomial Integer X -> Integer
forall t. Degree t => t -> Integer
P.deg Polynomial Integer X
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0]) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* UPolynomial Rational -> Rational
forall k v. (ContPP k, Ord v) => Polynomial k v -> k
P.cont UPolynomial Rational
p