{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Derivation.Constraint (
	Constraint, equal, greatEqualThan, greatThan, vars, has,
	isDerivFrom, positives, selfContained, eliminate,
	Poly, (.+), (.-) ) where

import Prelude hiding (null, filter)

import Control.Monad (guard)
import Data.Map.Strict (Map, null, singleton, (!?), filter, toList, lookupMin)
import Data.Map.Merge.Strict (
	merge, preserveMissing, mapMissing,
	zipWithMatched, zipWithMaybeMatched )
import Data.Maybe (isJust)
import Data.String (IsString, fromString)
import Data.Log (Log, logVar, (.+.), intersperse, Loggable(..))

---------------------------------------------------------------------------

-- * CONSTRAINT
--	+ DATA CONSTRAINT
--	+ CONSTRUCT
--	+ READ
-- 	+ CONVERT
-- * POLYNOMIAL
-- 	+ TYPE POLY
-- 	+ CONSTRUCT
-- 	+ READ
-- 	+ CONVERT

---------------------------------------------------------------------------
-- CONSTRAINT
---------------------------------------------------------------------------

-- DATA CONSTRAINT

data Constraint v = Eq (Poly v) | Geq (Poly v) deriving (Int -> Constraint v -> ShowS
[Constraint v] -> ShowS
Constraint v -> String
(Int -> Constraint v -> ShowS)
-> (Constraint v -> String)
-> ([Constraint v] -> ShowS)
-> Show (Constraint v)
forall v. Show v => Int -> Constraint v -> ShowS
forall v. Show v => [Constraint v] -> ShowS
forall v. Show v => Constraint v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint v] -> ShowS
$cshowList :: forall v. Show v => [Constraint v] -> ShowS
show :: Constraint v -> String
$cshow :: forall v. Show v => Constraint v -> String
showsPrec :: Int -> Constraint v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Constraint v -> ShowS
Show, Constraint v -> Constraint v -> Bool
(Constraint v -> Constraint v -> Bool)
-> (Constraint v -> Constraint v -> Bool) -> Eq (Constraint v)
forall v. Eq v => Constraint v -> Constraint v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint v -> Constraint v -> Bool
$c/= :: forall v. Eq v => Constraint v -> Constraint v -> Bool
== :: Constraint v -> Constraint v -> Bool
$c== :: forall v. Eq v => Constraint v -> Constraint v -> Bool
Eq, Eq (Constraint v)
Eq (Constraint v)
-> (Constraint v -> Constraint v -> Ordering)
-> (Constraint v -> Constraint v -> Bool)
-> (Constraint v -> Constraint v -> Bool)
-> (Constraint v -> Constraint v -> Bool)
-> (Constraint v -> Constraint v -> Bool)
-> (Constraint v -> Constraint v -> Constraint v)
-> (Constraint v -> Constraint v -> Constraint v)
-> Ord (Constraint v)
Constraint v -> Constraint v -> Bool
Constraint v -> Constraint v -> Ordering
Constraint v -> Constraint v -> Constraint v
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 v. Ord v => Eq (Constraint v)
forall v. Ord v => Constraint v -> Constraint v -> Bool
forall v. Ord v => Constraint v -> Constraint v -> Ordering
forall v. Ord v => Constraint v -> Constraint v -> Constraint v
min :: Constraint v -> Constraint v -> Constraint v
$cmin :: forall v. Ord v => Constraint v -> Constraint v -> Constraint v
max :: Constraint v -> Constraint v -> Constraint v
$cmax :: forall v. Ord v => Constraint v -> Constraint v -> Constraint v
>= :: Constraint v -> Constraint v -> Bool
$c>= :: forall v. Ord v => Constraint v -> Constraint v -> Bool
> :: Constraint v -> Constraint v -> Bool
$c> :: forall v. Ord v => Constraint v -> Constraint v -> Bool
<= :: Constraint v -> Constraint v -> Bool
$c<= :: forall v. Ord v => Constraint v -> Constraint v -> Bool
< :: Constraint v -> Constraint v -> Bool
$c< :: forall v. Ord v => Constraint v -> Constraint v -> Bool
compare :: Constraint v -> Constraint v -> Ordering
$ccompare :: forall v. Ord v => Constraint v -> Constraint v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (Constraint v)
Ord)

constraint :: (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint :: (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint Poly v -> a
f Poly v -> a
g = \case Eq Poly v
p -> Poly v -> a
f Poly v
p; Geq Poly v
p -> Poly v -> a
g Poly v
p

instance IsString s => Loggable s v (Constraint v) where
	log :: Constraint v -> Log s v
log = (Poly v -> Log s v)
-> (Poly v -> Log s v) -> Constraint v -> Log s v
forall v a. (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint
		(\Poly v
p -> Log s v
"(" Log s v -> Log s v -> Log s v
forall s v. Log s v -> Log s v -> Log s v
.+. [(Maybe v, Integer)] -> Log s v
forall s v. IsString s => [(Maybe v, Integer)] -> Log s v
polyToLog (Poly v -> [(Maybe v, Integer)]
forall k a. Map k a -> [(k, a)]
toList Poly v
p) Log s v -> Log s v -> Log s v
forall s v. Log s v -> Log s v -> Log s v
.+. Log s v
" == 0)")
		(\Poly v
p -> Log s v
"(" Log s v -> Log s v -> Log s v
forall s v. Log s v -> Log s v -> Log s v
.+. [(Maybe v, Integer)] -> Log s v
forall s v. IsString s => [(Maybe v, Integer)] -> Log s v
polyToLog (Poly v -> [(Maybe v, Integer)]
forall k a. Map k a -> [(k, a)]
toList Poly v
p) Log s v -> Log s v -> Log s v
forall s v. Log s v -> Log s v -> Log s v
.+. Log s v
" >= 0)")

-- CONSTRUCT

equal :: Ord v => Poly v -> Poly v -> Constraint v
Poly v
l equal :: Poly v -> Poly v -> Constraint v
`equal` Poly v
r = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Eq (Poly v -> Constraint v)
-> (Poly v -> Poly v) -> Poly v -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
posit (Poly v -> Poly v) -> (Poly v -> Poly v) -> Poly v -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v -> Constraint v) -> Poly v -> Constraint v
forall a b. (a -> b) -> a -> b
$ Poly v
l Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
.- Poly v
r

greatEqualThan :: Ord v => Poly v -> Poly v -> Constraint v
Poly v
l greatEqualThan :: Poly v -> Poly v -> Constraint v
`greatEqualThan` Poly v
r = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Geq (Poly v -> Constraint v)
-> (Poly v -> Poly v) -> Poly v -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v -> Constraint v) -> Poly v -> Constraint v
forall a b. (a -> b) -> a -> b
$ Poly v
l Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
.- Poly v
r

greatThan :: Ord v => Poly v -> Poly v -> Constraint v
Poly v
l greatThan :: Poly v -> Poly v -> Constraint v
`greatThan` Poly v
r = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Geq (Poly v -> Constraint v) -> Poly v -> Constraint v
forall a b. (a -> b) -> a -> b
$ Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v
l Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
.- Poly v
r) Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
.- Maybe v -> Integer -> Poly v
forall k a. k -> a -> Map k a
singleton Maybe v
forall a. Maybe a
Nothing Integer
1

-- READ

vars :: Ord v => Constraint v -> [Maybe v]
vars :: Constraint v -> [Maybe v]
vars = ((Maybe v, Integer) -> Maybe v
forall a b. (a, b) -> a
fst ((Maybe v, Integer) -> Maybe v)
-> [(Maybe v, Integer)] -> [Maybe v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Maybe v, Integer)] -> [Maybe v])
-> (Constraint v -> [(Maybe v, Integer)])
-> Constraint v
-> [Maybe v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v -> [(Maybe v, Integer)])
-> (Poly v -> [(Maybe v, Integer)])
-> Constraint v
-> [(Maybe v, Integer)]
forall v a. (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint Poly v -> [(Maybe v, Integer)]
forall k a. Map k a -> [(k, a)]
toList Poly v -> [(Maybe v, Integer)]
forall k a. Map k a -> [(k, a)]
toList

has :: Ord v => Constraint v -> Maybe v -> Bool
has :: Constraint v -> Maybe v -> Bool
has = (Poly v -> Maybe v -> Bool)
-> (Poly v -> Maybe v -> Bool) -> Constraint v -> Maybe v -> Bool
forall v a. (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint (\Poly v
p -> Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Integer -> Bool)
-> (Maybe v -> Maybe Integer) -> Maybe v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v
p Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!?)) (\Poly v
p -> Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Integer -> Bool)
-> (Maybe v -> Maybe Integer) -> Maybe v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v
p Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!?))

selfContained :: Constraint v -> Bool
selfContained :: Constraint v -> Bool
selfContained = (Poly v -> Bool) -> (Poly v -> Bool) -> Constraint v -> Bool
forall v a. (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint Poly v -> Bool
forall k a. Map k a -> Bool
null ((Poly v -> Bool) -> Constraint v -> Bool)
-> (Poly v -> Bool) -> Constraint v -> Bool
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> Poly v -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0)

isDerivFrom :: Ord v => Constraint v -> Constraint v -> Bool
Eq Poly v
w isDerivFrom :: Constraint v -> Constraint v -> Bool
`isDerivFrom` Eq Poly v
g = Poly v
w Poly v -> Poly v -> Bool
forall a. Eq a => a -> a -> Bool
== Poly v
g
Geq Poly v
w `isDerivFrom` Eq Poly v
g = Poly v
w Poly v -> Poly v -> Bool
forall v. Ord v => Poly v -> Poly v -> Bool
`isGeqThan` Poly v
g
Geq Poly v
w `isDerivFrom` Geq Poly v
g = Poly v
w Poly v -> Poly v -> Bool
forall v. Ord v => Poly v -> Poly v -> Bool
`isGeqThan` Poly v
g
Constraint v
_ `isDerivFrom` Constraint v
_ = Bool
False

-- CONVERT

positives :: Constraint v -> Constraint v
positives :: Constraint v -> Constraint v
positives = (Poly v -> Constraint v)
-> (Poly v -> Constraint v) -> Constraint v -> Constraint v
forall v a. (Poly v -> a) -> (Poly v -> a) -> Constraint v -> a
constraint Poly v -> Constraint v
forall v. Poly v -> Constraint v
Eq ((Poly v -> Constraint v) -> Constraint v -> Constraint v)
-> (Poly v -> Constraint v) -> Constraint v -> Constraint v
forall a b. (a -> b) -> a -> b
$ Poly v -> Constraint v
forall v. Poly v -> Constraint v
Geq (Poly v -> Constraint v)
-> (Poly v -> Poly v) -> Poly v -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> Poly v -> Poly v
forall a k. (a -> Bool) -> Map k a -> Map k a
filter (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0)

eliminate ::
	Ord v => Maybe v -> Constraint v -> Constraint v -> Maybe (Constraint v)
eliminate :: Maybe v -> Constraint v -> Constraint v -> Maybe (Constraint v)
eliminate Maybe v
v (Eq Poly v
l) (Eq Poly v
r) = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Eq (Poly v -> Constraint v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
posit (Poly v -> Poly v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v -> Poly v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v -> Poly v -> Poly v) -> (Poly v, Poly v) -> Poly v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
(.+) ((Poly v, Poly v) -> Constraint v)
-> Maybe (Poly v, Poly v) -> Maybe (Constraint v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> Poly v -> Poly v -> Maybe (Poly v, Poly v)
forall v. Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignEE Maybe v
v Poly v
l Poly v
r
eliminate Maybe v
v (Eq Poly v
l) (Geq Poly v
r) = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Geq (Poly v -> Constraint v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v -> Poly v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v -> Poly v -> Poly v) -> (Poly v, Poly v) -> Poly v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
(.+) ((Poly v, Poly v) -> Constraint v)
-> Maybe (Poly v, Poly v) -> Maybe (Constraint v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> Poly v -> Poly v -> Maybe (Poly v, Poly v)
forall v. Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignEG Maybe v
v Poly v
l Poly v
r
eliminate Maybe v
v (Geq Poly v
l) (Geq Poly v
r) = Poly v -> Constraint v
forall v. Poly v -> Constraint v
Geq (Poly v -> Constraint v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Constraint v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poly v -> Poly v
forall v. Poly v -> Poly v
reduce (Poly v -> Poly v)
-> ((Poly v, Poly v) -> Poly v) -> (Poly v, Poly v) -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Poly v -> Poly v -> Poly v) -> (Poly v, Poly v) -> Poly v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Poly v -> Poly v -> Poly v
forall v. Ord v => Poly v -> Poly v -> Poly v
(.+) ((Poly v, Poly v) -> Constraint v)
-> Maybe (Poly v, Poly v) -> Maybe (Constraint v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> Poly v -> Poly v -> Maybe (Poly v, Poly v)
forall v. Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignGG Maybe v
v Poly v
l Poly v
r
eliminate Maybe v
v Constraint v
l Constraint v
r = Maybe v -> Constraint v -> Constraint v -> Maybe (Constraint v)
forall v.
Ord v =>
Maybe v -> Constraint v -> Constraint v -> Maybe (Constraint v)
eliminate Maybe v
v Constraint v
r Constraint v
l

type Aligned v = Maybe (Poly v, Poly v)

alignEE :: Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignEE :: Maybe v -> Poly v -> Poly v -> Aligned v
alignEE Maybe v
v Poly v
l Poly v
r =
	(((Integer, Integer) -> (Poly v, Poly v))
-> Maybe (Integer, Integer) -> Aligned v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Integer -> Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer -> (Integer, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v
l Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v Maybe (Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Poly v
r Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v)) \(Integer
m, Integer
s) -> (Poly v
l Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` Integer
s, Poly v
r Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` (- Integer
m))

alignEG :: Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignEG :: Maybe v -> Poly v -> Poly v -> Aligned v
alignEG Maybe v
v Poly v
l Poly v
r = (((Integer, Integer) -> (Poly v, Poly v))
-> Maybe (Integer, Integer) -> Aligned v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Integer -> Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer -> (Integer, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v
l Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v Maybe (Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Poly v
r Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v)) \(Integer
m, Integer
s) ->
	(Poly v
l Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` (- Integer -> Integer
forall a. Num a => a -> a
signum Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s), Poly v
r Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` Integer -> Integer
forall a. Num a => a -> a
abs Integer
m)

alignGG :: Ord v => Maybe v -> Poly v -> Poly v -> Aligned v
alignGG :: Maybe v -> Poly v -> Poly v -> Aligned v
alignGG Maybe v
v Poly v
l Poly v
r = (,) (Integer -> Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer -> (Integer, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v
l Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v Maybe (Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Poly v
r Poly v -> Maybe v -> Maybe Integer
forall k a. Ord k => Map k a -> k -> Maybe a
!? Maybe v
v Maybe (Integer, Integer)
-> ((Integer, Integer) -> Aligned v) -> Aligned v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
m, Integer
s) ->
	(Poly v
l Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` Integer -> Integer
forall a. Num a => a -> a
abs Integer
s, Poly v
r Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul` Integer -> Integer
forall a. Num a => a -> a
abs Integer
m) (Poly v, Poly v) -> Maybe () -> Aligned v
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0)

---------------------------------------------------------------------------
-- POLYNOMIAL
---------------------------------------------------------------------------

-- TYPE POLY

type Poly v = Map (Maybe v) Integer

polyToLog :: IsString s => [(Maybe v, Integer)] -> Log s v
polyToLog :: [(Maybe v, Integer)] -> Log s v
polyToLog [] = Log s v
"0"
polyToLog [(Maybe v, Integer)]
ps = Log s v -> [Log s v] -> Log s v
forall s v. Log s v -> [Log s v] -> Log s v
intersperse Log s v
" + " ([Log s v] -> Log s v) -> [Log s v] -> Log s v
forall a b. (a -> b) -> a -> b
$ (Maybe v, Integer) -> Log s v
forall s v. IsString s => (Maybe v, Integer) -> Log s v
polyToLog1 ((Maybe v, Integer) -> Log s v)
-> [(Maybe v, Integer)] -> [Log s v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe v, Integer)]
ps

polyToLog1 :: IsString s => (Maybe v, Integer) -> Log s v
polyToLog1 :: (Maybe v, Integer) -> Log s v
polyToLog1 (Maybe v
Nothing, Integer
n) = String -> Log s v
forall a. IsString a => String -> a
fromString (String -> Log s v) -> String -> Log s v
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n
polyToLog1 (Just v
v, Integer
n) = String -> Log s v
forall a. IsString a => String -> a
fromString (Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * ") Log s v -> Log s v -> Log s v
forall s v. Log s v -> Log s v -> Log s v
.+. v -> Log s v
forall v s. v -> Log s v
logVar v
v

-- CONSTRUCT

(.+), (.-) :: Ord v => Poly v -> Poly v -> Poly v
.+ :: Poly v -> Poly v -> Poly v
(.+) = SimpleWhenMissing (Maybe v) Integer Integer
-> SimpleWhenMissing (Maybe v) Integer Integer
-> SimpleWhenMatched (Maybe v) Integer Integer Integer
-> Poly v
-> Poly v
-> Poly v
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing (Maybe v) Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing SimpleWhenMissing (Maybe v) Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing
	((Maybe v -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched (Maybe v) Integer Integer Integer
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched \Maybe v
_ Integer
a Integer
b -> Integer -> Maybe () -> Maybe Integer
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (Integer -> Maybe () -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe () -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer
forall a. a -> a
id (Integer -> Maybe () -> Maybe Integer)
-> (Integer -> Maybe ()) -> Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Integer -> Bool) -> Integer -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)
.- :: Poly v -> Poly v -> Poly v
(.-) = SimpleWhenMissing (Maybe v) Integer Integer
-> SimpleWhenMissing (Maybe v) Integer Integer
-> SimpleWhenMatched (Maybe v) Integer Integer Integer
-> Poly v
-> Poly v
-> Poly v
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge SimpleWhenMissing (Maybe v) Integer Integer
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
preserveMissing ((Maybe v -> Integer -> Integer)
-> SimpleWhenMissing (Maybe v) Integer Integer
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing ((Maybe v -> Integer -> Integer)
 -> SimpleWhenMissing (Maybe v) Integer Integer)
-> (Maybe v -> Integer -> Integer)
-> SimpleWhenMissing (Maybe v) Integer Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Maybe v -> Integer -> Integer
forall a b. a -> b -> a
const Integer -> Integer
forall a. Num a => a -> a
negate)
	((Maybe v -> Integer -> Integer -> Maybe Integer)
-> SimpleWhenMatched (Maybe v) Integer Integer Integer
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
zipWithMaybeMatched \Maybe v
_ Integer
a Integer
b -> Integer -> Maybe () -> Maybe Integer
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (Integer -> Maybe () -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe () -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer
forall a. a -> a
id (Integer -> Maybe () -> Maybe Integer)
-> (Integer -> Maybe ()) -> Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Integer -> Bool) -> Integer -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
b)

-- READ

isGeqThan :: Ord v => Poly v -> Poly v -> Bool
isGeqThan :: Poly v -> Poly v -> Bool
isGeqThan = (Map (Maybe v) Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Map (Maybe v) Bool -> Bool)
-> (Poly v -> Map (Maybe v) Bool) -> Poly v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Poly v -> Map (Maybe v) Bool) -> Poly v -> Bool)
-> (Poly v -> Poly v -> Map (Maybe v) Bool)
-> Poly v
-> Poly v
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleWhenMissing (Maybe v) Integer Bool
-> SimpleWhenMissing (Maybe v) Integer Bool
-> SimpleWhenMatched (Maybe v) Integer Integer Bool
-> Poly v
-> Poly v
-> Map (Maybe v) Bool
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge
	((Maybe v -> Integer -> Bool)
-> SimpleWhenMissing (Maybe v) Integer Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Maybe v
_ Integer
nl -> Integer
nl Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0)
	((Maybe v -> Integer -> Bool)
-> SimpleWhenMissing (Maybe v) Integer Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Maybe v
_ Integer
nr -> Integer
nr Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0) ((Maybe v -> Integer -> Integer -> Bool)
-> SimpleWhenMatched (Maybe v) Integer Integer Bool
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched ((Maybe v -> Integer -> Integer -> Bool)
 -> SimpleWhenMatched (Maybe v) Integer Integer Bool)
-> (Maybe v -> Integer -> Integer -> Bool)
-> SimpleWhenMatched (Maybe v) Integer Integer Bool
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Bool)
-> Maybe v -> Integer -> Integer -> Bool
forall a b. a -> b -> a
const Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=))

-- CONVERT

posit :: Poly v -> Poly v
posit :: Poly v -> Poly v
posit Poly v
p = Poly v
p Poly v
-> ((Maybe v, Integer) -> Poly v)
-> Maybe (Maybe v, Integer)
-> Poly v
forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` ((Poly v
p Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
`mul`) (Integer -> Poly v)
-> ((Maybe v, Integer) -> Integer) -> (Maybe v, Integer) -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
signum (Integer -> Integer)
-> ((Maybe v, Integer) -> Integer) -> (Maybe v, Integer) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe v, Integer) -> Integer
forall a b. (a, b) -> b
snd) (Maybe (Maybe v, Integer) -> Poly v)
-> Maybe (Maybe v, Integer) -> Poly v
forall a b. (a -> b) -> a -> b
$ Poly v -> Maybe (Maybe v, Integer)
forall k a. Map k a -> Maybe (k, a)
lookupMin Poly v
p

reduce :: Poly v -> Poly v
reduce :: Poly v -> Poly v
reduce = Poly v -> Integer -> Poly v
forall v. Poly v -> Integer -> Poly v
divide (Poly v -> Integer -> Poly v)
-> (Poly v -> Poly v) -> Poly v -> Integer -> Poly v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v -> Poly v
forall a. a -> a
id (Poly v -> Integer -> Poly v)
-> (Poly v -> Integer) -> Poly v -> Poly v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> Integer -> Integer) -> Integer -> Poly v -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd Integer
0

mul, divide :: Poly v -> Integer -> Poly v
mul :: Poly v -> Integer -> Poly v
mul Poly v
p = ((Integer -> Integer) -> Poly v -> Poly v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v
p) ((Integer -> Integer) -> Poly v)
-> (Integer -> Integer -> Integer) -> Integer -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*); divide :: Poly v -> Integer -> Poly v
divide Poly v
p = ((Integer -> Integer) -> Poly v -> Poly v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Poly v
p) ((Integer -> Integer) -> Poly v)
-> (Integer -> Integer -> Integer) -> Integer -> Poly v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div