[Haskell-beginners] Traverse tree with computing current level using Foldable instance.

Dmitriy Matrosov sgf.dma at gmail.com
Wed May 23 12:51:02 CEST 2012


On 05/22/12 06:18, Brent Yorgey wrote:
>>
>> As you can see, this just selects all elements at particular tree level.
>>
>> So, my foldMapS2 looks similar to foldMap from Foldable, but i can't
>> figure out, how should i define instances of Foldable (and Monoid?)
>> to achieve the same functionality?
>
> You cannot.  Foldable is not general enough; it does not allow you to
> define folds which can observe the *structure* of the container being
> folded over (such as the level in a tree, the number of children of a
> given node, etc.).  It corresponds to simply "flattening" the
> structure into a list of elements, turning each of them into a value
> of some monoid, and then applying mconcat.
>
> However, you should be able to define a general fold for Tape, with
> type
>
>    foldTape :: (a ->  [b] ->  b) ->  Tape a ->  b
>
> and then define foldMapS2 in terms of foldTape.
>
> -Brent

Hi, Brent, and thanks for the answer! I've tried to define foldTape and then
foldMapS2 using it, i've tried.. ugh, i think everything, with fold and with
map, but i still can't.

Well, this is the whole story. I repeat part of the previous message, 
since i
refer to it later. Here is my tree definition, test tree and test function:

import Data.Monoid
import Control.Monad.State

type TpName             =  String
type TpLevel            =  Int
type TpState a          =  State TpLevel a
data Tape a             =  Tape a [Tape a]

-- Oldest first. I.e. tape "B" is older, than tape "D", etc.
testTape                :: Tape TpName
testTape                =  Tape "A" [ Tape "B"  [ Tape "C" []
                                                 , Tape "F" [Tape "G" [
                                                                 Tape 
"H" []]]
                                                 , Tape "E" []
                                                 ]
                                     , Tape "D"  [ Tape "I" []]
                                     ]
testFoldMapS    :: ((a -> TpState [a]) -> TpState (Tape a) -> TpState 
[a]) ->
                    Int -> Tape a -> ([a], Int)
testFoldMapS foldMapS i t =
     runState    (foldMapS   (\x -> get >>= \cs ->
                                    if cs == i then  return [x]
                                      else           return mempty)
                             (return t))
                 0

Test function invokes specified foldMapS with function, which adds 
(mappends)
to list only elements at particular tree level.

Here is my previous foldMapS function for Tape tree, which counts tree level
using State monad:

foldMapS2               :: (Monoid m) =>
                            (a -> TpState m) -> TpState (Tape a) -> 
TpState m
foldMapS2 f tt          =  do
     t@(Tape name ts) <- tt
     foldr (go f) (f name) ts
   where
     go                  :: (Monoid m) =>
                            (a -> TpState m) -> Tape a -> TpState m -> 
TpState m
     go f t mz           =  do
         cs <- get
         x <- foldMapS2 f (State (\s -> (t, s + 1)))
         put cs
         z <- mz
         put cs
         return (x `mappend` z)


First, i've tried to define foldTape like

foldTape                :: (a -> [b] -> b) -> Tape a -> b
foldTape f (Tape name ts)
                         =  f name $ map (foldTape f) ts

and then i've rewritten foldMapS2 using map and sequence instead of foldr:

foldMapSm3              :: (Monoid m) =>
                            (a -> TpState m) -> TpState (Tape a) -> 
TpState m
foldMapSm3 f mt         =
     mt >>= \(Tape name ts) ->
     get >>= \cs ->
     sequenceS cs (f name)
         $ map (\t -> foldMapSm3 f (State (\s -> (t, s + 1)))) ts
   where
     sequenceS           :: (Monoid m) =>
                            s -> State s m -> [State s m] -> State s m
     sequenceS cs z []   =  z >>= \x ->
                            put cs >> return x
     sequenceS cs z (mx : mxs)
                         =  mx >>= \x ->
                            put cs >> sequenceS cs z mxs >>= \y ->
                            put cs >> return (x `mappend` y)


i need to redefine sequence, because library's sequence does not reset state
(with (put cs)), when bind-ing list elements.

and then i've tried to define foldMapSm3 using foldTape:

foldMapSt               :: (Monoid m) =>
                            (a -> TpState m) -> TpState (Tape a) -> 
TpState m
foldMapSt f mt          =
     mt >>= \t ->
     get >>= \cs ->
     foldTape (sequenceS cs) t
   where
     --sequenceS           :: (Monoid m) => Int -> a -> [TpState m] ->
     --                       TpState m
     sequenceS cs name [] = f name
     sequenceS cs name (mx : mxs)
                         =  mx >>= \x ->
                            put cs >> sequenceS cs name mxs >>= \y ->
                            put cs >> return (x `mappend` y)

but, as you may notice, it will not work. Result will be

 > testFoldMapS foldMapSt 0 testTape
(["C","H","G","F","E","B","I","D","A"],0)

because in foldMapSt state change part, when recursively processing list of
Tape elements (childrens), is missed. I.e. in foldMapSm3 map will call

     foldMapSm3 f (State (\s -> (t, s + 1)))

for each list element, but foldTape from foldMapSt will simple call itself

     foldTape f

and then (sequenceS cs), which rely on someone setting cs
(current state) correctly.

Then i return again to foldMapS2 and try to split it into two functions, 
like
so

foldTapeF               :: (Monad m, Monoid b) => (a -> m b) ->
                            ((a -> m b) -> Tape a -> m b -> m b) ->
                            m (Tape a) -> m b
foldTapeF f go mt       =  mt >>= \(Tape name ts) -> foldr (go f) (f 
name) ts
foldTapeGo              :: (Monoid m) =>
                            (a -> TpState m) -> Tape a -> TpState m -> 
TpState m
foldTapeGo f t mz  =  do
     cs <- get
     x <- foldTapeF f foldTapeGo (State (\s -> (t, s + 1)))
     put cs
     z <- mz
     put cs
     return (x `mappend` z)

but.. umm, i don't think this code is better, than foldMapS2. There have 
been
other attempts, but all of them are walking in a circle, and all of them 
have
failed.

So, am i missing something? Or may be i should change tree definition? 
Can you
give me more hints, please? :)

And, after all, what is idiomatic haskell way of folding tree, with 
function, which should have access to tree level (depth)?

--
     Dmitriy Matrosov




More information about the Beginners mailing list