{- |
Description: Supporting definitions for binary tree problems
Copyright: Copyright (C) 2021 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Supporting definitions for binary tree problems.
-}
module Problems.BinaryTrees (
  Tree (Empty, Branch),
  -- * Support functions
  treeSize,
  treeHeight,
  printTreeList,
  ) where

import           Control.DeepSeq
import           Data.List       (intercalate, sort)
import           GHC.Generics    (Generic)

-- | A binary tree.
--
-- A 'Tree' of type @a@ consists of either an 'Empty' node,
-- or a 'Branch' containing one value of type @a@ with exactly two subtrees of type @a@.
--
-- === __Notes__
--
-- This is not the problem 54A from the original Ninety-Nine Haskell Problems.
-- As it also mentions, there is nothing to do here except making sure code
-- compiles correctly, thanks to Haskell's strict typing and the way 'Tree'
-- is defined.
--
-- Instead, the problem was replaced by the simple problems of implementing
-- given binary trees as Haskell values.  I.e., turn the examples from
-- the original problem into simple problems to solve.
data Tree a = Empty | Branch a (Tree a) (Tree a)
  deriving (Tree a -> Tree a -> Bool
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
/= :: Tree a -> Tree a -> Bool
Eq, Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
showsPrec :: Int -> Tree a -> ShowS
$cshow :: forall a. Show a => Tree a -> String
show :: Tree a -> String
$cshowList :: forall a. Show a => [Tree a] -> ShowS
showList :: [Tree a] -> ShowS
Show, (forall x. Tree a -> Rep (Tree a) x)
-> (forall x. Rep (Tree a) x -> Tree a) -> Generic (Tree a)
forall x. Rep (Tree a) x -> Tree a
forall x. Tree a -> Rep (Tree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tree a) x -> Tree a
forall a x. Tree a -> Rep (Tree a) x
$cfrom :: forall a x. Tree a -> Rep (Tree a) x
from :: forall x. Tree a -> Rep (Tree a) x
$cto :: forall a x. Rep (Tree a) x -> Tree a
to :: forall x. Rep (Tree a) x -> Tree a
Generic, Tree a -> ()
(Tree a -> ()) -> NFData (Tree a)
forall a. NFData a => Tree a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Tree a -> ()
rnf :: Tree a -> ()
NFData)

-- | Returns the number of nodes in a binary tree.
treeSize :: Tree a -> Int
treeSize :: forall a. Tree a -> Int
treeSize Tree a
Empty          = Int
0
treeSize (Branch a
_ Tree a
l Tree a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
treeSize Tree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
treeSize Tree a
r

-- | Returns the height of a binary tree.
treeHeight :: Tree a -> Int
treeHeight :: forall a. Tree a -> Int
treeHeight Tree a
Empty          = Int
0
treeHeight (Branch a
_ Tree a
l Tree a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Tree a -> Int
forall a. Tree a -> Int
treeHeight Tree a
l) (Tree a -> Int
forall a. Tree a -> Int
treeHeight Tree a
r)

-- | An arbitrary total ordering for 'Tree'.
--
-- Defines an order for a set of 'Tree's.  Not intended to support solving problems.
instance Ord a => Ord (Tree a) where
  compare :: Tree a -> Tree a -> Ordering
compare Tree a
t Tree a
v = [([Bool], a)] -> [([Bool], a)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tree a -> [Bool] -> [([Bool], a)]
forall a. Tree a -> [Bool] -> [([Bool], a)]
encodeTree Tree a
t []) (Tree a -> [Bool] -> [([Bool], a)]
forall a. Tree a -> [Bool] -> [([Bool], a)]
encodeTree Tree a
v [])

-- | Encodes 'Tree' in a form more obviously ordered,
-- in a way which avoids distinct trees being encoded the same.
encodeTree :: Tree a -> [Bool] -> [([Bool], a)]
encodeTree :: forall a. Tree a -> [Bool] -> [([Bool], a)]
encodeTree Tree a
Empty [Bool]
_ = []
encodeTree (Branch a
x Tree a
left Tree a
right) [Bool]
trail =
  [([Bool]
trail, a
x)] [([Bool], a)] -> [([Bool], a)] -> [([Bool], a)]
forall a. [a] -> [a] -> [a]
++ Tree a -> [Bool] -> [([Bool], a)]
forall a. Tree a -> [Bool] -> [([Bool], a)]
encodeTree Tree a
left (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
trail) [([Bool], a)] -> [([Bool], a)] -> [([Bool], a)]
forall a. [a] -> [a] -> [a]
++ Tree a -> [Bool] -> [([Bool], a)]
forall a. Tree a -> [Bool] -> [([Bool], a)]
encodeTree Tree a
right (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
trail)

-- | Prints a list of 'Tree's.
--
-- For two lists with the same trees, except for perhaps different order,
-- the output will be the same.
--
-- Not intended to support solving problems.
printTreeList :: (Show a, Ord a) => [Tree a] -> IO ()
printTreeList :: forall a. (Show a, Ord a) => [Tree a] -> IO ()
printTreeList [Tree a]
ts = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"[ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
content String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
  where content :: String
content = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n, " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Tree a -> String) -> [Tree a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> String
forall a. Show a => a -> String
show ([Tree a] -> [Tree a]
forall a. Ord a => [a] -> [a]
sort [Tree a]
ts)