{-# language MultiParamTypeClasses #-}
{-# language FlexibleContexts      #-}
{-# language UndecidableInstances  #-}
{-# language FlexibleInstances #-}

module Satchmo.Polynomial 

( Poly (Poly), NumPoly, polynomial, constant, fromCoefficients
, isNull, null, constantTerm, coefficients
, equals, ge, gt
, add, times, subtract, compose, apply, derive
)

where

import Prelude hiding (subtract,null)
import Data.Map ( Map )
import qualified Data.Map as M
import Control.Applicative ((<$>))
import Control.Monad (foldM)

import Satchmo.MonadSAT (MonadSAT)
import Satchmo.Boolean (Boolean,monadic)
import qualified Satchmo.Boolean as B
import Satchmo.Code

import qualified Satchmo.BinaryTwosComplement.Op.Fixed as F
--import qualified Satchmo.Binary.Op.Fixed as F

import Control.Monad ( forM )

-- | polynomial in one variable,
-- coefficients starting from degree zero
data Poly a = Poly [a] deriving ( Poly a -> Poly a -> Bool
forall a. Eq a => Poly a -> Poly a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Poly a -> Poly a -> Bool
$c/= :: forall a. Eq a => Poly a -> Poly a -> Bool
== :: Poly a -> Poly a -> Bool
$c== :: forall a. Eq a => Poly a -> Poly a -> Bool
Eq, Poly a -> Poly a -> Bool
Poly a -> Poly a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Poly a)
forall a. Ord a => Poly a -> Poly a -> Bool
forall a. Ord a => Poly a -> Poly a -> Ordering
forall a. Ord a => Poly a -> Poly a -> Poly a
min :: Poly a -> Poly a -> Poly a
$cmin :: forall a. Ord a => Poly a -> Poly a -> Poly a
max :: Poly a -> Poly a -> Poly a
$cmax :: forall a. Ord a => Poly a -> Poly a -> Poly a
>= :: Poly a -> Poly a -> Bool
$c>= :: forall a. Ord a => Poly a -> Poly a -> Bool
> :: Poly a -> Poly a -> Bool
$c> :: forall a. Ord a => Poly a -> Poly a -> Bool
<= :: Poly a -> Poly a -> Bool
$c<= :: forall a. Ord a => Poly a -> Poly a -> Bool
< :: Poly a -> Poly a -> Bool
$c< :: forall a. Ord a => Poly a -> Poly a -> Bool
compare :: Poly a -> Poly a -> Ordering
$ccompare :: forall a. Ord a => Poly a -> Poly a -> Ordering
Ord, Int -> Poly a -> ShowS
forall a. Show a => Int -> Poly a -> ShowS
forall a. Show a => [Poly a] -> ShowS
forall a. Show a => Poly a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Poly a] -> ShowS
$cshowList :: forall a. Show a => [Poly a] -> ShowS
show :: Poly a -> String
$cshow :: forall a. Show a => Poly a -> String
showsPrec :: Int -> Poly a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Poly a -> ShowS
Show )

type NumPoly = Poly F.Number

instance Decode m a Integer => Decode m (Poly a) (Poly Integer) where
    decode :: Poly a -> m (Poly Integer)
decode (Poly [a]
xs) = do
      [Integer]
decodedXs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [a]
xs forall (m :: * -> *) c a. Decode m c a => c -> m a
decode 
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Poly a
Poly [Integer]
decodedXs

fromCoefficients :: MonadSAT m => Int -- ^ Bits
                 -> [Integer]         -- ^ Coefficients
                 -> m NumPoly
fromCoefficients :: forall (m :: * -> *). MonadSAT m => Int -> [Integer] -> m NumPoly
fromCoefficients Int
width [Integer]
coefficients = 
    forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Integer]
coefficients forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadSAT m => Int -> Integer -> m Number
F.constantWidth Int
width)

polynomial :: MonadSAT m => Int -- ^ Bits
           -> Int -- ^ Degree
           -> m NumPoly
polynomial :: forall (m :: * -> *). MonadSAT m => Int -> Int -> m NumPoly
polynomial Int
bits Int
deg = 
    forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ Int
0 .. Int
deg ] forall a b. (a -> b) -> a -> b
$ \ Int
i -> forall (m :: * -> *). MonadSAT m => Int -> m Number
F.number Int
bits)

constant :: MonadSAT m
         => Integer
         -> m NumPoly
constant :: forall (m :: * -> *). MonadSAT m => Integer -> m NumPoly
constant Integer
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Poly a
Poly []
constant Integer
const = do
    Number
c <- forall (m :: * -> *). MonadSAT m => Integer -> m Number
F.constant Integer
const
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Poly a
Poly [Number
c]

-- | this is sort of wrong:
-- null polynomial should have degree -infty
-- but this function will return -1
degree :: Poly a -> Int
degree :: forall a. Poly a -> Int
degree ( Poly [a]
xs ) = forall a. Enum a => a -> a
pred forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

isNull :: Poly a -> Bool
isNull :: forall a. Poly a -> Bool
isNull (Poly []) = Bool
True
isNull Poly a
_         = Bool
False

null :: Poly a
null :: forall a. Poly a
null = forall a. [a] -> Poly a
Poly []

constantTerm :: Poly a -> a
constantTerm :: forall a. Poly a -> a
constantTerm (Poly (a
c:[a]
_)) = a
c

coefficients :: Poly a -> [a]
coefficients :: forall a. Poly a -> [a]
coefficients (Poly [a]
cs) = [a]
cs

fill :: MonadSAT m => NumPoly -> NumPoly -> m ([F.Number],[F.Number])
fill :: forall (m :: * -> *).
MonadSAT m =>
NumPoly -> NumPoly -> m ([Number], [Number])
fill (Poly [Number]
p1) (Poly [Number]
p2) = do
  Number
zero <- forall (m :: * -> *). MonadSAT m => Integer -> m Number
F.constant Integer
0
  let maxL :: Int
maxL = forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Number]
p1) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Number]
p2)
      fill' :: [Number] -> [Number]
fill' [Number]
xs = forall a. Int -> [a] -> [a]
take Int
maxL forall a b. (a -> b) -> a -> b
$ [Number]
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Number
zero
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Number] -> [Number]
fill' [Number]
p1, [Number] -> [Number]
fill' [Number]
p2)

reverseBoth :: ([a],[b]) -> ([a], [b])
reverseBoth :: forall a b. ([a], [b]) -> ([a], [b])
reverseBoth ([a]
p1, [b]
p2) = (forall a. [a] -> [a]
reverse [a]
p1, forall a. [a] -> [a]
reverse [b]
p2)

binaryOp :: ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp :: forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp [a] -> b
unary [a] -> [a] -> b
binary [a]
p1 [a]
p2 =
    case ([a]
p1,[a]
p2) of
      ([],[a]
ys) -> [a] -> b
unary [a]
ys
      ([a]
xs,[]) -> [a] -> b
unary [a]
xs
      ([a]
xs,[a]
ys) -> [a] -> [a] -> b
binary [a]
xs [a]
ys

equals,  ge,  gt  :: MonadSAT m => NumPoly -> NumPoly -> m Boolean
equals', ge', gt' :: MonadSAT m => [F.Number] -> [F.Number] -> m Boolean

equals :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m Boolean
equals NumPoly
p1 NumPoly
p2 = forall (m :: * -> *).
MonadSAT m =>
NumPoly -> NumPoly -> m ([Number], [Number])
fill NumPoly
p1 NumPoly
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
equals'

equals' :: forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
equals' = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp (\[Number]
_ -> forall (m :: * -> *). MonadSAT m => Bool -> m Boolean
B.constant Bool
True)
          (\(Number
x:[Number]
xs) (Number
y:[Number]
ys) -> do Boolean
e <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Boolean
F.equals Number
x Number
y
                                Boolean
rest <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
equals' [Number]
xs [Number]
ys
                                forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean
B.and [Boolean
e,Boolean
rest]
          )

ge :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m Boolean
ge NumPoly
p1 NumPoly
p2 = forall (m :: * -> *).
MonadSAT m =>
NumPoly -> NumPoly -> m ([Number], [Number])
fill NumPoly
p1 NumPoly
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
ge' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ([a], [b]) -> ([a], [b])
reverseBoth

ge' :: forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
ge' = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp (\[Number]
_ -> forall (m :: * -> *). MonadSAT m => Bool -> m Boolean
B.constant Bool
True)
      (\(Number
x:[Number]
xs) (Number
y:[Number]
ys) -> do Boolean
gt <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Boolean
F.gt Number
x Number
y
                            Boolean
eq <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Boolean
F.equals Number
x Number
y
                            Boolean
rest <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
ge' [Number]
xs [Number]
ys
                            forall (m :: * -> *) a b. Monad m => ([a] -> m b) -> [m a] -> m b
monadic forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean
B.or [ forall (m :: * -> *) a. Monad m => a -> m a
return Boolean
gt
                                         , forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean
B.and [ Boolean
eq, Boolean
rest ]]
      )

gt :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m Boolean
gt NumPoly
p1 NumPoly
p2 = forall (m :: * -> *).
MonadSAT m =>
NumPoly -> NumPoly -> m ([Number], [Number])
fill NumPoly
p1 NumPoly
p2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
gt' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ([a], [b]) -> ([a], [b])
reverseBoth

gt' :: forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
gt' = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp (\[Number]
_ -> forall (m :: * -> *). MonadSAT m => Bool -> m Boolean
B.constant Bool
False)
      (\(Number
x:[Number]
xs) (Number
y:[Number]
ys) -> do Boolean
gt <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Boolean
F.gt Number
x Number
y
                            Boolean
eq <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Boolean
F.equals Number
x Number
y
                            Boolean
rest <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m Boolean
gt' [Number]
xs [Number]
ys
                            forall (m :: * -> *) a b. Monad m => ([a] -> m b) -> [m a] -> m b
monadic forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean
B.or [ forall (m :: * -> *) a. Monad m => a -> m a
return Boolean
gt
                                         , forall (m :: * -> *). MonadSAT m => [Boolean] -> m Boolean
B.and [ Boolean
eq, Boolean
rest ]]
      )

add,  times, subtract, compose :: MonadSAT m => NumPoly -> NumPoly -> m NumPoly
add', times' :: MonadSAT m => [F.Number] -> [F.Number] -> m [F.Number]

add :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m NumPoly
add (Poly [Number]
p1) (Poly [Number]
p2) = forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' [Number]
p1 [Number]
p2
add' :: forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp forall (m :: * -> *) a. Monad m => a -> m a
return 
       (\(Number
x:[Number]
xs) (Number
y:[Number]
ys) -> do Number
z  <- forall (m :: * -> *). MonadSAT m => Number -> Number -> m Number
F.add Number
x Number
y
                             [Number]
zs <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' [Number]
xs [Number]
ys
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Number
z forall a. a -> [a] -> [a]
: [Number]
zs
       )

times :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m NumPoly
times (Poly [Number]
p1) (Poly [Number]
p2) = forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
times' [Number]
p1 [Number]
p2
times' :: forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
times' = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp (\[Number]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
         (\(Number
x:[Number]
xs) [Number]
ys -> do [Number]
zs   <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
times' [Number]
xs [Number]
ys
                           ~(Number
f:[Number]
fs) <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Number]
ys forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadSAT m => Number -> Number -> m Number
F.times Number
x
                           [Number]
rest <- forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' [Number]
zs [Number]
fs
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Number
f forall a. a -> [a] -> [a]
: [Number]
rest
         )

subtract :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m NumPoly
subtract (Poly [Number]
p1) (Poly [Number]
p2) = do
  [Number]
p2' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Number]
p2 forall (m :: * -> *). MonadSAT m => Number -> m Number
F.negate
  forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' [Number]
p1 [Number]
p2'

-- | @compose p(x) q(x) = p(q(x))@
compose :: forall (m :: * -> *). MonadSAT m => NumPoly -> NumPoly -> m NumPoly
compose (Poly [Number]
p1) (Poly [Number]
p2) = 
    let Number
p:[Number]
ps = forall a. [a] -> [a]
reverse [Number]
p1
    in do
      forall a. [a] -> Poly a
Poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
MonadSAT m =>
[Number] -> [Number] -> [Number] -> m [Number]
compose' [Number
p] [Number]
ps [Number]
p2

compose' :: [Number] -> [Number] -> [Number] -> m [Number]
compose' [Number]
zs = forall a b. ([a] -> b) -> ([a] -> [a] -> b) -> [a] -> [a] -> b
binaryOp (\[Number]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return [Number]
zs)
              (\(Number
x:[Number]
xs) [Number]
ys -> do [Number]
zs' <- [Number]
zs forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
`times'` [Number]
ys forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadSAT m =>
[Number] -> [Number] -> m [Number]
add' [Number
x] 
                                [Number] -> [Number] -> [Number] -> m [Number]
compose' [Number]
zs' [Number]
xs [Number]
ys
              )

-- | @apply p x@ applies number @x@ to polynomial @p@
apply :: MonadSAT m => NumPoly -> F.Number -> m F.Number
apply :: forall (m :: * -> *). MonadSAT m => NumPoly -> Number -> m Number
apply (Poly [Number]
poly) Number
x = 
    let Number
p:[Number]
ps = forall a. [a] -> [a]
reverse [Number]
poly
    in 
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Number
sum -> forall (m :: * -> *).
MonadSAT m =>
Number -> Number -> Number -> m Number
F.linear Number
sum Number
x) Number
p [Number]
ps

-- | @derive p@ computes the derivation of @p@
derive :: MonadSAT m => NumPoly -> m NumPoly
derive :: forall (m :: * -> *). MonadSAT m => NumPoly -> m NumPoly
derive (Poly [Number]
p) = 
    let p' :: [(Number, Integer)]
p' = forall a b. [a] -> [b] -> [(a, b)]
zip [Number]
p [Integer
0..]
        dx :: (Number, Integer) -> m Number
dx (Number
x,Integer
e) = forall (m :: * -> *). MonadSAT m => Integer -> m Number
F.constant Integer
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadSAT m => Number -> Number -> m Number
F.times Number
x
    in
      (forall a. [a] -> Poly a
Poly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Number, Integer)]
p' forall {m :: * -> *}. MonadSAT m => (Number, Integer) -> m Number
dx