61 lines
1.6 KiB
Haskell
61 lines
1.6 KiB
Haskell
|
{-# OPTIONS_GHC -XNPlusKPatterns #-}
|
||
|
|
|
||
|
|
-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23)
|
||
|
|
|
||
|
|
module FTree where
|
||
|
|
|
||
|
|
import Cp
|
||
|
|
|
||
|
|
-- (1) Datatype definition -----------------------------------------------------
|
||
|
|
|
||
|
|
data FTree a c = Unit c | Comp a (FTree a c, FTree a c) deriving Show
|
||
|
|
|
||
|
|
inFTree = either Unit (uncurry Comp)
|
||
|
|
|
||
|
|
outFTree (Unit c) = Left c
|
||
|
|
outFTree (Comp a (t1,t2)) = Right(a,(t1,t2))
|
||
|
|
|
||
|
|
baseFTree f g h = f -|- (g >< (h >< h))
|
||
|
|
|
||
|
|
-- (2) Ana + cata + hylo -------------------------------------------------------
|
||
|
|
|
||
|
|
recFTree f = baseFTree id id f
|
||
|
|
|
||
|
|
cataFTree a = a . (recFTree (cataFTree a)) . outFTree
|
||
|
|
|
||
|
|
anaFTree f = inFTree . (recFTree (anaFTree f) ) . f
|
||
|
|
|
||
|
|
hyloFTree a c = cataFTree a . anaFTree c
|
||
|
|
|
||
|
|
-- (3) Map ---------------------------------------------------------------------
|
||
|
|
|
||
|
|
instance BiFunctor FTree
|
||
|
|
where bmap f g = cataFTree ( inFTree . baseFTree g f id )
|
||
|
|
|
||
|
|
-- (4) Examples ----------------------------------------------------------------
|
||
|
|
|
||
|
|
-- (4.1) Inversion (mirror) ----------------------------------------------------
|
||
|
|
|
||
|
|
invFTree = cataFTree (inFTree . (id -|- id >< swap))
|
||
|
|
|
||
|
|
-- (4.2) Counting --------------------------------------------------------------
|
||
|
|
|
||
|
|
countFTree = cataFTree (either (const 1) (succ . (uncurry (+)) . p2))
|
||
|
|
|
||
|
|
-- (4.3) Flattening ------------------------------------------------------------
|
||
|
|
|
||
|
|
flatFTree = cataFTree flt
|
||
|
|
|
||
|
|
flt = either singl (cons.(id><conc))
|
||
|
|
|
||
|
|
-- (4.4) Generating lists of Booleans ------------------------------------------
|
||
|
|
|
||
|
|
genBoolTree = anaFTree gbt
|
||
|
|
|
||
|
|
gbt = f where
|
||
|
|
f(0,x)=i1 x
|
||
|
|
f(n+1,x) = i2(x,((n,False:x),(n,True:x)))
|
||
|
|
|
||
|
|
genBools = hyloFTree flt gbt
|
||
|
|
|