Monoidal tree interview in Haskell

Question

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.Monad (join)
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.

• Gurkenglas: Linear time: answer xs = zipWith (*) (scanl (*) 1 xs) (tail $ scanr (*) 1 xs)
• Petr: @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.

Answer 1

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?