Binary Heap, Haskell and JS

minbinaryHeap.hs

module BinaryHeap(empty, insert, minimum, extractMin) where

import Prelude hiding (minimum)

data BinHeap a = Empty
               | Node Bool (BinHeap a) a (BinHeap a)
               deriving (Show)

empty :: BinHeap a
empty = Empty

insert :: (Ord a) => a -> BinHeap a -> BinHeap a
insert x Empty = Node True Empty x Empty
insert x (Node True  h1 y h2) = Node False (insert (max x y) h1) (min x y) h2
insert x (Node False h1 y h2) = Node True h1 (min x y) (insert (max x y) h2)

minimum :: BinHeap a -> a
minimum (Node _ _ x _) = x

extractMin :: Ord a => BinHeap a -> (a, BinHeap a)
extractMin Empty                  = error "Cannot extract minimum from an empty heap"
extractMin (Node _ Empty x Empty) = (x, Empty)
extractMin (Node True h1 x h2)    =
  let (y,h2') = extractMin h2
      (z,h1') = siftDown y h1
   in (x, Node False h1' z h2')
extractMin (Node False h1 x h2)   =
  let (y,h1') = extractMin h1
      (z,h2') = siftDown y h2
   in (x, Node True h1' z h2')

siftDown :: Ord a => a -> BinHeap a -> (a, BinHeap a)
siftDown x Empty = (x, Empty)
siftDown x h@(Node b h1 y h2)
  | x > y = (y, downHeap $ Node b h1 x h2)
  | otherwise = (x, h)

downHeap :: Ord a => BinHeap a -> BinHeap a
downHeap (Node b h1 x h2) =
  if minRoot h1 h2
  then let (x',h1') = siftDown x h1
       in (Node b h1' x' h2)
  else let (x',h2') = siftDown x h2
       in (Node b h1 x' h2')
downHeap h = h

minRoot :: Ord a => BinHeap a -> BinHeap a -> Bool
minRoot (Node _ _ x _) (Node _ _ y _) = x <= y
minRoot _ Empty = True
minRoot _ _     = False

minbinaryHeap.js

const bh = (v, x, y, d) => z => z(v, x, y, d)
const value = z => z((v, x, y, d) => v)
const left = z => z((v, x, y, d) => x)
const right = z => z((v, x, y, d) => y)
const direction = z => z((v, x, y, d) => d)

const insert = (tree, data) => {
  if(tree === null) {
    return bh(data, null, null, true)
  }
  const isLeft = direction(tree)
  const v = value(tree)
  const l = left(tree)
  const r = right(tree)
  if(isLeft) {
    return bh(Math.min(data, v), insert(l, Math.max(data, v)), r, false)
  }
  return bh(Math.min(data, v), l, insert(r, Math.max(data, v)), true)
}
const extractMin = (tree) => {
  if(!tree) {
    return []
  }
  const l = left(tree)
  const r = right(tree)
  const isLeft = direction(tree)
  const v = value(tree)
  if(!l && !r) {
    return [v, null]
  }
  if(isLeft) {
    const [x, r1] = extractMin(r)
    const [z, l1] = siftDown(x, l)
    return [v, bh(z, l1, r1, false)]
  }
  const [z, l1] = extractMin(l)
  const [x, r1] = siftDown(z, r)
  return [v, bh(x, l1, r1, true)]
}

const downHeap = (tree) => {
  if(minroot(left(tree), right(tree))) {
    const [x, h1] = siftDown(value(tree), left(tree))
    return bh(x, h1, right(tree), direction(tree))
  }
  const [y, h2] = siftDown(value(tree), right(tree))
  return bh(y, left(tree), h2, direction(tree))
}
const siftDown = (data, tree) => {
  if(!tree) {
    return [data, null]
  }
  // console.log('how many times do we get here?', tree)
  const v = value(tree)
  const d = direction(tree)
  const l = left(tree)
  const r = right(tree)
  if(data > v) {
    return [v, downHeap(bh(data, l, r, d))]
  }
  return [data, tree]
}
const minroot = (l, r) => {
  if(l && !r) {
    return true
  }
  if(!l || !r) {
    return false
  }
  const vl = value(l)
  const vr = value(r)
  return vl < vr
}
const preorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return [value(tree)].concat(preorderArray(left(tree))).concat(preorderArray(right(tree)))
}
const inorderArray = (tree) => {
  if(!tree) {
    return [];
  }
  return inorderArray(left(tree)).concat([value(tree)]).concat(inorderArray(right(tree)))
}

const recursiveInsert = (arr, tree) => {
  const [first, ...rest] = arr
  if(!first) {
    return tree
  }
  return recursiveInsert(rest, insert(tree, first))
}

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

const logWithInOrder = (tree, arr=[]) => {
  if(!tree || !value(tree)) {
    return arr
  }
  const [x, y] = extractMin(tree)
  // console.log(x, 'xxx')
  return logWithInOrder(y, arr.concat(x))
}
logWithInOrder(x)