-- 
-- (c) Susumu Katayama
--

-- bestのやつだけkeepするやつ．analyticalに適用するとIgorIIと同じになるし，exhaustiveに適用するとDjinnみたいな感じになる．
{-# LANGUAGE MultiParamTypeClasses #-}
module Control.Monad.Search.Best where
import Control.Monad
import Control.Monad.Search.Combinatorial
import Control.Applicative -- necessary for backward compatibility

-- | Unlike 'Matrix', 'Recomp', etc., the 'Best' monad only keeps the best set of results.
--   This makes the analytical synthesis like IgorII, and the exhaustive synthesis like Djinn,
--   i.e., the resulting algorithms are more efficient, but cannot be used for (analytically-)generate-and-test.
data Best a = Result [a] | Delay (Best a) deriving (Int -> Best a -> ShowS
[Best a] -> ShowS
Best a -> String
(Int -> Best a -> ShowS)
-> (Best a -> String) -> ([Best a] -> ShowS) -> Show (Best a)
forall a. Show a => Int -> Best a -> ShowS
forall a. Show a => [Best a] -> ShowS
forall a. Show a => Best a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Best a] -> ShowS
$cshowList :: forall a. Show a => [Best a] -> ShowS
show :: Best a -> String
$cshow :: forall a. Show a => Best a -> String
showsPrec :: Int -> Best a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Best a -> ShowS
Show, ReadPrec [Best a]
ReadPrec (Best a)
Int -> ReadS (Best a)
ReadS [Best a]
(Int -> ReadS (Best a))
-> ReadS [Best a]
-> ReadPrec (Best a)
-> ReadPrec [Best a]
-> Read (Best a)
forall a. Read a => ReadPrec [Best a]
forall a. Read a => ReadPrec (Best a)
forall a. Read a => Int -> ReadS (Best a)
forall a. Read a => ReadS [Best a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Best a]
$creadListPrec :: forall a. Read a => ReadPrec [Best a]
readPrec :: ReadPrec (Best a)
$creadPrec :: forall a. Read a => ReadPrec (Best a)
readList :: ReadS [Best a]
$creadList :: forall a. Read a => ReadS [Best a]
readsPrec :: Int -> ReadS (Best a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Best a)
Read)

-- Note that getBests zero = _|_
getBests :: Best a -> [a]
getBests :: Best a -> [a]
getBests (Result [a]
xs) = [a]
xs
getBests (Delay Best a
b)   = Best a -> [a]
forall a. Best a -> [a]
getBests Best a
b

zero :: Best a
zero = Best a -> Best a
forall a. Best a -> Best a
Delay Best a
zero

instance Functor Best where
    fmap :: (a -> b) -> Best a -> Best b
fmap a -> b
f (Result [a]
xs) = [b] -> Best b
forall a. [a] -> Best a
Result ([b] -> Best b) -> [b] -> Best b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs
    fmap a -> b
f (Delay Best a
b)   = Best b -> Best b
forall a. Best a -> Best a
Delay  (Best b -> Best b) -> Best b -> Best b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Best a -> Best b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Best a
b
instance Applicative Best where
    pure :: a -> Best a
pure a
x = [a] -> Best a
forall a. [a] -> Best a
Result [a
x]
    <*> :: Best (a -> b) -> Best a -> Best b
(<*>)  = Best (a -> b) -> Best a -> Best b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Best where
    return :: a -> Best a
return = a -> Best a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Result [a]
xs >>= :: Best a -> (a -> Best b) -> Best b
>>= a -> Best b
f = [Best b] -> Best b
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Best b] -> Best b) -> [Best b] -> Best b
forall a b. (a -> b) -> a -> b
$ (a -> Best b) -> [a] -> [Best b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Best b
f [a]
xs
    Delay  Best a
b  >>= a -> Best b
f = Best b -> Best b
forall a. Best a -> Best a
Delay (Best b -> Best b) -> Best b -> Best b
forall a b. (a -> b) -> a -> b
$ Best a
b Best a -> (a -> Best b) -> Best b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Best b
f
instance Alternative Best where
    empty :: Best a
empty = Best a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: Best a -> Best a -> Best a
(<|>) = Best a -> Best a -> Best a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus Best where
    mzero :: Best a
mzero = Best a
forall a. Best a
zero
    Result [a]
xs    mplus :: Best a -> Best a -> Best a
`mplus` Result [a]
ys    = [a] -> Best a
forall a. [a] -> Best a
Result ([a] -> Best a) -> [a] -> Best a
forall a b. (a -> b) -> a -> b
$ [a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ys
    b :: Best a
b@(Result [a]
_) `mplus` Delay  Best a
_     = Best a
b
    Delay Best a
_      `mplus` b :: Best a
b@(Result [a]
_) = Best a
b
    Delay Best a
b      `mplus` Delay Best a
c      = Best a -> Best a
forall a. Best a -> Best a
Delay (Best a -> Best a) -> Best a -> Best a
forall a b. (a -> b) -> a -> b
$ Best a
b Best a -> Best a -> Best a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Best a
c
instance Delay Best where
    delay :: Best a -> Best a
delay = Best a -> Best a
forall a. Best a -> Best a
Delay

instance Search  Best where
    fromRc :: Recomp a -> Best a
fromRc             = Matrix a -> Best a
forall (m :: * -> *) a. Search m => Matrix a -> m a
fromMx (Matrix a -> Best a)
-> (Recomp a -> Matrix a) -> Recomp a -> Best a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recomp a -> Matrix a
forall (m :: * -> *) a. Search m => m a -> Matrix a
toMx
    toRc :: Best a -> Recomp a
toRc               = Matrix a -> Recomp a
forall (m :: * -> *) a. Search m => m a -> Recomp a
toRc   (Matrix a -> Recomp a)
-> (Best a -> Matrix a) -> Best a -> Recomp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Best a -> Matrix a
forall (m :: * -> *) a. Search m => m a -> Matrix a
toMx
    fromMx :: Matrix a -> Best a
fromMx (Mx Stream (Bag a)
xss)    = Stream (Bag a) -> Best a
forall a. [[a]] -> Best a
fromLists Stream (Bag a)
xss
    toMx :: Best a -> Matrix a
toMx   (Result [a]
xs) = Stream [a] -> Matrix a
forall a. Stream (Bag a) -> Matrix a
Mx (Stream [a] -> Matrix a) -> Stream [a] -> Matrix a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> Stream [a] -> Stream [a]
forall a. a -> [a] -> [a]
: Matrix a -> Stream [a]
forall a. Matrix a -> Stream (Bag a)
unMx Matrix a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    toMx   (Delay  Best a
b)  = let Mx Stream [a]
xss = Best a -> Matrix a
forall (m :: * -> *) a. Search m => m a -> Matrix a
toMx Best a
b in Stream [a] -> Matrix a
forall a. Stream (Bag a) -> Matrix a
Mx (Stream [a] -> Matrix a) -> Stream [a] -> Matrix a
forall a b. (a -> b) -> a -> b
$ [][a] -> Stream [a] -> Stream [a]
forall a. a -> [a] -> [a]
:Stream [a]
xss
    fromDF :: [a] -> Best a
fromDF             = [a] -> Best a
forall a. [a] -> Best a
Result

fromLists :: [[a]] -> Best a
fromLists :: [[a]] -> Best a
fromLists ([]:[[a]]
xss) = Best a -> Best a
forall a. Best a -> Best a
Delay ([[a]] -> Best a
forall a. [[a]] -> Best a
fromLists [[a]]
xss)
fromLists ([a]
xs:[[a]]
_)   = [a] -> Best a
forall a. [a] -> Best a
Result [a]
xs

instance Memoable Best Best where
    tabulate :: Best a -> Best a
tabulate  = Best a -> Best a
forall a. a -> a
id
    applyMemo :: Best a -> Best a
applyMemo = Best a -> Best a
forall a. a -> a
id