    {-# LANGUAGE CPP #-}

    -- | Pairing heap implementation of dictionary
    module Data.Graph.Inductive.Internal.Heap(
        -- * Type
        Heap(..),
        prettyHeap,
        printPrettyHeap,
        -- * Operations
        empty,unit,insert,merge,mergeAll,
        isEmpty,findMin,deleteMin,splitMin,
        build, toList, heapsort
    ) where

    import Text.Show (showListWith)

    #if MIN_VERSION_containers (0,4,2)
    import Control.DeepSeq (NFData (..))
    #endif

    data Heap a b = Empty | Node a b [Heap a b]
         deriving (Heap a b -> Heap a b -> Bool
    (Heap a b -> Heap a b -> Bool)
    -> (Heap a b -> Heap a b -> Bool) -> Eq (Heap a b)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall a b. (Eq a, Eq b) => Heap a b -> Heap a b -> Bool
    $c== :: forall a b. (Eq a, Eq b) => Heap a b -> Heap a b -> Bool
    == :: Heap a b -> Heap a b -> Bool
    $c/= :: forall a b. (Eq a, Eq b) => Heap a b -> Heap a b -> Bool
    /= :: Heap a b -> Heap a b -> Bool
    Eq, Int -> Heap a b -> ShowS
    [Heap a b] -> ShowS
    Heap a b -> String
    (Int -> Heap a b -> ShowS)
    -> (Heap a b -> String) -> ([Heap a b] -> ShowS) -> Show (Heap a b)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall a b. (Show a, Show b) => Int -> Heap a b -> ShowS
    forall a b. (Show a, Show b) => [Heap a b] -> ShowS
    forall a b. (Show a, Show b) => Heap a b -> String
    $cshowsPrec :: forall a b. (Show a, Show b) => Int -> Heap a b -> ShowS
    showsPrec :: Int -> Heap a b -> ShowS
    $cshow :: forall a b. (Show a, Show b) => Heap a b -> String
    show :: Heap a b -> String
    $cshowList :: forall a b. (Show a, Show b) => [Heap a b] -> ShowS
    showList :: [Heap a b] -> ShowS
    Show, ReadPrec [Heap a b]
    ReadPrec (Heap a b)
    Int -> ReadS (Heap a b)
    ReadS [Heap a b]
    (Int -> ReadS (Heap a b))
    -> ReadS [Heap a b]
    -> ReadPrec (Heap a b)
    -> ReadPrec [Heap a b]
    -> Read (Heap a b)
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    forall a b. (Read a, Read b) => ReadPrec [Heap a b]
    forall a b. (Read a, Read b) => ReadPrec (Heap a b)
    forall a b. (Read a, Read b) => Int -> ReadS (Heap a b)
    forall a b. (Read a, Read b) => ReadS [Heap a b]
    $creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Heap a b)
    readsPrec :: Int -> ReadS (Heap a b)
    $creadList :: forall a b. (Read a, Read b) => ReadS [Heap a b]
    readList :: ReadS [Heap a b]
    $creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Heap a b)
    readPrec :: ReadPrec (Heap a b)
    $creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Heap a b]
    readListPrec :: ReadPrec [Heap a b]
    Read)

    #if MIN_VERSION_containers (0,4,2)
    instance (NFData a, NFData b) => NFData (Heap a b) where
      rnf :: Heap a b -> ()
    rnf Heap a b
    Empty         = ()
      rnf (Node a
    a b
    b [Heap a b]
    hs) = a -> ()
    forall a. NFData a => a -> ()
    rnf a
    a () -> () -> ()
    forall a b. a -> b -> b
    `seq` b -> ()
    forall a. NFData a => a -> ()
    rnf b
    b () -> () -> ()
    forall a b. a -> b -> b
    `seq` [Heap a b] -> ()
    forall a. NFData a => a -> ()
    rnf [Heap a b]
    hs
    #endif

    prettyHeap :: (Show a, Show b) => Heap a b -> String
    prettyHeap :: forall a b. (Show a, Show b) => Heap a b -> String
    prettyHeap = (Heap a b -> ShowS
    forall {a} {a}. (Show a, Show a) => Heap a a -> ShowS
    `showsHeap` String
    "")
      where
        showsHeap :: Heap a a -> ShowS
    showsHeap Heap a a
    Empty             = ShowS
    forall a. a -> a
    id
        showsHeap (Node a
    key a
    val []) = a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    key ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    ": "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    val
        showsHeap (Node a
    key a
    val [Heap a a]
    hs) = a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    key ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    ": "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    val
                                      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  (Char
    ' 'Char -> ShowS
    forall a. a -> [a] -> [a]
    :) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Heap a a -> ShowS) -> [Heap a a] -> ShowS
    forall a. (a -> ShowS) -> [a] -> ShowS
    showListWith Heap a a -> ShowS
    showsHeap [Heap a a]
    hs

    printPrettyHeap :: (Show a, Show b) => Heap a b -> IO ()
    printPrettyHeap :: forall a b. (Show a, Show b) => Heap a b -> IO ()
    printPrettyHeap = String -> IO ()
    putStrLn (String -> IO ()) -> (Heap a b -> String) -> Heap a b -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Heap a b -> String
    forall a b. (Show a, Show b) => Heap a b -> String
    prettyHeap

    ----------------------------------------------------------------------
    -- MAIN FUNCTIONS
    ----------------------------------------------------------------------

    empty :: Heap a b
    empty :: forall a b. Heap a b
    empty = Heap a b
    forall a b. Heap a b
    Empty

    unit :: a -> b -> Heap a b
    unit :: forall a b. a -> b -> Heap a b
    unit a
    key b
    val = a -> b -> [Heap a b] -> Heap a b
    forall a b. a -> b -> [Heap a b] -> Heap a b
    Node a
    key b
    val []

    insert :: (Ord a) => (a, b) -> Heap a b -> Heap a b
    insert :: forall a b. Ord a => (a, b) -> Heap a b -> Heap a b
    insert (a
    key, b
    val) = Heap a b -> Heap a b -> Heap a b
    forall a b. Ord a => Heap a b -> Heap a b -> Heap a b
    merge (a -> b -> Heap a b
    forall a b. a -> b -> Heap a b
    unit a
    key b
    val)

    merge :: (Ord a) => Heap a b -> Heap a b -> Heap a b
    merge :: forall a b. Ord a => Heap a b -> Heap a b -> Heap a b
    merge Heap a b
    h Heap a b
    Empty = Heap a b
    h
    merge Heap a b
    Empty Heap a b
    h = Heap a b
    h
    merge h :: Heap a b
    h@(Node a
    key1 b
    val1 [Heap a b]
    hs) h' :: Heap a b
    h'@(Node a
    key2 b
    val2 [Heap a b]
    hs')
        | a
    key1a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <a
    key2 = a -> b -> [Heap a b] -> Heap a b
    forall a b. a -> b -> [Heap a b] -> Heap a b
    Node a
    key1 b
    val1 (Heap a b
    h'Heap a b -> [Heap a b] -> [Heap a b]
    forall a. a -> [a] -> [a]
    :[Heap a b]
    hs)
        | Bool
    otherwise = a -> b -> [Heap a b] -> Heap a b
    forall a b. a -> b -> [Heap a b] -> Heap a b
    Node a
    key2 b
    val2 (Heap a b
    hHeap a b -> [Heap a b] -> [Heap a b]
    forall a. a -> [a] -> [a]
    :[Heap a b]
    hs')

    mergeAll:: (Ord a) => [Heap a b] -> Heap a b
    mergeAll :: forall a b. Ord a => [Heap a b] -> Heap a b
    mergeAll []        = Heap a b
    forall a b. Heap a b
    Empty
    mergeAll [Heap a b
    h]       = Heap a b
    h
    mergeAll (Heap a b
    h:Heap a b
    h':[Heap a b]
    hs) = Heap a b -> Heap a b -> Heap a b
    forall a b. Ord a => Heap a b -> Heap a b -> Heap a b
    merge (Heap a b -> Heap a b -> Heap a b
    forall a b. Ord a => Heap a b -> Heap a b -> Heap a b
    merge Heap a b
    h Heap a b
    h') ([Heap a b] -> Heap a b
    forall a b. Ord a => [Heap a b] -> Heap a b
    mergeAll [Heap a b]
    hs)

    isEmpty :: Heap a b -> Bool
    isEmpty :: forall a b. Heap a b -> Bool
    isEmpty Heap a b
    Empty = Bool
    True
    isEmpty Heap a b
    _     = Bool
    False

    findMin :: Heap a b -> (a, b)
    findMin :: forall a b. Heap a b -> (a, b)
    findMin Heap a b
    Empty      = String -> (a, b)
    forall a. HasCallStack => String -> a
    error String
    "Heap.findMin: empty heap"
    findMin (Node a
    key b
    val [Heap a b]
    _) = (a
    key, b
    val)

    deleteMin :: (Ord a) => Heap a b -> Heap a b
    deleteMin :: forall a b. Ord a => Heap a b -> Heap a b
    deleteMin Heap a b
    Empty             = Heap a b
    forall a b. Heap a b
    Empty
    deleteMin (Node a
    _ b
    _ [Heap a b]
    hs) = [Heap a b] -> Heap a b
    forall a b. Ord a => [Heap a b] -> Heap a b
    mergeAll [Heap a b]
    hs

    splitMin :: (Ord a) => Heap a b -> (a,b,Heap a b)
    splitMin :: forall a b. Ord a => Heap a b -> (a, b, Heap a b)
    splitMin Heap a b
    Empty             = String -> (a, b, Heap a b)
    forall a. HasCallStack => String -> a
    error String
    "Heap.splitMin: empty heap"
    splitMin (Node a
    key b
    val [Heap a b]
    hs) = (a
    key,b
    val,[Heap a b] -> Heap a b
    forall a b. Ord a => [Heap a b] -> Heap a b
    mergeAll [Heap a b]
    hs)

    ----------------------------------------------------------------------
    -- APPLICATION FUNCTIONS, EXAMPLES
    ----------------------------------------------------------------------

    build :: (Ord a) => [(a,b)] -> Heap a b
    build :: forall a b. Ord a => [(a, b)] -> Heap a b
    build = ((a, b) -> Heap a b -> Heap a b)
    -> Heap a b -> [(a, b)] -> Heap a b
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (a, b) -> Heap a b -> Heap a b
    forall a b. Ord a => (a, b) -> Heap a b -> Heap a b
    insert Heap a b
    forall a b. Heap a b
    Empty

    toList :: (Ord a) => Heap a b -> [(a,b)]
    toList :: forall a b. Ord a => Heap a b -> [(a, b)]
    toList Heap a b
    Empty = []
    toList Heap a b
    h = (a, b)
    x(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :Heap a b -> [(a, b)]
    forall a b. Ord a => Heap a b -> [(a, b)]
    toList Heap a b
    r
               where ((a, b)
    x,Heap a b
    r) = (Heap a b -> (a, b)
    forall a b. Heap a b -> (a, b)
    findMin Heap a b
    h,Heap a b -> Heap a b
    forall a b. Ord a => Heap a b -> Heap a b
    deleteMin Heap a b
    h)

    heapsort :: (Ord a) => [a] -> [a]
    heapsort :: forall a. Ord a => [a] -> [a]
    heapsort = ((a, a) -> a) -> [(a, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, a) -> a
    forall a b. (a, b) -> a
    fst ([(a, a)] -> [a]) -> ([a] -> [(a, a)]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Heap a a -> [(a, a)]
    forall a b. Ord a => Heap a b -> [(a, b)]
    toList (Heap a a -> [(a, a)]) -> ([a] -> Heap a a) -> [a] -> [(a, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, a)] -> Heap a a
    forall a b. Ord a => [(a, b)] -> Heap a b
    build ([(a, a)] -> Heap a a) -> ([a] -> [(a, a)]) -> [a] -> Heap a a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> (a, a)) -> [a] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    x->(a
    x,a
    x))
    {-
    l :: (Num a) => [a]
    l  = [6,9,2,13,6,8,14,9,10,7,5]
    l' = reverse l

    h1  = build $ map (\x->(x,x)) l
    h1' = build $ map (\x->(x,x)) l'

    s1  = heapsort l
    s1' = heapsort l'
    -}