{-# LANGUAGE BangPatterns, Safe #-}
module Dep.Algorithm.Synthesis (
synthesis, synthesis'
, synthesisSOP, synthesisSOP'
, synthesisPOS, synthesisPOS'
, WeightedProduct, WeightedSum
, upperbound, lowerbound
, extractProduct, extractSum
, wipeout, wipeout'
) where
import Control.Applicative((<|>))
import Dep.Class.Opposite(opposite)
import Dep.Class.NonDeterministicWalkable(NonDeterministicWalkable(allNstep))
import Dep.Class.Simplify(simplify)
import Dep.Class.Walkable(Walkable(allStep, allWalkValues))
import Dep.Data.LogicItem(Item')
import Dep.Data.Product(Product(Product), Product', SumOfProducts(SumOfProducts), SumOfProducts')
import Dep.Data.Sum(ProductOfSums(ProductOfSums), ProductOfSums', Sum', Sum(Sum))
import Dep.Data.Three(Three(Leaf, Link, Split), depth, wipe)
import Dep.Data.ThreeValue(ThreeValue(DontCare, Zero, One), fromBool, toLower, toUpper)
type WeightedItem = (Int, Item')
type WeightedProduct = (Int, Product')
type WeightedSum = (Int, Sum')
upperbound
:: Three ThreeValue
-> Three Bool
upperbound :: Three ThreeValue -> Three Bool
upperbound = Three Bool -> Three Bool
forall a. Simplify a => a -> a
simplify (Three Bool -> Three Bool)
-> (Three ThreeValue -> Three Bool)
-> Three ThreeValue
-> Three Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThreeValue -> Bool) -> Three ThreeValue -> Three Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ThreeValue -> Bool
toUpper
lowerbound
:: Three ThreeValue
-> Three Bool
lowerbound :: Three ThreeValue -> Three Bool
lowerbound = Three Bool -> Three Bool
forall a. Simplify a => a -> a
simplify (Three Bool -> Three Bool)
-> (Three ThreeValue -> Three Bool)
-> Three ThreeValue
-> Three Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThreeValue -> Bool) -> Three ThreeValue -> Three Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ThreeValue -> Bool
toLower
_pushVal :: (Int -> Int) -> ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal :: (Int -> Int) -> ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal Int -> Int
f ThreeValue
x = (Int, Product') -> (Int, Product')
go
where go :: (Int, Product') -> (Int, Product')
go ~(!Int
n, Product'
xs) = (Int -> Int
f Int
n, ThreeValue
xThreeValue -> Product' -> Product'
forall a. a -> [a] -> [a]
:Product'
xs)
_pushVal' :: ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal' :: ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal' = (Int -> Int) -> ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal Int -> Int
forall a. Enum a => a -> a
succ
_pushVal'' :: (Int, Product') -> (Int, Product')
_pushVal'' :: (Int, Product') -> (Int, Product')
_pushVal'' = (Int -> Int) -> ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal Int -> Int
forall a. a -> a
id ThreeValue
DontCare
extractItem
:: ThreeValue
-> Int
-> Three Bool
-> Three ThreeValue
-> Maybe WeightedItem
ThreeValue
x' Int
k Three Bool
_ = Int -> Three ThreeValue -> Maybe (Int, Product')
go Int
k
where go :: Int -> Three ThreeValue -> Maybe (Int, Product')
go !Int
n (Leaf ThreeValue
x)
| ThreeValue
x ThreeValue -> ThreeValue -> Bool
forall a. Eq a => a -> a -> Bool
== ThreeValue
x' = (Int, Product') -> Maybe (Int, Product')
forall a. a -> Maybe a
Just (Int
0, Int -> ThreeValue -> Product'
forall a. Int -> a -> [a]
replicate Int
n ThreeValue
DontCare)
| Bool
otherwise = Maybe (Int, Product')
forall a. Maybe a
Nothing
go Int
n (Link Three ThreeValue
l) = (Int, Product') -> (Int, Product')
_pushVal'' ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Three ThreeValue -> Maybe (Int, Product')
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Three ThreeValue
l
go Int
n ~(Split Three ThreeValue
la Three ThreeValue
lb) = ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal' ThreeValue
Zero) (Int -> Three ThreeValue -> Maybe (Int, Product')
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Three ThreeValue
la) Maybe (Int, Product')
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal' ThreeValue
One) (Int -> Three ThreeValue -> Maybe (Int, Product')
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Three ThreeValue
lb)
extractProduct
:: Int
-> Three Bool
-> Three ThreeValue
-> Maybe WeightedProduct
= ThreeValue
-> Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
extractItem ThreeValue
One
extractSum
:: Int
-> Three Bool
-> Three ThreeValue
-> Maybe WeightedSum
= ThreeValue
-> Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
extractItem ThreeValue
Zero
wipeout
:: Product'
-> Three ThreeValue
-> Three ThreeValue
wipeout :: Product' -> Three ThreeValue -> Three ThreeValue
wipeout Product'
path = Three ThreeValue -> Three ThreeValue
forall a. Simplify a => a -> a
simplify (Three ThreeValue -> Three ThreeValue)
-> (Three ThreeValue -> Three ThreeValue)
-> Three ThreeValue
-> Three ThreeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product' -> Three ThreeValue -> Three ThreeValue
wipeout' Product'
path
wipeout'
:: Product'
-> Three ThreeValue
-> Three ThreeValue
wipeout' :: Product' -> Three ThreeValue -> Three ThreeValue
wipeout' = ThreeValue -> Product' -> Three ThreeValue -> Three ThreeValue
forall a. a -> Product' -> Three a -> Three a
wipe ThreeValue
DontCare
mergeSide :: (Int -> Maybe WeightedItem) -> Int -> Maybe (Int, Product') -> Maybe WeightedItem
mergeSide :: (Int -> Maybe (Int, Product'))
-> Int -> Maybe (Int, Product') -> Maybe (Int, Product')
mergeSide Int -> Maybe (Int, Product')
f Int
n = Maybe (Int, Product') -> Maybe (Int, Product')
go
where go :: Maybe (Int, Product') -> Maybe (Int, Product')
go Maybe (Int, Product')
Nothing = Int -> Maybe (Int, Product')
f Int
n
go j :: Maybe (Int, Product')
j@(~(Just ~(Int
k, Product'
_))) = Int -> Maybe (Int, Product')
f Int
k Maybe (Int, Product')
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Product')
j
_minimizeItem' :: ([Bool] -> Bool) -> Int -> [Bool] -> [Three Bool] -> Maybe WeightedItem
_minimizeItem' :: ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' [Bool] -> Bool
_ Int
n [Bool]
_ [Three Bool]
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (Int, Product')
forall a. Maybe a
Nothing
_minimizeItem' [Bool] -> Bool
_ Int
_ [] [Three Bool]
_ = (Int, Product') -> Maybe (Int, Product')
forall a. a -> Maybe a
Just (Int
0, [])
_minimizeItem' [Bool] -> Bool
mg Int
n ~(Bool
x:[Bool]
xs) [Three Bool]
thr
| [Bool] -> Bool
mg ([Three Bool] -> [Bool] -> [Bool]
forall (f :: * -> *) step (g :: * -> *) (h :: * -> *) a.
(Walkable f step, Foldable f, Foldable g, Functor g, Foldable h) =>
g (f a) -> h step -> [a]
allWalkValues [Three Bool]
stepdc [Bool]
xs) = (Int -> Maybe (Int, Product'))
-> Int -> Maybe (Int, Product') -> Maybe (Int, Product')
mergeSide (\Int
i -> (Int, Product') -> (Int, Product')
pshVal ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' [Bool] -> Bool
mg (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Bool]
xs ([Three Bool] -> Bool -> [Three Bool]
forall (f :: * -> *) step (g :: * -> *) a.
(Walkable f step, Functor g) =>
g (f a) -> step -> g (f a)
allStep [Three Bool]
thr Bool
x)) Int
n ((Int, Product') -> (Int, Product')
_pushVal'' ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' [Bool] -> Bool
mg Int
n [Bool]
xs [Three Bool]
stepdc)
| Bool
otherwise = (Int, Product') -> (Int, Product')
pshVal ((Int, Product') -> (Int, Product'))
-> Maybe (Int, Product') -> Maybe (Int, Product')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' [Bool] -> Bool
mg (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Bool]
xs [Three Bool]
stepx
where stepdc :: [Three Bool]
stepdc = [Three Bool] -> ThreeValue -> [Three Bool]
forall (f :: * -> *) step (g :: * -> *) a.
(NonDeterministicWalkable f step, Foldable g) =>
g (f a) -> step -> [f a]
allNstep [Three Bool]
thr ThreeValue
DontCare
stepx :: [Three Bool]
stepx = [Three Bool] -> Bool -> [Three Bool]
forall (f :: * -> *) step (g :: * -> *) a.
(Walkable f step, Functor g) =>
g (f a) -> step -> g (f a)
allStep [Three Bool]
thr Bool
x
pshVal :: (Int, Product') -> (Int, Product')
pshVal = ThreeValue -> (Int, Product') -> (Int, Product')
_pushVal' (Bool -> ThreeValue
fromBool Bool
x)
minimizeProduct' :: Int -> [Bool] -> [Three Bool] -> Maybe WeightedProduct
minimizeProduct' :: Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
minimizeProduct' = ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
minimizeSum' :: Int -> [Bool] -> [Three Bool] -> Maybe WeightedSum
minimizeSum' :: Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
minimizeSum' = ([Bool] -> Bool)
-> Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
_minimizeItem' (Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or)
minimizeProduct :: Int -> Product' -> Three Bool -> Product'
minimizeProduct :: Int -> Product' -> Three Bool -> Product'
minimizeProduct Int
wght Product'
prd Three Bool
thr = Product'
-> ((Int, Product') -> Product')
-> Maybe (Int, Product')
-> Product'
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Product'
prd (Int, Product') -> Product'
forall a b. (a, b) -> b
snd (Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
minimizeProduct' Int
wght ((ThreeValue -> Bool) -> Product' -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ThreeValue -> Bool
toUpper Product'
prd) [Three Bool
thr])
minimizeSum :: Int -> Sum' -> Three Bool -> Sum'
minimizeSum :: Int -> Product' -> Three Bool -> Product'
minimizeSum Int
wght Product'
prd Three Bool
thr = Product'
-> ((Int, Product') -> Product')
-> Maybe (Int, Product')
-> Product'
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Product'
prd (Int, Product') -> Product'
forall a b. (a, b) -> b
snd (Int -> [Bool] -> [Three Bool] -> Maybe (Int, Product')
minimizeSum' Int
wght ((ThreeValue -> Bool) -> Product' -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ThreeValue -> Bool
toUpper Product'
prd) [Three Bool
thr])
synthesis
:: Three ThreeValue
-> SumOfProducts
synthesis :: Three ThreeValue -> SumOfProducts
synthesis = [Product] -> SumOfProducts
SumOfProducts ([Product] -> SumOfProducts)
-> (Three ThreeValue -> [Product])
-> Three ThreeValue
-> SumOfProducts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Product' -> Product) -> [Product'] -> [Product]
forall a b. (a -> b) -> [a] -> [b]
map Product' -> Product
Product ([Product'] -> [Product])
-> (Three ThreeValue -> [Product'])
-> Three ThreeValue
-> [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three ThreeValue -> [Product']
synthesis'
synthesisSOP
:: Three ThreeValue
-> SumOfProducts
synthesisSOP :: Three ThreeValue -> SumOfProducts
synthesisSOP = [Product] -> SumOfProducts
SumOfProducts ([Product] -> SumOfProducts)
-> (Three ThreeValue -> [Product])
-> Three ThreeValue
-> SumOfProducts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Product' -> Product) -> [Product'] -> [Product]
forall a b. (a -> b) -> [a] -> [b]
map Product' -> Product
Product ([Product'] -> [Product])
-> (Three ThreeValue -> [Product'])
-> Three ThreeValue
-> [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three ThreeValue -> [Product']
synthesisSOP'
synthesisPOS
:: Three ThreeValue
-> ProductOfSums
synthesisPOS :: Three ThreeValue -> ProductOfSums
synthesisPOS = [Sum] -> ProductOfSums
ProductOfSums ([Sum] -> ProductOfSums)
-> (Three ThreeValue -> [Sum]) -> Three ThreeValue -> ProductOfSums
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Product' -> Sum) -> [Product'] -> [Sum]
forall a b. (a -> b) -> [a] -> [b]
map Product' -> Sum
Sum ([Product'] -> [Sum])
-> (Three ThreeValue -> [Product']) -> Three ThreeValue -> [Sum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three ThreeValue -> [Product']
synthesisPOS'
synthesis'
:: Three ThreeValue
-> SumOfProducts'
synthesis' :: Three ThreeValue -> [Product']
synthesis' = Three ThreeValue -> [Product']
synthesisSOP'
synthesisSOP'
:: Three ThreeValue
-> SumOfProducts'
synthesisSOP' :: Three ThreeValue -> [Product']
synthesisSOP' = (Three ThreeValue -> Three Bool)
-> (Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product'))
-> (Int -> Product' -> Three Bool -> Product')
-> (Product' -> Product')
-> Three ThreeValue
-> [Product']
_genericSynthesis' Three ThreeValue -> Three Bool
upperbound Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
extractProduct Int -> Product' -> Three Bool -> Product'
minimizeProduct Product' -> Product'
forall a. a -> a
id
synthesisPOS'
:: Three ThreeValue
-> ProductOfSums'
synthesisPOS' :: Three ThreeValue -> [Product']
synthesisPOS' = (Three ThreeValue -> Three Bool)
-> (Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product'))
-> (Int -> Product' -> Three Bool -> Product')
-> (Product' -> Product')
-> Three ThreeValue
-> [Product']
_genericSynthesis' Three ThreeValue -> Three Bool
lowerbound Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
extractSum Int -> Product' -> Three Bool -> Product'
minimizeSum Product' -> Product'
forall a. Opposite a => a -> a
opposite
_genericSynthesis'
:: (Three ThreeValue -> Three Bool)
-> (Int -> Three Bool -> Three ThreeValue -> Maybe WeightedItem)
-> (Int -> Item' -> Three Bool -> Item')
-> (Item' -> Item')
-> Three ThreeValue
-> ProductOfSums'
_genericSynthesis' :: (Three ThreeValue -> Three Bool)
-> (Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product'))
-> (Int -> Product' -> Three Bool -> Product')
-> (Product' -> Product')
-> Three ThreeValue
-> [Product']
_genericSynthesis' Three ThreeValue -> Three Bool
toBound Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
_extractItem Int -> Product' -> Three Bool -> Product'
minimize Product' -> Product'
post Three ThreeValue
th = Three ThreeValue -> [Product']
_synthesis Three ThreeValue
_simp
where _bound :: Three Bool
_bound = Three ThreeValue -> Three Bool
toBound Three ThreeValue
_simp
_n :: Int
_n = Three ThreeValue -> Int
forall a. Three a -> Int
depth Three ThreeValue
_simp
_simp :: Three ThreeValue
_simp = Three ThreeValue -> Three ThreeValue
forall a. Simplify a => a -> a
simplify Three ThreeValue
th
_takeItem :: Three ThreeValue -> Maybe (Int, Product')
_takeItem = Int -> Three Bool -> Three ThreeValue -> Maybe (Int, Product')
_extractItem Int
_n Three Bool
_bound
_synthesis :: Three ThreeValue -> [Product']
_synthesis Three ThreeValue
thr
| Just (~(Int
k, Product'
j)) <- Three ThreeValue -> Maybe (Int, Product')
_takeItem Three ThreeValue
thr = let j' :: Product'
j' = Int -> Product' -> Three Bool -> Product'
minimize Int
k Product'
j Three Bool
_bound in Product' -> Product'
post Product'
j' Product' -> [Product'] -> [Product']
forall a. a -> [a] -> [a]
: Three ThreeValue -> [Product']
_synthesis (Product' -> Three ThreeValue -> Three ThreeValue
wipeout Product'
j' Three ThreeValue
thr)
| Bool
otherwise = []