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.

  • 1
    \$\begingroup\$ Linear time: answer xs = zipWith (*) (scanl (*) 1 xs) (tail $ scanr (*) 1 xs) \$\endgroup\$ – Gurkenglas Sep 4 '18 at 4:26
  • \$\begingroup\$ @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. \$\endgroup\$ – 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?


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.