# Monoidal tree interview in Haskell

I was working on the following interview question:

Given an array of integers, return a new array such that each element at index i of the new array is the product of all the numbers in the original array except the one at i.

For example, if our input was [1, 2, 3, 4, 5], the expected output would be [120, 60, 40, 30, 24]. If our input was [3, 2, 1], the expected output would be [2, 3, 6].

Follow-up: what if you can't use division?

I decided to do the followup question in Haskell:

{-# LANGUAGE ViewPatterns, PatternSynonyms #-}
import Control.Arrow ((***))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Monoid (Product(..), getProduct)

mapTuple = join (***)

pattern Empty   <- (Seq.viewl -> Seq.EmptyL)
pattern x :< xs <- (Seq.viewl -> x Seq.:< xs)

data Tree a = Leaf a | Branch a (Tree a, Tree a)
label :: Tree a -> a
label (Leaf a) = a
label (Branch a _) = a

{- Create a complete binary tree, such that each subtree contains the concat of all
- elements under it. -}
makeTree :: Monoid a => Seq a -> Tree a
makeTree Empty = undefined
makeTree (label :< Empty) = Leaf label
makeTree s =
let midpoint = Seq.length s div 2 in
let subseq = Seq.splitAt midpoint s in
let subtrees = mapTuple makeTree subseq in
let subtreeLabels = mapTuple label subtrees in
let label = uncurry mappend subtreeLabels in
Branch label subtrees

{- Zippers. -}
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a)
type Breadcrumbs a = [Crumb a]
type Zipper a = (Tree a, Breadcrumbs a)

goLeft :: Zipper a -> Zipper a
goLeft (Branch x (l, r), bs) = (l, LeftCrumb x r:bs)
goLeft (Leaf _, _) = error "Nothing to go left into"

goRight :: Zipper a -> Zipper a
goRight (Branch x (l, r), bs) = (r, RightCrumb x l:bs)
goRight (Leaf _, _) = error "Nothing to go right into"

-- Concat of all elements except the one corresponding to the given crumbs
concatAllExcept :: Monoid a => Breadcrumbs a -> a
concatAllExcept = concatAllExceptRev . reverse where
concatAllExceptRev [] = mempty
concatAllExceptRev ((LeftCrumb _ subtree) : xs) =
concatAllExceptRev xs <> label subtree
concatAllExceptRev ((RightCrumb _ subtree) : xs) =
label subtree <> concatAllExceptRev xs

-- Return a list of zippers pointing to the leafs of the tree
dfsList :: Tree a -> [Zipper a]
dfsList t =
reverse $dfsListHelper (t, []) [] where dfsListHelper zipper@(Leaf _, _) accum = zipper : accum dfsListHelper zipper@(Branch _ _, _) accum = -- Since this is a Branch node, both [goLeft] and [goRight] will work. let l = goLeft zipper r = goRight zipper in dfsListHelper r (dfsListHelper l accum) {- Produces a list such that the ith element is the concat of all elements in the - original list, excluding the ith element. -} concatAllExceptEach :: Monoid a => [a] -> [a] concatAllExceptEach = map (concatAllExcept . snd) . dfsList . makeTree . Seq.fromList answer :: [Integer] -> [Integer] answer = map getProduct . concatAllExceptEach . fmap Product main = do print$ answer [3, 10, 33, 4, 31, 31, 1, 7]
print $answer [1, 2, 3, 4, 5] print$ concatAllExceptEach ["A", "B", "C", "D"]


Algorithm runs in Θ(n log n) which I believe is optimal. New to Haskell so all feedback welcome.

• Linear time: answer xs = zipWith (*) (scanl (*) 1 xs) (tail \$ scanr (*) 1 xs) – Gurkenglas Sep 4 '18 at 4:26
• @Gurkenglas For the benefit of the OP (and others too), it might be more educational to only hint the answer and let them figure out the solution on their own. – Petr Sep 4 '18 at 18:42

Welcome! Here are my thoughts what could be improved:

1. For top-level declarations, always do include types. I'm pretty sure in a few weeks it'll be difficult to realize what

mapTuple = join (***)


means without knowing that it's type is

mapTupple :: (b' -> c') -> (b', b') -> (c', c')


Also as you don't need arrows anywhere else, it makes sense to specialize the type to avoid accidental errors and get nicer error messages.

2. I'd put a newline betweek 'data...' and 'label'. Keeping consistent style helps readability very much.

3. You don't need to nest 'let' expressions. You can write just

let midpoint = Seq.length s div 2
subseq = Seq.splitAt midpoint s
...
in Branch label subtrees

4. Instead of creating a sequence and then converting it into a balanced tree, you can convert a list directly into a balanced tree in O(n). This is a nice exercise on its own!

5. Use Haddock markup in comments, you can then generate nice documentation very easily.

6. Algorithm runs in Θ(n log n) which I believe is optimal.

Are you sure?