Balancing trees with javascript and haskell

avl.hs

module AVLTree where 
data BT = L | N Int BT BT deriving (Show, Eq)

-- utility functions
empty = L

depth L = 0
depth (N _ t u) = (max (depth t) (depth u)) + 1

inorder :: BT -> [Int]
inorder L = []
inorder (N v t u) = inorder t ++ [v] ++ inorder u

left (N _ t _) = t
right (N _ _ u) = u
value (N v _ _) = v

btmin = head . inorder

balFactor :: BT -> BT -> Int
balFactor t u = (depth t) - (depth u)

search :: BT -> Int -> Maybe [Int]
search L s = Nothing
search (N v t u) s 
    | v == s                  = Just []
    | (search t s) /= Nothing = fmap ((:) 0) (search t s)
    | (search u s) /= Nothing = fmap ((:) 1) (search u s)
    | otherwise               = Nothing

-- Complementary to search: get the node with the path
getelem :: BT -> [Int] -> Maybe Int
getelem L _ = Nothing
getelem (N v _ _) [] = Just v
getelem (N v t u) (x:xs)
    | x == 0    = getelem t xs
    | otherwise = getelem u xs

-- according to http://en.wikipedia.org/wiki/Image:Tree_Rebalancing.gif
balanceLL (N v (N vl tl ul) u)              = (N vl tl (N v ul u))
balanceLR (N v (N vl tl (N vlr tlr ulr)) u) = (N vlr (N vl tl tlr) (N v ulr u))
balanceRL (N v t (N vr (N vrl trl url) ur)) = (N vrl (N v t trl) (N vr url ur)) 
balanceRR (N v t (N vr tr ur))              = (N vr (N v t tr) ur)

-- Balanced insert
insert :: BT -> Int -> BT
insert L i = (N i L L)
insert (N v t u) i
    | i == v = (N v t u)
    | i < v && (balFactor ti u) ==  2 && i < value t = balanceLL (N v ti u)
    | i < v && (balFactor ti u) ==  2 && i > value t = balanceLR (N v ti u)
    | i > v && (balFactor t ui) == -2 && i < value u = balanceRL (N v t ui)
    | i > v && (balFactor t ui) == -2 && i > value u = balanceRR (N v t ui)
    | i < v  = (N v ti u)
    | i > v  = (N v t ui)
        where ti = insert t i
              ui = insert u i

-- Balanced delete
delete :: BT -> Int -> BT
delete L d = L
delete (N v L L) d = if v == d then L else (N v L L)
delete (N v t L) d = if v == d then t else (N v t L)
delete (N v L u) d = if v == d then u else (N v L u)
delete (N v t u) d
    | v == d                            = (N mu t dmin)
    | v > d && abs (balFactor dt u) < 2 = (N v dt u)
    | v < d && abs (balFactor t du) < 2 = (N v t du)
    | v > d && (balFactor (left u) (right u)) < 0 = balanceRR (N v dt u) 
    | v < d && (balFactor (left t) (right t)) > 0 = balanceLL (N v t du)
    | v > d                                       = balanceRL (N v dt u)
    | v < d                                       = balanceLR (N v t du)
        where dmin = delete u mu
              dt   = delete t d
              du   = delete u d
              mu   = btmin u

-- Test Functions
load :: BT -> [Int] -> BT
load t []     = t
load t (x:xs) = insert (load t xs) x

unload :: BT -> [Int] -> BT
unload t []     = t
unload t (x:xs) = delete (unload t xs) x

sort :: [Int] -> [Int]
sort = inorder . (load empty)

isBalanced L = True
isBalanced (N _ t u) = isBalanced t && isBalanced u && abs (balFactor t u) < 2

avl.js

const bt = (val, left, right) => z => z(val, left, right)
const val = (z) => z((val, left, right ) => val)
const left = (z) => z((val, left, right ) => left)
const right = (z) => z((val, left, right ) => right)

const insertWithoutBalance = (tree, data) => {
  if(tree === null) {
    return bt(data, null, null)
  }
  if (data < val(tree)) {
    return bt(val(tree), insert(left(tree), data), right(tree))
  }
  return bt(val(tree), left(tree), insert(right(tree), data))
}

const getHeight = (tree) => {
  if(tree == null) return 0;
  return 1 + Math.max(getHeight(left(tree)), getHeight(right(tree)));
}

const balanceFactor = (left, right) => {
  return getHeight(left) - getHeight(right)
}


// according to http://en.wikipedia.org/wiki/Image:Tree_Rebalancing.gif
// balanceLL (N v (N vl tl ul) u) = (N vl tl (N v ul u))

const balanceLL = (tree) => {
  const v = val(tree)
  const left_tree = left(tree)
  const vl = val(left_tree)
  const tl = left(left_tree)
  const ul = right(left_tree)
  const u = right(tree)
  return bt(vl, tl, bt(v, ul, u))
}

// balanceRR (N v t (N vr tr ur))  = (N vr (N v t tr) ur)
const balanceRR = (tree) => {
  const v = val(tree)
  const t = left(tree)
  const right_tree = right(tree)
  const vr = val(right_tree)
  const tr = left(right_tree)
  const ur = right(right_tree)
  return bt(vr, bt(v, t, tr), ur)
}


// balanceLR (N v (N vl tl (N vlr tlr ulr)) u) = (N vlr (N vl tl tlr) (N v ulr u))
const balanceLR = (tree) => {
  const v = val(tree)
  const left_tree = left(tree)
  const vl = val(left_tree)
  const tl = left(left_tree)
  const left_right_tree = right(left_tree)
  const vlr = val(left_right_tree)
  const tlr = left(left_right_tree)
  const ulr = right(left_right_tree)
  const u = right(tree)
  return bt(vlr, bt(vl, tl, tlr), bt(v, ulr, u))
}

// balanceRL (N v t (N vr (N vrl trl url) ur)) = (N vrl (N v t trl) (N vr url ur)) 
const balanceRL = (tree) => {
  const v = val(tree)
  const t = left(tree)
  const right_tree = right(tree)
  const vr = val(right_tree)
  const right_left_tree = left(right_tree)
  const vrl = val(right_left_tree)
  const trl = left(right_left_tree)
  const url = right(right_left_tree)
  const ur = right(right_tree)
  return bt(vrl, bt(v, t, trl), bt(vr, url, ur))
}

const insert = (tree, data) => {
  if(tree === null || val(tree) === null) {
    return bt(data, null, null)
  }
  const value = val(tree)
  if(value === data) {
    return tree
  }
  const t = left(tree)
  const u = right(tree)
  const ti = () => insert(t, data)
  const ui = () => insert(u, data)
  if(data < value && balanceFactor(ti(), u) === 2 && data < val(t)) {
    return balanceLL(bt(value, ti(), u))
  }
  if(data < value && balanceFactor(ti(), u) === 2 && data > val(t)) {
    return balanceLR(bt(value, ti(), u))
  }
  if(data > value && balanceFactor(t, ui()) === -2 && data < val(u)) {
    return balanceRL(bt(value, t, ui()))
  }
  if(data > value && balanceFactor(t, ui()) === -2 && data > val(u)) {
    return balanceRR(bt(value, t, ui()))
  }
  if(data < value) {
    return bt(value, ti(), u)
  }
  if (data > value) {
    return bt(value, t, ui())
  }
}

const smallestNode = (tree) => {
  if(!left(tree)) {
    return tree
  }
  return smallestNode(left(tree))
}

const deleteTree = (tree, data) => {
  if(tree === null) {
    return null
  }
  const v = val(tree)
  const t = left(tree)
  const u = right(tree)
  const dt = () => deleteTree(t, data)
  const du = () => deleteTree(u, data)
  if(v === data && u === null && t === null) {
    return null
  }
  if(v === data && u === null) {
    return t
  }
  if(v === data && t === null) {
    return u
  }
  if(v === data) {
    const value = val(smallestNode(u))
    return bt(value, t, deleteTree(u, value))
  }
  if (v > data && Math.abs(balanceFactor(dt(), u)) < 2) {
    return bt(v, dt(), u)
  }
  if (v < data && Math.abs(balanceFactor(t, du())) < 2) {
    return bt(v, t, du())
  }
  if(v > data && balanceFactor(left(u), right(u)) < 0) {
    return balanceRR(bt(v, dt(), u))
  }
  if(v < data && balanceFactor(left(t), right(t)) > 0) {
    return balanceLL(bt(v, t, du()))
  }
  if(v > data) {
    return balanceRL(bt(v, dt(), u))
  }
  if(v < data) {
    return balanceLR(bt(v, t, du()))
  }
}
const search = (tree, data) => {
  if(tree == null) return false;
  if(data < val(tree)) return search(left(tree), data)
  if(data > val(tree)) return search(right(tree), data)
  if(val(tree) == data) return true
}

const preorder = (tree) => {
  if(tree === null) {
    return
  }

  console.log(val(tree), 'treee')
  preorder(left(tree))
  preorder(right(tree))
}

const preorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return [val(tree)].concat(preorderArray(left(tree))).concat(preorderArray(right(tree)))
}

const inorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return inorderArray(left(tree)).concat([val(tree)]).concat(inorderArray(right(tree)))
}

const postorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return postorderArray(left(tree)).concat(postorderArray(right(tree))).concat([val(tree)])
}

const outOrderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return outOrderArray(right(tree)).concat([val(tree)].concat(outOrderArray(left(tree))))
}

const isBalanced = (tree) => {
  if(!tree) {
    return true;
  }
  const t = left(tree)
  const u = right(tree)
  return isBalanced(t) && isBalanced(u) && Math.abs(balanceFactor(t, u)) < 2
}
const recursiveInsert = (arr, tree = bt(null, null, null)) => {
  const [first, ...rest] = arr
  if(!first) {
    return tree
  }
  return recursiveInsert(rest, insert(tree, first))
}


// y = insertWithoutBalance(y, 80)


const x = recursiveInsert([10, 20, 30, 40, 50, 25, 45, 48, 49, 57, 42, 49.5, 58])

let y = bt(50, null, null)
y = insertWithoutBalance(y, 20)
y = insertWithoutBalance(y, 10)
const b = deleteTree(x, 58)

console.log(isBalanced(b), 'balanced?')
console.log(isBalanced(y), 'balanced??')

// debugging
preorder(x)
preorder(b)
///
console.log(preorderArray(x), 'pre-order')
console.log(inorderArray(x), 'sort')
console.log(outOrderArray(x), 'reverse sort')

console.log(postorderArray(x), 'post order')

// Then we can have a utility sort functions without array sort and reverse sort  like so
const compose = f => g => x => f(g(x))

const sort = compose(inorderArray)(recursiveInsert)
const reverseSort = compose(outOrderArray)(recursiveInsert)
console.log(sort([45,100, 77, 20, 35, 80, 200]), 'the sort?')
console.log(reverseSort([45,100, 77, 20, 35, 80, 200]), 'the reverse sort?')

haskellusingfoldsandmap.hs

module AVLTree where 
data BT a = L | N a (BT a) (BT a) deriving (Show, Eq)

-- utility functions
empty = L

depth L = 0
depth (N _ t u) = (max (depth t) (depth u)) + 1

inorder :: BT a -> [a]
inorder L = []
inorder (N v t u) = inorder t ++ [v] ++ inorder u

left (N _ t _) = t
right (N _ _ u) = u
value (N v _ _) = v

btmin = head . inorder

balFactor :: (Ord a, Num a) => BT a -> BT a -> a
balFactor t u = (depth t) - (depth u)

search :: (Num a, Ord a) =>  BT a -> a -> Maybe [a]
search L s = Nothing
search (N v t u) s 
    | v == s                  = Just []
    | (search t s) /= Nothing = fmap ((:) 0) (search t s)
    | (search u s) /= Nothing = fmap ((:) 1) (search u s)
    | otherwise               = Nothing

-- Complementary to search: get the node with the path
getelem :: (Num a, Ord a) => BT a -> [a] -> Maybe a
getelem L _ = Nothing
getelem (N v _ _) [] = Just v
getelem (N v t u) (x:xs)
    | x == 0    = getelem t xs
    | otherwise = getelem u xs

-- according to http://en.wikipedia.org/wiki/Image:Tree_Rebalancing.gif
balanceLL (N v (N vl tl ul) u)              = (N vl tl (N v ul u))
balanceLR (N v (N vl tl (N vlr tlr ulr)) u) = (N vlr (N vl tl tlr) (N v ulr u))
balanceRL (N v t (N vr (N vrl trl url) ur)) = (N vrl (N v t trl) (N vr url ur)) 
balanceRR (N v t (N vr tr ur))              = (N vr (N v t tr) ur)

-- Balanced insert
insert :: (Num a, Ord a) => BT a -> a -> BT a
insert L i = (N i L L)
insert (N v t u) i
    | i == v = (N v t u)
    | (balFactor ti u) ==  2 && i < value t = balanceLL (N v ti u)
    | (balFactor ti u) ==  2 && i > value t = balanceLR (N v ti u)
    | (balFactor t ui) == -2 && i < value u = balanceRL (N v t ui)
    | (balFactor t ui) == -2 && i > value u = balanceRR (N v t ui)
    | i < v  = (N v ti u)
    | i > v  = (N v t ui)
        where ti = insert t i
              ui = insert u i

-- Balanced delete
delete :: (Num a, Ord a) => BT a -> a -> BT a
delete L d = L
delete (N v L L) d = if v == d then L else (N v L L)
delete (N v t L) d = if v == d then t else (N v t L)
delete (N v L u) d = if v == d then u else (N v L u)
delete (N v t u) d
    | v == d                            = (N mu t dmin)
    | v > d &&  (balFactor dt u) < 2 = (N v dt u)
    | v < d &&  (balFactor t du) < -2 = (N v t du)
    | v > d && (balFactor (left u) (right u)) < 0 = balanceRR (N v dt u) 
    | v < d && (balFactor (left t) (right t)) > 0 = balanceLL (N v t du)
    | v > d                                       = balanceRL (N v dt u)
    | v < d                                       = balanceLR (N v t du)
        where dmin = delete u mu
              dt   = delete t d
              du   = delete u d
              mu   = btmin u

-- Test Functions
load :: (Num a, Ord a) => BT a -> [a] -> BT a
load t []     = t
load t (x:xs) = insert (load t xs) x

unload :: (Num a, Ord a) => BT a -> [a] -> BT a
unload t []     = t
unload t (x:xs) = delete (unload t xs) x

sort :: [Int] -> [Int]
sort = inorder . (load empty)

isBalanced L = True
isBalanced (N _ t u) = isBalanced t && isBalanced u && abs (balFactor t u) < 2

mapTree :: (a -> b) -> BT a -> BT b
mapTree _ L = L
mapTree f (N v t l) = N (f v) (mapTree f t) (mapTree f l)

foldTRee :: (a -> b -> b) -> b -> BT a -> b 
foldTRee f z L = z
foldTRee f z (N v l r) = foldTRee f ( f v (foldTRee f z l ) ) r

--b = load L [10, 20, 30, 40, 50, 25, 45, 48, 49, 57, 42, 52, 58]
b = foldl (\x y -> insert x y) L [10, 20, 30, 40, 50, 25, 45, 48, 49, 57, 42, 52, 58]
main = do
  show.inorder $ unload b [40]

javascriptwithfoldsandmap.js

const bt = (val, left, right) => z => z(val, left, right)
const val = (z) => z((val, left, right ) => val)
const left = (z) => z((val, left, right ) => left)
const right = (z) => z((val, left, right ) => right)

const insertWithoutBalance = (tree, data) => {
  if(tree === null) {
    return bt(data, null, null)
  }
  if (data < val(tree)) {
    return bt(val(tree), insert(left(tree), data), right(tree))
  }
  return bt(val(tree), left(tree), insert(right(tree), data))
}

const getHeight = (tree) => {
  if(tree == null) return 0;
  return 1 + Math.max(getHeight(left(tree)), getHeight(right(tree)));
}

const balanceFactor = (left, right) => {
  return getHeight(left) - getHeight(right)
}


// according to http://en.wikipedia.org/wiki/Image:Tree_Rebalancing.gif
// balanceLL (N v (N vl tl ul) u) = (N vl tl (N v ul u))

const balanceLL = (tree) => {
  const v = val(tree)
  const left_tree = left(tree)
  const vl = val(left_tree)
  const tl = left(left_tree)
  const ul = right(left_tree)
  const u = right(tree)
  return bt(vl, tl, bt(v, ul, u))
}

// balanceRR (N v t (N vr tr ur))  = (N vr (N v t tr) ur)
const balanceRR = (tree) => {
  const v = val(tree)
  const t = left(tree)
  const right_tree = right(tree)
  const vr = val(right_tree)
  const tr = left(right_tree)
  const ur = right(right_tree)
  return bt(vr, bt(v, t, tr), ur)
}


// balanceLR (N v (N vl tl (N vlr tlr ulr)) u) = (N vlr (N vl tl tlr) (N v ulr u))
const balanceLR = (tree) => {
  const v = val(tree)
  const left_tree = left(tree)
  const vl = val(left_tree)
  const tl = left(left_tree)
  const left_right_tree = right(left_tree)
  const vlr = val(left_right_tree)
  const tlr = left(left_right_tree)
  const ulr = right(left_right_tree)
  const u = right(tree)
  return bt(vlr, bt(vl, tl, tlr), bt(v, ulr, u))
}

// balanceRL (N v t (N vr (N vrl trl url) ur)) = (N vrl (N v t trl) (N vr url ur)) 
const balanceRL = (tree) => {
  const v = val(tree)
  const t = left(tree)
  const right_tree = right(tree)
  const vr = val(right_tree)
  const right_left_tree = left(right_tree)
  const vrl = val(right_left_tree)
  const trl = left(right_left_tree)
  const url = right(right_left_tree)
  const ur = right(right_tree)
  return bt(vrl, bt(v, t, trl), bt(vr, url, ur))
}

const insert = (tree, data) => {
  if(tree === null || val(tree) === null) {
    return bt(data, null, null)
  }
  const value = val(tree)
  if(value === data) {
    return tree
  }
  const t = left(tree)
  const u = right(tree)
  const ti = () => insert(t, data)
  const ui = () => insert(u, data)
  if(data < value && balanceFactor(ti(), u) === 2 && data < val(t)) {
    return balanceLL(bt(value, ti(), u))
  }
  if(data < value && balanceFactor(ti(), u) === 2 && data > val(t)) {
    return balanceLR(bt(value, ti(), u))
  }
  if(data > value && balanceFactor(t, ui()) === -2 && data < val(u)) {
    return balanceRL(bt(value, t, ui()))
  }
  if(data > value && balanceFactor(t, ui()) === -2 && data > val(u)) {
    return balanceRR(bt(value, t, ui()))
  }
  if(data < value) {
    return bt(value, ti(), u)
  }
  if (data > value) {
    return bt(value, t, ui())
  }
}

const smallestNode = (tree) => {
  if(!left(tree)) {
    return tree
  }
  return smallestNode(left(tree))
}

const deleteTree = (tree, data) => {
  if(tree === null) {
    return null
  }
  const v = val(tree)
  const t = left(tree)
  const u = right(tree)
  const dt = () => deleteTree(t, data)
  const du = () => deleteTree(u, data)
  if(v === data && u === null && t === null) {
    return null
  }
  if(v === data && u === null) {
    return t
  }
  if(v === data && t === null) {
    return u
  }
  if(v === data) {
    const value = val(smallestNode(u))
    return bt(value, t, deleteTree(u, value))
  }
  if (v > data && Math.abs(balanceFactor(dt(), u)) < 2) {
    return bt(v, dt(), u)
  }
  if (v < data && Math.abs(balanceFactor(t, du())) < 2) {
    return bt(v, t, du())
  }
  if(v > data && balanceFactor(left(u), right(u)) < 0) {
    return balanceRR(bt(v, dt(), u))
  }
  if(v < data && balanceFactor(left(t), right(t)) > 0) {
    return balanceLL(bt(v, t, du()))
  }
  if(v > data) {
    return balanceRL(bt(v, dt(), u))
  }
  if(v < data) {
    return balanceLR(bt(v, t, du()))
  }
}
const search = (tree, data) => {
  if(tree == null) return false;
  if(data < val(tree)) return search(left(tree), data)
  if(data > val(tree)) return search(right(tree), data)
  if(val(tree) == data) return true
}


const preorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return [val(tree)].concat(preorderArray(left(tree))).concat(preorderArray(right(tree)))
}

const inorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return inorderArray(left(tree)).concat([val(tree)]).concat(inorderArray(right(tree)))
}

const postorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return postorderArray(left(tree)).concat(postorderArray(right(tree))).concat([val(tree)])
}

const outOrderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return outOrderArray(right(tree)).concat([val(tree)].concat(outOrderArray(left(tree))))
}

const isBalanced = (tree) => {
  if(!tree) {
    return true;
  }
  const t = left(tree)
  const u = right(tree)
  return isBalanced(t) && isBalanced(u) && Math.abs(balanceFactor(t, u)) < 2
}
const recursiveInsert = (arr, tree = bt(null, null, null)) => {
  const [first, ...rest] = arr
  if(!first) {
    return tree
  }
  return recursiveInsert(rest, insert(tree, first))
}

const mapTree = (f, tree) => {
  if(!tree) {
    return null;
  }

  return bt(f(val(tree)), mapTree(f, left(tree)), mapTree(f, right(tree)))
} 
// y = insertWithoutBalance(y, 80)

const reduceLeft = (f, initialValue, tree) => {
  if(!tree) {
    return initialValue
  }
  return reduce(f, f(val(tree), reduce(f, initialValue, left(tree))), right(tree))
}
// const x = recursiveInsert([10, 20, 30, 40, 50, 25, 45, 48, 49, 57, 42, 49.5, 58])

const reduceInsert = g =>  g.reduce((acc, x) => insert(acc, x), null)

const s = [10, 20, 30, 40, 50, 25, 45, 48, 49, 57, 42, 49.5, 58]
const x = mapTree((x => x * 2), reduceInsert(s))

let y = bt(50, null, null)
y = insertWithoutBalance(y, 20)
y = insertWithoutBalance(y, 10)
const b = deleteTree(x, 58)

console.log(isBalanced(b), 'balanced?')
console.log(isBalanced(y), 'balanced??')

// debugging
///
console.log(preorderArray(x), 'pre-order')
console.log(inorderArray(x), 'sort')
console.log(outOrderArray(x), 'reverse sort')

console.log(postorderArray(x), 'post order')

// Then we can have a utility sort functions without array sort and reverse sort  like so
const compose = f => g => x => f(g(x))

const sort = compose(inorderArray)(recursiveInsert)
const reverseSort = compose(outOrderArray)(recursiveInsert)
console.log(sort([45,100, 77, 20, 35, 80, 200]), 'the sort?')
console.log(reverseSort([45,100, 77, 20, 35, 80, 200]), 'the reverse sort?')
console.log(inorderArray(x))