Ltree inverse crossing function using high order functions

Question

I was solving some Haskell exercises as a way to refresh some of the language concepts.

I encounter the following exercise:

data LTree a = Leaf a | Fork (LTree a) (LTree a)

crossing :: LTree a -> [(a,Int)]
crossing (Leaf x) = [(x,0)]
crossing (Fork e d) = map(\(x,y) -> (x,y+1)) (crossing e ++ crossing d)

The above function basically takes a Ltree and turns into a list of pars (Lists the tree leaves, along with their depth).

The exercise is to make a function build :: [(a,Int)] -> LTree a, that does the inverse of the crossing function, such as build (crossing a) = a for any 'a' tree.

What I have done so far:

build :: [(a,Int)] -> LTree a
build l = fst (multConvert (map (\(x,n) -> (Leaf x, n)) l))

multConvert :: [(LTree a,Int)] -> (LTree a,Int)
multConvert [x] = x    
multConvert l = multConvert (convert l)

convert :: [(LTree a,Int)] -> [(LTree a,Int)]
convert [] = []
convert [x] = [x]
convert ((a,b):(c,d):xs) | b == d = ((Fork a c),(b-1)):xs
                         | otherwise = (a,b):convert ((c,d):xs)

Basically, I turn the list produce by the crossing into an list of (LTree,a) , for example [(3,3),(4,3)..] becomes [(Leaf 3, 3), (Leaf 4, 3)...]. The convert function will take this list of (LTree,a) and turn consecutive elements with the same depth into a Fork with both elements. For example [(Leaf 3, 3), (Leaf 4, 3), (Leaf 5, 2)...] becomes [(Fork (Leaf 3) (Leaf 4),2), (Leaf 5, 2)...]. Note, that the new produced element have a depth-1.

multConvert function will apply the above idea on the list, over and over, until this list have only one element. This element will represent the original tree. In other words, my algorithm builds the Ltree using a bottom up approach.

I would like to know if there is a more robust way to solve this problem. For example using high order functions, instead of explicitly recursive (possibly using foldr).

Answer 1

I think this is a continuation-passing solution (simple parser) for writing build:

build :: [(a,Int)] -> LTree a
build xs = parseAt 0 xs fst

-- The first Int is the depth of the "root" of parseAt
parseAt :: Int -> [(a,Int)] -> ( (LTree a, [(a,Int)]) -> r ) -> r
parseAt r [] k = error "input too short"
parseAt r xs@((a,n):rest) k =
  case compare r n of
    GT -> error "depth too small"
    EQ -> k (Leaf a,rest)
    LT -> parseAt (succ r) xs (\ (left,rest1) ->
            parseAt (succ r) rest1 (\ (right,rest2) ->
              k (Fork left right, rest2)))