Foldable Rose Trees
I've been trying to re-label nodes in a rose tree without re-inventing wheels (although I'm beginning to wish I had). I've got as far as this but haven't yet cracked the general case for Traversable. Any help would be much appreciated. Thanks, Dominic.
*Main> let (p,_) = runState (unwrapMonad (traverse (\x -> WrapMonad update) (Rose' 3 [Rose' 5 [Rose' 11 [Rose' 19 []], Rose' 13 [], Rose' 17[]], Rose' 7 []]))) 0 in p Rose' 0 [Rose' 1 [Rose' 2 [Rose' 3 []],Rose' 4 [],Rose' 5 []],Rose' 6 []]
import Control.Applicative import Data.Foldable import Data.Traversable import Data.Monoid import Control.Monad.State
update :: MonadState Int m => m Int update = do x <- get put (x + 1) return x
data Rose' a = Rose' a [Rose' a] deriving Show
instance Functor Rose' where fmap f (Rose' x rs) = Rose' (f x) (map (fmap f) rs)
instance Foldable Rose' where foldMap f (Rose' x rs) = f x `mappend` (mconcat (map (foldMap f) rs))
instance Traversable Rose' where traverse f (Rose' x []) = Rose' <$> f x <*> pure [] traverse f (Rose' x [x0]) = Rose' <$> f x <*> (pure (\x -> [x]) <*> traverse f x0) traverse f (Rose' x [x0,x1]) = Rose' <$> f x <*> (pure (\x y -> x:y:[]) <*> traverse f x0 <*> traverse f x1) traverse f (Rose' x [x0,x1,x2]) = Rose' <$> f x <*> (pure (\x y z -> x:y:z:[]) <*> traverse f x0 <*> traverse f x1 <*> traverse f x2)
Dominic Steinitz wrote:
I've been trying to re-label nodes in a rose tree without re-inventing wheels (although I'm beginning to wish I had). I've got as far as this but haven't yet cracked the general case for Traversable.
Solution 1) Data.Tree is already an instance of Traversable. :) Solution 2) The key observation is that you the instances for rose trees can/should be bootstrapped from corresponding instances for lists []. With this, we have
instance Functor Rose' where fmap f (Rose' x rs) = Rose' (f x) (map (fmap f) rs)
fmap f (Rose' x rs) = Rose' (f x) (fmap (fmap f) rs) (fmap instead of map to highlight the general structure)
instance Foldable Rose' where foldMap f (Rose' x rs) = f x `mappend` (mconcat (map (foldMap f) rs))
foldMap f (Rose' x rs) = f x `mappend` (foldMap (foldMap f) rs)
instance Traversable Rose' where traverse f (Rose' x []) = Rose' <$> f x <*> pure [] traverse f (Rose' x [x0]) = Rose' <$> f x <*> (pure (\x -> [x]) <*> traverse f x0) traverse f (Rose' x [x0,x1]) = Rose' <$> f x <*> (pure (\x y -> x:y:[]) <*> traverse f x0 <*> traverse f x1) traverse f (Rose' x [x0,x1,x2]) = Rose' <$> f x <*> (pure (\x y z -> x:y:z:[]) <*> traverse f x0 <*> traverse f x1 <*> traverse f x2)
traverse f (Rose' x xs) = Rose' <$> f x <*> traverse (traverse f) xs
*Main> let (p,_) = runState (unwrapMonad (traverse (\x -> WrapMonad update) (Rose' 3 [Rose' 5 [Rose' 11 [Rose' 19 []], Rose' 13 [], Rose' 17[]], Rose' 7 []]))) 0 in p Rose' 0 [Rose' 1 [Rose' 2 [Rose' 3 []],Rose' 4 [],Rose' 5 []],Rose' 6 []]
This can be made shorter: Data.Traversable.mapM m = unwrapMonad . traverse . (\x -> WrapMonad (m x)) Regards, apfelmus
Solution 1) Data.Tree is already an instance of Traversable. :)
Yes it's all there but I would have missed the fun of trying to do it myself ;-) Plus the data structure I actually want to re-label isn't quite a rose tree.
Solution 2) The key observation is that you the instances for rose trees can/should be bootstrapped from corresponding instances for lists []. With this, we have
instance Functor Rose' where fmap f (Rose' x rs) = Rose' (f x) (map (fmap f) rs)
fmap f (Rose' x rs) = Rose' (f x) (fmap (fmap f) rs)
(fmap instead of map to highlight the general structure)
instance Foldable Rose' where foldMap f (Rose' x rs) = f x `mappend` (mconcat (map (foldMap f) rs))
foldMap f (Rose' x rs) = f x `mappend` (foldMap (foldMap f) rs)
Interesting - I hadn't twigged that they were the same modulo instantiation for [].
((.).(.)) mconcat map :: forall a b. (Monoid b) => (a -> b) -> [a] -> b *Main> :t foldMap foldMap :: forall a m (t :: * -> *). (Monoid m, Foldable t) => (a -> m) -> t a -> m
instance Traversable Rose' where traverse f (Rose' x []) = Rose' <$> f x <*> pure [] traverse f (Rose' x [x0]) = Rose' <$> f x <*> (pure (\x -> [x]) <*> traverse f x0) traverse f (Rose' x [x0,x1]) = Rose' <$> f x <*> (pure (\x y -> x:y:[]) <*> traverse f x0 <*> traverse f x1) traverse f (Rose' x [x0,x1,x2]) = Rose' <$> f x <*> (pure (\x y z -> x:y:z:[]) <*> traverse f x0 <*> traverse f x1 <*> traverse f x2)
traverse f (Rose' x xs) = Rose' <$> f x <*> traverse (traverse f) xs
And then this becomes something you might guess.
*Main> let (p,_) = runState (unwrapMonad (traverse (\x -> WrapMonad update) (Rose' 3 [Rose' 5 [Rose' 11 [Rose' 19 []], Rose' 13 [], Rose' 17[]], Rose' 7 []]))) 0 in p Rose' 0 [Rose' 1 [Rose' 2 [Rose' 3 []],Rose' 4 [],Rose' 5 []],Rose' 6 []]
This can be made shorter:
Data.Traversable.mapM m = unwrapMonad . traverse . (\x -> WrapMonad (m x))
Your help as ever is excellent. Many thanks, Dominic.
participants (2)
-
apfelmus -
Dominic Steinitz