How do I map functions over a RoseTree in Applicative (Haskell)?

Question

How do I apply applicative to a RoseTree, i.e. return a tree composed of trees created by the successive application of functions to initial nodes. Here's the code that I have written:

{-# LANGUAGE DeriveFunctor, InstanceSigs #-}

data RoseTree a = Nil | Node a [RoseTree a] deriving(Functor,Show)

instance Applicative RoseTree where
    pure :: a -> RoseTree a
    pure x = Node x []

    (<*>) :: RoseTree (a -> b) -> RoseTree a -> RoseTree b
    (<*>) _ Nil = Nil
    (<*>) Nil _ = Nil
    (<*>) (Node f tree) (Node x subtrees) = Node (f x) (zipWith (<*>) tree subtrees)

I am unsure what's wrong with my definition of pure and (<*>). Here's the error I got:

Error: failure in expression `(Node (+1) []) <*> (Node 7 [Node 1 [], Node 2 [], Node 3 [Node 4 []]])' expected: Node 8 [Node 2 [],Node 3 [],Node 4 [Node 5 []]] but got: Node 8 []

Test cases for reference:

-- >>> (Node (+1) [Node (*2) []]) <*> Nil
-- Nil
--
-- >>> Nil <*> (Node 7 [Node 1 [], Node 2 [], Node 3 [Node 4 []]])
-- Nil
--
-- >>> (Node (+1) []) <*> (Node 7 [Node 1 [], Node 2 [], Node 3 [Node 4 []]])
-- Node 8 [Node 2 [],Node 3 [],Node 4 [Node 5 []]]
--
-- >>> (Node (+1) [Node (*2) []]) <*> (Node 5 [Node 2 [], Node 8 [Node 1 []]])
-- Node 6 [Node 3 [],Node 9 [Node 2 []],Node 10 [Node 4 [],Node 16 [Node 2 []]]]

Answer 1

Types can have more than one valid Applicative instance (such as how lists have one directly on [], and another on their newtype wrapper ZipList). Your <*> function appears to be valid for an Applicative instance, just not the one that you want according to your test cases (and also not one that uses this definition of pure).

The problem is here:

(<*>) (Node f tree) (Node x subtrees) = Node (f x) (zipWith (<*>) tree subtrees)

There's three main issues with it, given what your test cases expect:

1. It doesn't ever apply f to anything in subtrees.
2. It doesn't ever apply anything in tree to x.
3. It only applies each tree element to one element in subtrees.

This line should work instead:

(<*>) (Node f tree) n@(Node x subtrees) = Node (f x) (map (fmap f) subtrees ++ map (<*> n) tree)

Also, while this makes your test cases work as expected, I haven't rigorously verified that it's actually a lawful instance. (I've looked at it briefly and it seems fine, but I'm also writing this at 1am.)

Answer 2

We can see your RoseTree as a particular application of a particular monad transformer. Let's put your own definition in a module called Rose and derive Read and Show instances for RoseTree. Now we can get fancy. Note: you probably won't understand everything in here just yet. Some of it uses pretty advanced GHC language extensions. But I think it's interesting anyway.

We'll use the cofree comonad transformer from the free package. As the name indicates, it plays a special role relative to the Comonad class, but it turns out to do useful things with Monads too!

{-# language PatternSynonyms, ViewPatterns, GeneralizedNewtypeDeriving #-}
module FancyRose where

import Text.Read (Read (readPrec))
import qualified Rose
import Control.Comonad.Trans.Cofree
{-
newtype CofreeT f w a = CofreeT
  { runCofreeT :: w (CofreeF f a (CofreeT f w a)) }

data CofreeF f a b = a :< f b
-}

newtype RoseTree a = RoseTree { unRoseTree :: CofreeT [] Maybe a }
  deriving (Functor, Applicative, Monad, Eq, Ord)

The great thing is that we don't have to come up with proofs of the Applicative (or Monad) laws ourselves. You can find them all in the free git repository!

These pattern synonyms allow users to pretend (for the most part) that RoseTree is defined the simple way. Don't worry too much about the details.

-- Create or match on an empty 'RoseTree'. This is a simple
-- bidirectional pattern synonym: writing `Nil` in an expression
-- or a pattern is just the same as writing
-- `RoseTree (CofreeT Nothing)`
pattern Nil :: RoseTree a
pattern Nil = RoseTree (CofreeT Nothing)

-- Create or match on a non-empty 'RoseTree'. This is an explicit
-- bidirectional pattern synonym. We use a view pattern to show
-- how to match on a node, and then in the `where` clause we show
-- how to construct one.
pattern Node :: a -> [RoseTree a] -> RoseTree a
pattern Node a ts <- RoseTree (CofreeT (fmap (fmap RoseTree) -> Just (a :< ts)))
  where
    Node a ts = RoseTree $ CofreeT $ Just $ a :< map unRoseTree ts

Here's how we can implement Show and Read without much fuss:

-- Convert a `RoseTree` to the simple representation of one.
-- Note that the pattern synonyms make this really easy!
toBasicRose :: RoseTree a -> Rose.RoseTree a
toBasicRose Nil = Rose.Nil
toBasicRose (Node a ts) = Rose.Node a (map toBasicRose ts)

-- Convert the simple representation back to a `RoseTree`.
fromBasicRose :: Rose.RoseTree a -> RoseTree a
fromBasicRose Rose.Nil = Nil
fromBasicRose (Rose.Node a ts) = Node a (map fromBasicRose ts)

instance Show a => Show (RoseTree a) where
  showsPrec p = showsPrec p . toBasicRose
instance Read a => Read (RoseTree a) where
  readPrec = fmap fromBasicRose readPrec

All your test cases pass.

Performance note

I was concerned that all the mapping could make the Node pattern slow. But I've just checked the compiler intermediate language and determined that GHC's rewrite rules actually kick in and get rid of all the mapping unconditionally.