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.Monad (join)
import Control.Arrow ((***))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Monoid (Product(..), getProduct)

mapTuple = join (***)

pattern Empty   &lt;- (Seq.viewl -&gt; Seq.EmptyL)
pattern x :&lt; xs &lt;- (Seq.viewl -&gt; x Seq.:&lt; xs)

data Tree a = Leaf a | Branch a (Tree a, Tree a)
label :: Tree a -&gt; 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 =&gt; Seq a -&gt; Tree a
makeTree Empty = undefined
makeTree (label :&lt; 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 -&gt; Zipper a
goLeft (Branch x (l, r), bs) = (l, LeftCrumb x r:bs)
goLeft (Leaf _, _) = error "Nothing to go left into"

goRight :: Zipper a -&gt; 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 =&gt; Breadcrumbs a -&gt; a
concatAllExcept = concatAllExceptRev . reverse where
  concatAllExceptRev [] = mempty
  concatAllExceptRev ((LeftCrumb _ subtree) : xs) =
    concatAllExceptRev xs &lt;&gt; label subtree
  concatAllExceptRev ((RightCrumb _ subtree) : xs) =
    label subtree &lt;&gt; concatAllExceptRev xs

-- Return a list of zippers pointing to the leafs of the tree
dfsList :: Tree a -&gt; [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 =&gt; [a] -&gt; [a]
concatAllExceptEach = map (concatAllExcept . snd) . dfsList . makeTree . Seq.fromList

answer :: [Integer] -&gt; [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.
Welcome! Here are my thoughts what could be improved:


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' -&gt; c') -&gt; (b', b') -&gt; (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.
I'd put a newline betweek 'data...' and 'label'. Keeping consistent style helps readability very much.
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

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!
Use Haddock markup in comments, you can then generate nice documentation very easily.

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


Are you sure?