Haskell: Find a value in a Ternary Tree and the tree is not sorted

Question

For now I have the tree data type:

data TernaryTree a = EmptyTree
                   | Node a (TernaryTree a) (TernaryTree a) (TernaryTree a)
                   deriving (Show)

And I am trying to create a function that can loop up a value in the Ternary Tree. The tree is not sorted.

treeLook :: (Ord a)=> a -> TernaryTree a -> Bool
treeLook x EmptyTree = False
treeLook x (Node a left mid right) =
    if x /= a
        then do
        treeLook x left 
        treeLook x mid
        treeLook x right
        else 
        True

I have this for now but I can't compile it. It says:

Couldn't match expected type "m0 b0" with actual type "bool" on the line:
    treeLook x right

Answer 1

do is a keyword that is used to enable some syntactical sugar for monads. In this sitation, there is no need for monads.

There are two cases here: the EmptyTree that means that we failed to find the value, so we return False.

For the Node we can check up to four conditions: is the value the value we look for, is the value in the first subtree, is the value in the second subtree, and is the value in the third subtree. From the moment one of the checks is True, we can return True. If all checks fail, we return False, this is the behavior of a logical or (||). So we can write it like:

treeLook :: Eq a => a -> TernaryTree a -> Bool
treeLook _ EmptyTree = False
treeLook x (Node a l m r) = x == a || treeLook x l || treeLook x m || treeLook x r

Or we can define a locally scoped function preventing us from recursively passing the value we are looking for:

treeLook :: Eq a => a -> TernaryTree a -> Bool
treeLook x = go
    where go EmptyTree = False
          go (Node a l m r) = x == a || go l || go m || go r

Note that since the tree is not sorted, we do not need the Ord a type constraint, we only need to check equality (here in x == a), so the Eq a type constraint is sufficient.

Answer 2

Do is for monads.

Instead use any.

treeLook _ EmptyTree = False
treeLook x (Node y l m r) = any id [x == y, look l, look m, look r]
    where look = treeLook x

As pointed out, or is better use.

treeLook x (Node y l m r) = or [x == y, look l, look m, look r]
    where look = treeLook x

Tho my favourite would be this:

treeLook _ EmptyTree = False
treeLook x (Node y l m r) = x == y || any (treeLook x) [l, m, r]

Answer 3

One option is to use elem, which checks whether a value is an element of a Foldable container.

treeLook :: Eq a => a -> TernaryTree a -> Bool
treeLook = elem

Now you just have to write an instance of Foldable. One option is to enable the DeriveFoldable extension and just use deriving (Show, Foldable) to get GHC to write the instance for you. But you won't learn much that way. So let's explore some ways to do it.

-- This import is needed for non-bleeding-edge GHC versions.
import Data.Monoid ((<>))

instance Foldable TernaryTree where
  -- Fold over the tree in pre-order
  foldMap _ EmptyTree = mempty
  foldMap f (Node x ls cs rs) =
    f x <> foldMap f ls <> foldMap f cs <> foldMap f rs

But that repeated foldMap is itself a sort of "pattern" you can pull out by writing the "catamorphism" for trees:

cataTree :: r -> (a -> r -> r -> r -> r) -> TernaryTree a -> r
cataTree e _ EmptyTree = e
cataTree e f (Node x ls cs rs) =
  f x (cataTree e f ls) (cataTree e f cs) (cataTree e f rs)

Now you can define foldMap thus:

foldMap f = cataTree mempty (\a lr cr rr -> f a <> lr <> cr <> rr)

Now foldMap itself has a more-powerful cousin, traverse. So another option is to start there:

import Data.Traversable (fmapDefault, foldMapDefault)

instance Traversable TernaryTree where
  -- Traverse the tree in pre-order
  traverse f =
    cataTree (pure EmptyTree)
             (\a ls cs rs -> Node <$> f a <*> ls <*> cs <*> rs)

instance Functor TernaryTree where
  fmap = fmapDefault

instance Foldable TernaryTree where
  foldMap = foldMapDefault

Obviously, you're not at a point where you're going to want to do anything so fancy, but such techniques are actually useful once you're in the position of wanting to produce a bunch of functions quickly.