{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

{- |
Description: In-order and pre-order sequences of binary trees
Copyright: Copyright (C) 2021 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Some solutions to "Problems.P68" of Ninety-Nine Haskell "Problems".
-}
module Solutions.P68 (preorder, inorder, ordersToTree) where

import           Problems.BinaryTrees

{- |
Return the in-order sequence of a binary tree.
-}
inorder :: Tree a -> [a]
inorder :: forall a. Tree a -> [a]
inorder Tree a
t = Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
inorderGather Tree a
t []

-- List will be in reverse order of elements added,
-- so traverse in reverse order.
inorderGather :: Tree a -> [a] -> [a]
inorderGather :: forall a. Tree a -> [a] -> [a]
inorderGather Tree a
Empty [a]
xs          = [a]
xs
inorderGather (Branch a
x Tree a
l Tree a
r) [a]
xs = Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
inorderGather Tree a
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
inorderGather Tree a
r [a]
xs

{- |
Return the pre-order sequence of a binary tree.
-}
preorder :: Tree a -> [a]
preorder :: forall a. Tree a -> [a]
preorder Tree a
t = Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
preorderGather Tree a
t []

-- List will be in reverse order of elements added,
-- so traverse in reverse order.
preorderGather :: Tree a -> [a] -> [a]
preorderGather :: forall a. Tree a -> [a] -> [a]
preorderGather Tree a
Empty [a]
xs          = [a]
xs
preorderGather (Branch a
x Tree a
l Tree a
r) [a]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
preorderGather Tree a
l (Tree a -> [a] -> [a]
forall a. Tree a -> [a] -> [a]
preorderGather Tree a
r [a]
xs)

{- |
Given the in-order and pre-order sequences of a binary tree, return the original binary tree.

The values in each node of the binary tree will be distinct,
in which case the tree is determined unambiguously.
-}
ordersToTree :: Eq a
             => [a]  -- ^ In-order sequence
             -> [a]  -- ^ Pre-order sequence
             -> Maybe (Tree a)  -- ^ Binary tree with the given in-order and pre-order sequences
ordersToTree :: forall a. Eq a => [a] -> [a] -> Maybe (Tree a)
ordersToTree [] [] = Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just Tree a
forall a. Tree a
Empty
ordersToTree [a]
inseq (a
p:[a]
preseq)
  | a
p' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
p   = do
      Tree a
l <- [a] -> [a] -> Maybe (Tree a)
forall a. Eq a => [a] -> [a] -> Maybe (Tree a)
ordersToTree [a]
inseqLeft [a]
preseqLeft
      Tree a
r <- [a] -> [a] -> Maybe (Tree a)
forall a. Eq a => [a] -> [a] -> Maybe (Tree a)
ordersToTree [a]
inseqRight [a]
preseqRight
      Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree a -> Maybe (Tree a)) -> Tree a -> Maybe (Tree a)
forall a b. (a -> b) -> a -> b
$ a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Branch a
p Tree a
l Tree a
r
  | Bool
otherwise = Maybe (Tree a)
forall a. Maybe a
Nothing
  where ([a]
inseqLeft, a
p':[a]
inseqRight) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a
p ==) [a]
inseq
        ([a]
preseqLeft, [a]
preseqRight) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
inseqLeft) [a]
preseq
-- Failure to match patterns above or below indicate invalid sequences.
ordersToTree [a]
_ [a]
_ = Maybe (Tree a)
forall a. Maybe a
Nothing