--
-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net
-- New BSD License (see http://www.opensource.org/licenses/bsd-license.php)
--

module Data.Heap.Skew 
(SkewHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert) 
where

import Prelude hiding (head, tail, null)
import qualified Data.List as L

data (Ord a) => SkewHeap a =
    SkewLeaf
  | SkewHeap a (SkewHeap a) (SkewHeap a) deriving (SkewHeap a -> SkewHeap a -> Bool
(SkewHeap a -> SkewHeap a -> Bool)
-> (SkewHeap a -> SkewHeap a -> Bool) -> Eq (SkewHeap a)
forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
== :: SkewHeap a -> SkewHeap a -> Bool
$c/= :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
/= :: SkewHeap a -> SkewHeap a -> Bool
Eq, Eq (SkewHeap a)
Eq (SkewHeap a) =>
(SkewHeap a -> SkewHeap a -> Ordering)
-> (SkewHeap a -> SkewHeap a -> Bool)
-> (SkewHeap a -> SkewHeap a -> Bool)
-> (SkewHeap a -> SkewHeap a -> Bool)
-> (SkewHeap a -> SkewHeap a -> Bool)
-> (SkewHeap a -> SkewHeap a -> SkewHeap a)
-> (SkewHeap a -> SkewHeap a -> SkewHeap a)
-> Ord (SkewHeap a)
SkewHeap a -> SkewHeap a -> Bool
SkewHeap a -> SkewHeap a -> Ordering
SkewHeap a -> SkewHeap a -> SkewHeap a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (SkewHeap a)
forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
forall a. Ord a => SkewHeap a -> SkewHeap a -> Ordering
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
$ccompare :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Ordering
compare :: SkewHeap a -> SkewHeap a -> Ordering
$c< :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
< :: SkewHeap a -> SkewHeap a -> Bool
$c<= :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
<= :: SkewHeap a -> SkewHeap a -> Bool
$c> :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
> :: SkewHeap a -> SkewHeap a -> Bool
$c>= :: forall a. Ord a => SkewHeap a -> SkewHeap a -> Bool
>= :: SkewHeap a -> SkewHeap a -> Bool
$cmax :: forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
max :: SkewHeap a -> SkewHeap a -> SkewHeap a
$cmin :: forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
min :: SkewHeap a -> SkewHeap a -> SkewHeap a
Ord)

empty :: (Ord a) => SkewHeap a
empty :: forall a. Ord a => SkewHeap a
empty = SkewHeap a
forall a. SkewHeap a
SkewLeaf

null :: (Ord a) => SkewHeap a -> Bool
null :: forall a. Ord a => SkewHeap a -> Bool
null SkewHeap a
SkewLeaf = Bool
True
null SkewHeap a
_ = Bool
False

singleton :: (Ord a) => a -> SkewHeap a
singleton :: forall a. Ord a => a -> SkewHeap a
singleton a
n = a -> SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => a -> SkewHeap a -> SkewHeap a -> SkewHeap a
SkewHeap a
n SkewHeap a
forall a. SkewHeap a
SkewLeaf SkewHeap a
forall a. SkewHeap a
SkewLeaf

insert :: (Ord a) => a -> SkewHeap a -> SkewHeap a
insert :: forall a. Ord a => a -> SkewHeap a -> SkewHeap a
insert a
a SkewHeap a
h = SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
merge SkewHeap a
h (a -> SkewHeap a
forall a. Ord a => a -> SkewHeap a
singleton a
a)

merge :: (Ord a) => SkewHeap a -> SkewHeap a -> SkewHeap a
merge :: forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
merge SkewHeap a
SkewLeaf SkewHeap a
n = SkewHeap a
n
merge SkewHeap a
n SkewHeap a
SkewLeaf = SkewHeap a
n
merge SkewHeap a
h1 SkewHeap a
h2 = (SkewHeap a -> SkewHeap a -> SkewHeap a)
-> [SkewHeap a] -> SkewHeap a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
assemble ([SkewHeap a] -> SkewHeap a) -> [SkewHeap a] -> SkewHeap a
forall a b. (a -> b) -> a -> b
$ [SkewHeap a] -> [SkewHeap a]
forall a. [a] -> [a]
reverse ([SkewHeap a] -> [SkewHeap a]) -> [SkewHeap a] -> [SkewHeap a]
forall a b. (a -> b) -> a -> b
$ (SkewHeap a -> a) -> [SkewHeap a] -> [SkewHeap a] -> [SkewHeap a]
forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
listMerge SkewHeap a -> a
forall a. Ord a => SkewHeap a -> a
head (SkewHeap a -> [SkewHeap a]
forall a. Ord a => SkewHeap a -> [SkewHeap a]
cutRight SkewHeap a
h1) (SkewHeap a -> [SkewHeap a]
forall a. Ord a => SkewHeap a -> [SkewHeap a]
cutRight SkewHeap a
h2)

listMerge :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]
listMerge :: forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
listMerge a -> b
_ [] [a]
s = [a]
s
listMerge a -> b
_ [a]
f [] = [a]
f
listMerge a -> b
c f :: [a]
f@(a
h1:[a]
t1) s :: [a]
s@(a
h2:[a]
t2) =
  if a -> b
c a
h1  b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> b
c a
h2
  then a
h1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
listMerge a -> b
c [a]
t1 [a]
s
  else a
h2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a] -> [a]
listMerge a -> b
c [a]
f [a]
t2

cutRight :: (Ord a) => SkewHeap a -> [SkewHeap a]
cutRight :: forall a. Ord a => SkewHeap a -> [SkewHeap a]
cutRight SkewHeap a
SkewLeaf = []
cutRight (SkewHeap a
a SkewHeap a
l SkewHeap a
r) =  a -> SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => a -> SkewHeap a -> SkewHeap a -> SkewHeap a
SkewHeap a
a SkewHeap a
l SkewHeap a
forall a. SkewHeap a
SkewLeaf SkewHeap a -> [SkewHeap a] -> [SkewHeap a]
forall a. a -> [a] -> [a]
: SkewHeap a -> [SkewHeap a]
forall a. Ord a => SkewHeap a -> [SkewHeap a]
cutRight SkewHeap a
r

-- assumes h1 >= h2, merge relies on this
assemble :: (Ord a) => SkewHeap a -> SkewHeap a -> SkewHeap a
assemble :: forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
assemble SkewHeap a
h1 (SkewHeap a
a SkewHeap a
l SkewHeap a
SkewLeaf) = a -> SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => a -> SkewHeap a -> SkewHeap a -> SkewHeap a
SkewHeap a
a SkewHeap a
h1 SkewHeap a
l
assemble SkewHeap a
_ SkewHeap a
_ = [Char] -> SkewHeap a
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid heap assembly"

head :: (Ord a) => SkewHeap a -> a
head :: forall a. Ord a => SkewHeap a -> a
head SkewHeap a
SkewLeaf = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"head of empty heap"
head (SkewHeap a
a SkewHeap a
_ SkewHeap a
_) = a
a

tail :: (Ord a) => SkewHeap a -> SkewHeap a
tail :: forall a. Ord a => SkewHeap a -> SkewHeap a
tail SkewHeap a
SkewLeaf = [Char] -> SkewHeap a
forall a. HasCallStack => [Char] -> a
error [Char]
"tail of empty heap"
tail (SkewHeap a
_ SkewHeap a
l SkewHeap a
r) = SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
merge SkewHeap a
l SkewHeap a
r

toList :: (Ord a) => SkewHeap a -> [a]
toList :: forall a. Ord a => SkewHeap a -> [a]
toList SkewHeap a
SkewLeaf = []
toList (SkewHeap a
n SkewHeap a
l SkewHeap a
r) = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: SkewHeap a -> [a]
forall a. Ord a => SkewHeap a -> [a]
toList (SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
merge SkewHeap a
l SkewHeap a
r)

fromList :: (Ord a) => [a] -> SkewHeap a
fromList :: forall a. Ord a => [a] -> SkewHeap a
fromList [] = SkewHeap a
forall a. SkewHeap a
SkewLeaf
fromList [a]
l = [SkewHeap a] -> SkewHeap a
forall {a}. Ord a => [SkewHeap a] -> SkewHeap a
mergeList ((a -> SkewHeap a) -> [a] -> [SkewHeap a]
forall a b. (a -> b) -> [a] -> [b]
map a -> SkewHeap a
forall a. Ord a => a -> SkewHeap a
singleton [a]
l)
              where mergeList :: [SkewHeap a] -> SkewHeap a
mergeList [SkewHeap a
a] = SkewHeap a
a
                    mergeList [SkewHeap a]
x = [SkewHeap a] -> SkewHeap a
mergeList ([SkewHeap a] -> [SkewHeap a]
forall {a}. Ord a => [SkewHeap a] -> [SkewHeap a]
mergePairs [SkewHeap a]
x)
                    mergePairs :: [SkewHeap a] -> [SkewHeap a]
mergePairs (SkewHeap a
a:SkewHeap a
b:[SkewHeap a]
c) =  SkewHeap a -> SkewHeap a -> SkewHeap a
forall a. Ord a => SkewHeap a -> SkewHeap a -> SkewHeap a
merge SkewHeap a
a SkewHeap a
b SkewHeap a -> [SkewHeap a] -> [SkewHeap a]
forall a. a -> [a] -> [a]
: [SkewHeap a] -> [SkewHeap a]
mergePairs [SkewHeap a]
c
                    mergePairs [SkewHeap a]
x = [SkewHeap a]
x