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

On 05/23/12 20:48, Chaddaï Fouché wrote:

The solution now looks like that :

...

foldTapeD :: (Monoid m) => (Int -> a -> m) -> Tape a -> m foldTapeD f t = (foldTape go t) 0 where go x fs n = ....

I let you write your solution (if you didn't find before tomorrow evening, I'll give you the answer).

You can then call foldTapeD thus :

...

foldTapeD (\n x -> if n< 2 then [x] else []) testTape

(much nicer than your initial solution, is it not ?)

Hi, Chaddaï. Thanks for the clarification! Now i think i get it. Here is three my solutions. First one is (as you suggest) without monads:

import Data.Monoid import Control.Monad.State

data Tape a = Tape a [Tape a]

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

foldTapeD :: (Monoid m) => (Int -> a -> m) -> Tape a -> m foldTapeD f t = (foldTape (go f) t) 0 where go :: (Monoid m) => (Int -> a -> m) -> a -> [(Int -> m)] -> (Int -> m) go f name xs = \cs -> foldr (mappend . ($ (cs + 1))) (f cs name) xs

second one with monadic go function:

foldTapeD1 :: (Monoid m) => (Int -> a -> m) -> Tape a -> m foldTapeD1 f t = fst $ runState (foldTape (go f) t) 0 where go :: (Monoid m) => (Int -> a -> m) -> a -> [State Int m] -> State Int m go f name xs = do cs <- get put (cs + 1) foldr (go' (cs + 1)) (return (f cs name)) xs go' :: (Monoid m) => Int -> State Int m -> State Int m -> State Int m go' cs mx mz = do x <- mx put cs z <- mz put cs return (x `mappend` z)

and the last one with monadic go function and monadic user-defined folding function:

foldTapeD2 :: (Monoid m) => (a -> State Int m) -> Tape a -> m foldTapeD2 f t = fst $ runState (foldTape (go f) t) 0 where go :: (Monoid m) => (a -> State Int m) -> a -> [State Int m] -> State Int m go f name xs = do cs <- get z <- f name put (cs + 1) foldr (go' (cs + 1)) (return z) xs go' :: (Monoid m) => Int -> State Int m -> State Int m -> State Int m go' cs mx mz = do x <- mx put cs z <- mz put cs return (x `mappend` z)

and here is test functions:

testTape :: Tape String testTape = Tape "A" [ Tape "B" [ Tape "C" [] , Tape "F" [Tape "G" [Tape "H" []]] , Tape "E" [] ] , Tape "D" [ Tape "I" []] ] testFoldTapeD :: ((Int -> a -> [a]) -> Tape a -> [a]) -> Int -> Tape a -> [a] testFoldTapeD ftD i t = ftD (\cs x -> if cs == i then [x] else []) t testFoldTapeD1 :: ((a -> State Int [a]) -> Tape a -> [a]) -> Int -> Tape a -> [a] testFoldTapeD1 ftD i t = ftD (\x -> get >>= \cs -> if cs == i then return [x] else return []) t

Is my answer correct? :) And at the end it seems, that first (non-monadic) version is much simpler and clearer, than all other. So.. should i use monads here? Earlier i think, that it's better to use them, but now i doubt. -- Dmitriy Matrosov