-- 
-- (c) Susumu Katayama
--
module MagicHaskeller.ClassifyTr where
import MagicHaskeller.T10
import Control.Monad.Search.Combinatorial
import Control.Monad

import MagicHaskeller.TimeOut

-- Just for filterTr
import MagicHaskeller.MyDynamic
import MagicHaskeller.Instantiate
import MagicHaskeller.Expression
import MagicHaskeller.ProgramGenerator(Common(..))
import MagicHaskeller.Options(Opt(..))
import MagicHaskeller.Types
import MagicHaskeller.ClassifyDM(spreexecuteDM)
import MagicHaskeller.Classify(cmpBot)

import Debug.Trace

filterTr :: Common -> Type -> Matrix AnnExpr -> (Stream (Forest ([Dynamic], AnnExpr)), Stream (Forest ([Dynamic], AnnExpr)), Matrix AnnExpr)
filterTr :: Common
-> Type
-> Matrix AnnExpr
-> (Stream (Forest ([Dynamic], AnnExpr)),
    Stream (Forest ([Dynamic], AnnExpr)), Matrix AnnExpr)
filterTr Common
cmn Type
typ
    = case [Int]
-> TyConLib -> RTrie -> Type -> Maybe ([[Dynamic]], PackedOrd)
typeToRandomsOrdDM [Int]
nrnds (Common -> TyConLib
tcl Common
cmn) (Common -> RTrie
rt Common
cmn) Type
typ of
        Maybe ([[Dynamic]], PackedOrd)
Nothing         -> \Matrix AnnExpr
x -> (Stream (Forest ([Dynamic], AnnExpr))
forall a. HasCallStack => a
undefined, Stream (Forest ([Dynamic], AnnExpr))
forall a. HasCallStack => a
undefined, Matrix AnnExpr
x)
        Just ([], PackedOrd
op)   -> \Matrix AnnExpr
x -> (Stream (Forest ([Dynamic], AnnExpr))
forall a. HasCallStack => a
undefined, Stream (Forest ([Dynamic], AnnExpr))
forall a. HasCallStack => a
undefined, (Bag AnnExpr -> Bag AnnExpr) -> Matrix AnnExpr -> Matrix AnnExpr
forall (m :: * -> *) a b.
Search m =>
(Bag a -> Bag b) -> m a -> m b
mapDepth ((AnnExpr -> AnnExpr -> AnnExpr)
-> (AnnExpr -> AnnExpr -> Maybe Ordering)
-> Bag AnnExpr
-> Bag AnnExpr
forall k. (k -> k -> k) -> (k -> k -> Maybe Ordering) -> [k] -> [k]
mergesortWithByBot AnnExpr -> AnnExpr -> AnnExpr
forall a b. a -> b -> a
const (\(AE CoreExpr
_ Dynamic
k) (AE CoreExpr
_ Dynamic
l) -> (PackedOrd, Opt ()) -> Dynamic -> Dynamic -> Maybe Ordering
forall t1 t2 a2 a1.
(t1 -> t2 -> a2, Opt a1) -> t1 -> t2 -> Maybe a2
cmpBot (PackedOrd
op, Common -> Opt ()
opt Common
cmn) Dynamic
k Dynamic
l)) Matrix AnnExpr
x)
        Just ([[Dynamic]]
rndss,PackedOrd
op) -> -- trace ("take 1 rndss = "++show (take 1 rndss)) $ -- nrndssを表示しようとするとbehaviourが変わる．
                           -- trace ("ty = "++show typ++" and take 10 nrands = "++show (take 10 $ nrands $ opt cmn)) $
                           let finrndss :: [[Dynamic]]
finrndss = (Int -> [Dynamic] -> [Dynamic])
-> [Int] -> [[Dynamic]] -> [[Dynamic]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Dynamic] -> [Dynamic]
forall a. Int -> [a] -> [a]
take [Int]
nrnds [[Dynamic]]
rndss
                               unsafeCmp :: [Dynamic] -> [Dynamic] -> Maybe Ordering
unsafeCmp [Dynamic]
ks [Dynamic]
ls = Opt () -> Ordering -> Maybe Ordering
forall a1 a2. Opt a1 -> a2 -> Maybe a2
unsafeWithPTOOpt (Common -> Opt ()
opt Common
cmn) (PackedOrd -> [Dynamic] -> [Dynamic] -> Ordering
forall a. (a -> a -> Ordering) -> [a] -> [a] -> Ordering
bagCmp PackedOrd
op [Dynamic]
ks [Dynamic]
ls)
                           in ([Dynamic] -> [Dynamic] -> Maybe Ordering)
-> Matrix ([[Dynamic]], AnnExpr)
-> (Stream (Forest ([Dynamic], AnnExpr)),
    Stream (Forest ([Dynamic], AnnExpr)), Matrix AnnExpr)
forall key expr.
(key -> key -> Maybe Ordering)
-> Matrix (Stream key, expr)
-> (Stream (Forest (key, expr)), Stream (Forest (key, expr)),
    Matrix expr)
mkTip [Dynamic] -> [Dynamic] -> Maybe Ordering
unsafeCmp (Matrix ([[Dynamic]], AnnExpr)
 -> (Stream (Forest ([Dynamic], AnnExpr)),
     Stream (Forest ([Dynamic], AnnExpr)), Matrix AnnExpr))
-> (Matrix AnnExpr -> Matrix ([[Dynamic]], AnnExpr))
-> Matrix AnnExpr
-> (Stream (Forest ([Dynamic], AnnExpr)),
    Stream (Forest ([Dynamic], AnnExpr)), Matrix AnnExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnExpr -> ([[Dynamic]], AnnExpr))
-> Matrix AnnExpr -> Matrix ([[Dynamic]], AnnExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dynamic -> Dynamic)
-> [[Dynamic]] -> AnnExpr -> ([[Dynamic]], AnnExpr)
spreexecuteDM (Dynamic -> Type -> Dynamic -> Dynamic
uncurryDyn (TyConLib -> Dynamic
mkUncurry (TyConLib -> Dynamic) -> TyConLib -> Dynamic
forall a b. (a -> b) -> a -> b
$ Common -> TyConLib
tcl Common
cmn) Type
typ) [[Dynamic]]
finrndss)
      where nrnds :: [Int]
nrnds = Opt () -> [Int]
forall a. Opt a -> [Int]
nrands (Opt () -> [Int]) -> Opt () -> [Int]
forall a b. (a -> b) -> a -> b
$ Common -> Opt ()
opt Common
cmn
bagCmp :: (a->a->Ordering) -> [a] -> [a] -> Ordering
bagCmp :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
bagCmp a -> a -> Ordering
_   []     []     = Ordering
EQ
bagCmp a -> a -> Ordering
cmp (a
x:[a]
xs) (a
y:[a]
ys) = case a -> a -> Ordering
cmp a
x a
y of Ordering
EQ -> (a -> a -> Ordering) -> [a] -> [a] -> Ordering
forall a. (a -> a -> Ordering) -> [a] -> [a] -> Ordering
bagCmp a -> a -> Ordering
cmp [a]
xs [a]
ys
                                           Ordering
c  -> Ordering
c
-- other cases should not happen

type Forest k = [Tree k]
data Tree k = Tr k (Forest k) deriving Int -> Tree k -> ShowS
[Tree k] -> ShowS
Tree k -> String
(Int -> Tree k -> ShowS)
-> (Tree k -> String) -> ([Tree k] -> ShowS) -> Show (Tree k)
forall k. Show k => Int -> Tree k -> ShowS
forall k. Show k => [Tree k] -> ShowS
forall k. Show k => Tree k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree k] -> ShowS
$cshowList :: forall k. Show k => [Tree k] -> ShowS
show :: Tree k -> String
$cshow :: forall k. Show k => Tree k -> String
showsPrec :: Int -> Tree k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Tree k -> ShowS
Show

prop_mkTip :: Matrix (a -> b, a) -> Bool
prop_mkTip Matrix (a -> b, a)
mx = let mxx :: Matrix ([b], a)
mxx = ((a -> b, a) -> ([b], a)) -> Matrix (a -> b, a) -> Matrix ([b], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a -> b
f,a
e) -> ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a
0..], a
e)) Matrix (a -> b, a)
mx
                    (Stream (Forest (b, a))
_,Stream (Forest (b, a))
_,Matrix a
res) = (b -> b -> Maybe Ordering)
-> Matrix ([b], a)
-> (Stream (Forest (b, a)), Stream (Forest (b, a)), Matrix a)
forall key expr.
(key -> key -> Maybe Ordering)
-> Matrix (Stream key, expr)
-> (Stream (Forest (key, expr)), Stream (Forest (key, expr)),
    Matrix expr)
mkTip (\b
ks b
ls -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
ks b
ls)) Matrix ([b], a)
mxx
                in Int -> [Bag a] -> [Bag a]
forall a. Int -> [a] -> [a]
take Int
10 (Matrix a -> [Bag a]
forall a. Matrix a -> Stream (Bag a)
unMx Matrix a
res) [Bag a] -> [Bag a] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Bag a] -> [Bag a]
forall a. Int -> [a] -> [a]
take Int
10 (Matrix a -> [Bag a]
forall a. Matrix a -> Stream (Bag a)
unMx Matrix a
res)

mkTip :: -- Show expr =>
         (key->key->Maybe Ordering) -> Matrix (Stream key, expr) -> (Stream (Forest (key, expr)), Stream (Forest (key, expr)), Matrix expr)
mkTip :: (key -> key -> Maybe Ordering)
-> Matrix (Stream key, expr)
-> (Stream (Forest (key, expr)), Stream (Forest (key, expr)),
    Matrix expr)
mkTip key -> key -> Maybe Ordering
cmp Matrix (Stream key, expr)
mx = let fs :: Stream (Forest (key, expr))
fs  = (key -> key -> Maybe Ordering)
-> Matrix (Stream key, expr) -> Stream (Forest (key, expr))
forall k r.
(k -> k -> Maybe Ordering)
-> Matrix (Stream k, r) -> Stream (Forest (k, r))
mkForests key -> key -> Maybe Ordering
cmp Matrix (Stream key, expr)
mx
                   cmpFst :: (key, b) -> (key, b) -> Maybe Ordering
cmpFst (key
x,b
_) (key
y,b
_) = key -> key -> Maybe Ordering
cmp key
x key
y
                   acc :: Stream (Forest (key, expr))
acc = ((key, expr) -> (key, expr) -> Maybe Ordering)
-> Stream (Forest (key, expr)) -> Stream (Forest (key, expr))
forall k.
(k -> k -> Maybe Ordering)
-> Stream (Forest k) -> Stream (Forest k)
accumulateForests (key, expr) -> (key, expr) -> Maybe Ordering
forall b b. (key, b) -> (key, b) -> Maybe Ordering
cmpFst Stream (Forest (key, expr))
fs
                   filtered :: Matrix expr
filtered = ((key, expr) -> expr) -> Matrix (key, expr) -> Matrix expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (key, expr) -> expr
forall a b. (a, b) -> b
snd (Matrix (key, expr) -> Matrix expr)
-> Matrix (key, expr) -> Matrix expr
forall a b. (a -> b) -> a -> b
$ ((key, expr) -> (key, expr) -> Maybe Ordering)
-> Stream (Forest (key, expr))
-> Stream (Forest (key, expr))
-> Matrix (key, expr)
forall k.
(k -> k -> Maybe Ordering)
-> Stream (Forest k) -> Stream (Forest k) -> Matrix k
difference (key, expr) -> (key, expr) -> Maybe Ordering
forall b b. (key, b) -> (key, b) -> Maybe Ordering
cmpFst Stream (Forest (key, expr))
fs ([]Forest (key, expr)
-> Stream (Forest (key, expr)) -> Stream (Forest (key, expr))
forall a. a -> [a] -> [a]
:Stream (Forest (key, expr))
acc)
               in (Stream (Forest (key, expr))
fs, Stream (Forest (key, expr))
acc, Matrix expr
filtered)


mkForests :: (k->k->Maybe Ordering) -> Matrix (Stream k, r) -> Stream (Forest (k,r))
mkForests :: (k -> k -> Maybe Ordering)
-> Matrix (Stream k, r) -> Stream (Forest (k, r))
mkForests k -> k -> Maybe Ordering
cmp (Mx Stream (Bag (Stream k, r))
xss) = (Bag (Stream k, r) -> Forest (k, r))
-> Stream (Bag (Stream k, r)) -> Stream (Forest (k, r))
forall a b. (a -> b) -> [a] -> [b]
map ((k -> k -> Maybe Ordering) -> Bag (Stream k, r) -> Forest (k, r)
forall k r.
(k -> k -> Maybe Ordering) -> [(Stream k, r)] -> Forest (k, r)
mkForest k -> k -> Maybe Ordering
cmp) Stream (Bag (Stream k, r))
xss
{-
mkForests :: Show r => (k->k->Ordering) -> Matrix (Stream k, r) -> Stream (Forest (k,r))
mkForests cmp (Mx xss) = map (\xs -> trace ("before filtration"++ show (map snd xs)) $
                                     mkForest cmp xs) xss
-}
mkForest :: (k->k->Maybe Ordering) -> [(Stream k,r)] -> Forest (k,r) -- Stream kなので，[(Stream k,r)]をあらかじめソートできないことに注意．
mkForest :: (k -> k -> Maybe Ordering) -> [(Stream k, r)] -> Forest (k, r)
mkForest k -> k -> Maybe Ordering
cmp = ((k, [(Stream k, r)]) -> Tree (k, r))
-> [(k, [(Stream k, r)])] -> Forest (k, r)
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k,ts :: [(Stream k, r)]
ts@((Stream k
_,r
r):[(Stream k, r)]
_)) -> (k, r) -> Forest (k, r) -> Tree (k, r)
forall k. k -> Forest k -> Tree k
Tr (k
k, r
r) ((k -> k -> Maybe Ordering) -> [(Stream k, r)] -> Forest (k, r)
forall k r.
(k -> k -> Maybe Ordering) -> [(Stream k, r)] -> Forest (k, r)
mkForest k -> k -> Maybe Ordering
cmp [(Stream k, r)]
ts)) ([(k, [(Stream k, r)])] -> Forest (k, r))
-> ([(Stream k, r)] -> [(k, [(Stream k, r)])])
-> [(Stream k, r)]
-> Forest (k, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, [(Stream k, r)])
 -> (k, [(Stream k, r)]) -> (k, [(Stream k, r)]))
-> ((k, [(Stream k, r)]) -> (k, [(Stream k, r)]) -> Maybe Ordering)
-> [(k, [(Stream k, r)])]
-> [(k, [(Stream k, r)])]
forall k. (k -> k -> k) -> (k -> k -> Maybe Ordering) -> [k] -> [k]
mergesortWithByBot (\(k
k,[(Stream k, r)]
xs) (k
_,[(Stream k, r)]
ys) -> (k
k,[(Stream k, r)]
xs[(Stream k, r)] -> [(Stream k, r)] -> [(Stream k, r)]
forall a. [a] -> [a] -> [a]
++[(Stream k, r)]
ys)) (\(k
k,[(Stream k, r)]
_) (k
l,[(Stream k, r)]
_) -> k -> k -> Maybe Ordering
cmp k
k k
l) ([(k, [(Stream k, r)])] -> [(k, [(Stream k, r)])])
-> ([(Stream k, r)] -> [(k, [(Stream k, r)])])
-> [(Stream k, r)]
-> [(k, [(Stream k, r)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Stream k, r) -> (k, [(Stream k, r)]))
-> [(Stream k, r)] -> [(k, [(Stream k, r)])]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k:Stream k
ks, r
r) -> (k
k,[(Stream k
ks,r
r)]))
-- もう一つの実装方法: どっちが効率的かは? mkForest cmp [(ks,r)]は[mkTree cmp ks r]みたいにspecializeしたものを用意した方がいいかも．
-- mkForest cmp = map (\(Tr k ts@(Tr (_,r) _ : _)) -> Tr (k, r) ts) . mergesortWithBy (\(Tr k xs) (Tr _ ys) -> Tr k (mergeForests xs ys)) (\(Tr (k,_) _) (Tr (l,_) _) -> cmp k l) . map (\(k:ks, r) -> (k, mkForest cmp [(ks,r)]))


accumulateForests :: (k->k->Maybe Ordering) -> Stream (Forest k) -> Stream (Forest k)
accumulateForests :: (k -> k -> Maybe Ordering)
-> Stream (Forest k) -> Stream (Forest k)
accumulateForests k -> k -> Maybe Ordering
cmp Stream (Forest k)
forests = Stream (Forest k)
cumulatives
   where cumulatives :: Stream (Forest k)
cumulatives = (Forest k -> Forest k -> Forest k)
-> Stream (Forest k) -> Stream (Forest k) -> Stream (Forest k)
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
cmp) ([]Forest k -> Stream (Forest k) -> Stream (Forest k)
forall a. a -> [a] -> [a]
:Stream (Forest k)
cumulatives) Stream (Forest k)
forests
-- mergeってのはmonoid的にはmappendなワケ
mergeForests :: (k->k->Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests :: (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
_   [] Forest k
trs = Forest k
trs
mergeForests k -> k -> Maybe Ordering
_   Forest k
tls [] = Forest k
tls
mergeForests k -> k -> Maybe Ordering
cmp tls :: Forest k
tls@((tl :: Tree k
tl@(Tr k
kl Forest k
fl)) : Forest k
rls)
                 trs :: Forest k
trs@((tr :: Tree k
tr@(Tr k
kr Forest k
fr)) : Forest k
rrs)
                    = case k -> k -> Maybe Ordering
cmp k
kl k
kr of Just Ordering
LT -> Tree k
tl                   Tree k -> Forest k -> Forest k
forall a. a -> [a] -> [a]
: (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
cmp Forest k
rls Forest k
trs
                                        Just Ordering
GT -> Tree k
tr                   Tree k -> Forest k -> Forest k
forall a. a -> [a] -> [a]
: (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
cmp Forest k
tls Forest k
rrs
                                        Maybe Ordering
_ -> k -> Forest k -> Tree k
forall k. k -> Forest k -> Tree k
Tr k
kl ((k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
cmp Forest k
fl Forest k
fr) Tree k -> Forest k -> Forest k
forall a. a -> [a] -> [a]
: (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Forest k
mergeForests k -> k -> Maybe Ordering
cmp Forest k
rls Forest k
rrs

difference :: (k->k->Maybe Ordering) -> Stream (Forest k) -> Stream (Forest k) -> Matrix k
-- difference :: Show x => ((k,x)->(k,x)->Ordering) -> Stream (Forest (k,x)) -> Stream (Forest (k,x)) -> Matrix (k,x)
difference :: (k -> k -> Maybe Ordering)
-> Stream (Forest k) -> Stream (Forest k) -> Matrix k
difference k -> k -> Maybe Ordering
cmp Stream (Forest k)
mx Stream (Forest k)
cumulative
  = -- mapDepth (\xs -> trace ("after filtration" ++ show (map snd xs)) xs)$
    (Matrix k -> Matrix k -> Matrix k)
-> Matrix k -> [Matrix k] -> Matrix k
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Matrix k
x Matrix k
y -> Matrix k
x Matrix k -> Matrix k -> Matrix k
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Matrix k -> Matrix k
forall (m :: * -> *) a. Delay m => m a -> m a
delay Matrix k
y) Matrix k
forall a. HasCallStack => a
undefined ([Matrix k] -> Matrix k) -> [Matrix k] -> Matrix k
forall a b. (a -> b) -> a -> b
$ (Forest k -> Forest k -> Matrix k)
-> Stream (Forest k) -> Stream (Forest k) -> [Matrix k]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
cmp) Stream (Forest k)
mx Stream (Forest k)
cumulative
diff :: (k->k->Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff :: (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
_   []  Forest k
_  = Matrix k
forall (m :: * -> *) a. MonadPlus m => m a
mzero
diff k -> k -> Maybe Ordering
_   Forest k
tls [] = (Matrix k -> Matrix k -> Matrix k) -> [Matrix k] -> Matrix k
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Matrix k -> Matrix k -> Matrix k
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ([Matrix k] -> Matrix k) -> [Matrix k] -> Matrix k
forall a b. (a -> b) -> a -> b
$ (Tree k -> Matrix k) -> Forest k -> [Matrix k]
forall a b. (a -> b) -> [a] -> [b]
map Tree k -> Matrix k
forall k. Tree k -> Matrix k
flattenTr Forest k
tls
diff k -> k -> Maybe Ordering
cmp tls :: Forest k
tls@((tl :: Tree k
tl@(Tr k
kl Forest k
fl)) : Forest k
rls)
         trs :: Forest k
trs@(     Tr k
kr Forest k
fr   : Forest k
rrs)
                   = case k -> k -> Maybe Ordering
cmp k
kl k
kr of Just Ordering
LT -> Tree k -> Matrix k
forall k. Tree k -> Matrix k
flattenTr Tree k
tl                                Matrix k -> Matrix k -> Matrix k
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
cmp Forest k
rls Forest k
trs
                                       Just Ordering
EQ -> Matrix k -> Matrix k
forall (m :: * -> *) a. Delay m => m a -> m a
delay (Matrix k -> Matrix k
forall a. Matrix a -> Matrix a
removeFirstOfFirst ((k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
cmp Forest k
fl Forest k
fr)) Matrix k -> Matrix k -> Matrix k
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
cmp Forest k
rls Forest k
rrs
                                       Maybe Ordering
_  ->                                                     (k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
forall k.
(k -> k -> Maybe Ordering) -> Forest k -> Forest k -> Matrix k
diff k -> k -> Maybe Ordering
cmp Forest k
tls Forest k
rrs
flattenTr :: Tree k -> Matrix k
flattenTr :: Tree k -> Matrix k
flattenTr (Tr k
k Forest k
f) = [k
k] [k] -> Matrix k -> Matrix k
forall a. Bag a -> Matrix a -> Matrix a
`consMx` Matrix k -> Matrix k
forall a. Matrix a -> Matrix a
removeFirstOfFirst ([Matrix k] -> Matrix k
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Matrix k] -> Matrix k) -> [Matrix k] -> Matrix k
forall a b. (a -> b) -> a -> b
$ (Tree k -> Matrix k) -> Forest k -> [Matrix k]
forall a b. (a -> b) -> [a] -> [b]
map Tree k -> Matrix k
forall k. Tree k -> Matrix k
flattenTr Forest k
f)

removeFirstOfFirst :: Matrix a -> Matrix a
removeFirstOfFirst mx :: Matrix a
mx@(Mx ([]:[Bag a]
xss))  = Matrix a
mx
removeFirstOfFirst (Mx ((a
_:Bag a
xs):[Bag a]
xss)) = [Bag a] -> Matrix a
forall a. Stream (Bag a) -> Matrix a
Mx ([Bag a] -> Matrix a) -> [Bag a] -> Matrix a
forall a b. (a -> b) -> a -> b
$ Bag a
xsBag a -> [Bag a] -> [Bag a]
forall a. a -> [a] -> [a]
:[Bag a]
xss -- これが長子を取り除く


{-
*MagicHaskeller.ClassifyTr> case mkTip compare (Mx (((repeat 1, 1):(repeat 1, 2):[]) : repeat [])) of (_,_,x) -> x
Mx {unMx = [[1],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],
-}