{-# 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 Control.Monad ( forM )
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
-> [Integer]
-> 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
-> Int
-> 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]
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 :: 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 :: 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 :: 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