My Binary Tree's delete function occasionally results in duplicate entries

Question

I created a small Binary Tree "library", but tDelete isn't functioning properly in certain circumstances. I tested it on simpler trees and it worked fine, but in this particular scenario, it causes a duplicate node to be added to the tree. It seems to be because the recursive call to tDelete can't find the fMin value. It has to be findable though, or it would just return the original tree, instead of deleting the original targeted value, but not it's replacement's original.

The routine in main outlines the issue. The last printed tree has the target removed (992), and is successively replaced by the found minimum value (993), but the original minimum (993) is never found/deleted in the recursive call (resulting in two 993 entries). I've stepped through it, and I can't see the issue. If fMin finds 993 to act as the replacement, why can't a second call to tDelete find (and delete) it?

I originally thought that it was my balancing algorithm messing with the ordering, but thankfully, I don't think that that's possible. If that were the case, 993 would have never been found in the first place (and tMin does find it at least once). Any insight here would be appreciated. I was about to try and make this into a Map, but I need to iron out all the issues first.

data Tree a = ETree | Node { leftTreeOf :: Tree a, rightTreeOf :: Tree a, tLoad :: a }

instance Show s => Show (Tree s) where
    show = showTree 0

showTree :: Show s => Int -> Tree s -> String
showTree depth t = "\n" ++ replicate (depth * 2) '-' ++ case t of
    ETree           -> "()"
    (Node lT rT a)  -> "(" ++ show a ++ ")" ++ showTree nD lT ++ showTree nD rT
    where nD = depth + 1

tInsert :: Ord o => o -> Tree o -> Tree o
tInsert x ETree = Node ETree ETree x
tInsert x (Node lT rT a)
    | x < a = Node (tInsert x lT) rT a
    | x > a = Node lT (tInsert x rT) a
    | otherwise = Node lT rT x

-- Replaces the L/R tree with nT
replaceL, replaceR :: Ord o => Tree o -> Tree o -> Tree o
replaceL _ ETree = ETree
replaceL nT (Node _ rT a) = Node nT rT a

replaceR _ ETree = ETree
replaceR nT (Node lT _ a) = Node lT nT a

-- Folds a list into a tree
tFromListL, tFromListR :: Ord o => [o] -> Tree o
tFromListL = foldl (flip tInsert) ETree
tFromListR = foldr tInsert ETree

leftRotation, rightRotation :: Ord o => Tree o -> Tree o
rightRotation ETree = ETree
rightRotation t@(Node lT _ _) = let replaced = replaceL (rightTreeOf lT) t in
    replaceR replaced lT

leftRotation ETree = ETree
leftRotation t@(Node _ rT _) = let replaced = replaceR (leftTreeOf rT) t in
    replaceL replaced rT

-- Turns a tree into a list
tToList :: Ord o => Tree o -> [o]
tToList ETree = []
tToList (Node lT rT a) = (tToList lT) ++ [a] ++ (tToList rT)

-- Splits a list roughly in half (as part of balancing)
splitInHalf :: [a] -> ([a],[a])
splitInHalf xs = splitAt (round $ (fromIntegral $ length xs) / 2.0) xs

-- Returns how unbalanced a node is
tUnbalancedBy :: Tree a -> Int
tUnbalancedBy ETree = 0
tUnbalancedBy (Node lT rT _) = absDiff (tDepth lT) (tDepth rT)

-- Arranges a list in such a way that it forms a more balanced tree
balanceList :: [a] -> [a]
balanceList xs = let (fH,sH) = splitInHalf xs in (reverse fH) ++ sH

-- "Inefficient balance"
tIneffBalance :: Ord o => Tree o -> Tree o
tIneffBalance = tFromListL . balanceList . tToList

-- Finds the min/max values of a tree
tMin, tMax :: Ord o => Tree o -> o
tMin ETree = error "tMin called on an Empty Tree"
tMin (Node lT _ a) = case lT of
    ETree           -> a
    (Node lT' _ _)  -> tMin lT'

tMax ETree = error "tMax called on an Empty Tree"
tMax (Node _ rT a) = case rT of
    ETree           -> a
    (Node _ rT' _)  -> tMax rT'

-- Find the max depth of a tree 
tDepth :: Tree a -> Int
tDepth ETree = 0
tDepth (Node lT rT _) = 1 + max (tDepth lT) (tDepth rT)

-- Finds how many nodes a tree contains
tSize :: Tree a -> Int
tSize ETree = 0
tSize (Node lT rT _) = 1 + (tSize lT) + (tSize rT)

absDiff :: Int -> Int -> Int
absDiff x y = abs $ x - y

exceeds :: (Num n, Ord n) => n -> n -> Bool
exceeds x y = let t = 1 in x >= (y - t)

isInRangeOf :: (Num n, Ord n) => n -> n -> Bool
isInRangeOf x y = let t = 1 in
    x >= (y - t) && x <= (y + t)

-- Checks if a node is balanced
tIsBalanced :: Tree a -> Bool
tIsBalanced ETree = True
tIsBalanced n@(Node lT rT _) =
    tUnbalancedBy n <= 1 && tIsBalanced lT && tIsBalanced rT

tBalance :: Ord o => Tree o -> Tree o
tBalance ETree = ETree
tBalance n@(Node lT rT a)
    | lD `isInRangeOf` rD = Node (tBalance lT) (tBalance rT) a
    | lD `exceeds` rD = balanceRest $ rightRotation n
    | otherwise = balanceRest $ leftRotation n
    where
        (lD,rD) = (tDepth lT,tDepth rT)
        balanceRest t = replaceR (tBalance $ rightTreeOf t) $
            replaceL (tBalance $ leftTreeOf t) t

tBalanceNX :: Ord o => Int -> Tree o -> Tree o
tBalanceNX _ ETree = ETree
tBalanceNX n t = foldl (\a _-> tBalance a) t [1..n]

-- Checks if a value is an element of the tree
tElem :: Ord o => o -> Tree o -> Bool
tElem x ETree = False
tElem x (Node lT rT a)
    | x < a = tElem x lT
    | x > a = tElem x rT
    | otherwise = True

getSubTree :: Ord o => o -> Tree o -> Tree o
getSubTree _ ETree = ETree
getSubTree e t@(Node lT rT a)
    | e < a = getSubTree e lT
    | e > a = getSubTree e rT
    | otherwise = t

tDelete :: Ord o => o -> Tree o -> Tree o
tDelete _ ETree = ETree
tDelete _ n@(Node ETree ETree _) = n -- Or give "Not found" error?
tDelete tD n@(Node lT rT a)
    | tD < a = Node (tDelete tD lT) rT a
    | tD > a = Node lT (tDelete tD rT) a
    | otherwise = case (lT,rT) of
        (ETree,t)   -> t
        (t,ETree)   -> t
        (t,t')      -> let fMin = tMin t' in Node t (tDelete (fMin) t') fMin

getErrorTree :: Tree Int
getErrorTree = getSubTree 992 . tBalanceNX 100 $ tFromListL [1..1000]

main = do
    putStrLn "Deleting 992 yields two 993 trees"
    let errorTree = getErrorTree
    print errorTree
    putStrLn $ "993 findable in tree? " ++ show (993 `tElem` errorTree)
    print $ tDelete 992 errorTree
    putStrLn "The final tree ends up containing two 993 values; one as the root (intended), and one further down (unintended. It should have been deleted in the last case of the last guard of tDelete)"

Answer 1

I think your problem is the line

tDelete _ n@(Node ETree ETree _) = n -- Or give "Not found" error?

It breaks if the value you are looking for actually is in that node. Also, it is redundant with the next pattern, so I think you can just remove it.