Skip to content

Instantly share code, notes, and snippets.

@Munksgaard

Munksgaard/tree-fold.hs

Created September 2, 2022 12:03
Show Gist options
  • Save Munksgaard/a662ae5c917bc18eeffb4082b4c71d43 to your computer and use it in GitHub Desktop.
Save Munksgaard/a662ae5c917bc18eeffb4082b4c71d43 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
tree-fold.hs
maybeHead :: a -> [a] -> a
maybeHead _ (x : _) = x
maybeHead x _ = x
treeFold :: Show a => (a -> a -> a) -> a -> [a] -> a
treeFold f neutral = treeFold' []
where
treeFold' ((i1, x1) : (i2, x2) : rest) xs
| i1 == i2 = treeFold' ((i1 + 1, f x1 x2) : rest) xs
treeFold' acc (x1 : x2 : rest) = treeFold' ((0, f x1 x2) : acc) rest
treeFold' acc xs = foldl f (maybeHead neutral xs) $ map snd acc
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment