s c h e m a t i c s : c o o k b o o k

/ DataStructures? / Cookbook.FunctionalHeap

This Web


WebHome 
WebChanges 
TOC (with recipes)
NewRecipe 
WebTopicList 
WebStatistics 

Other Webs


Chicken
Cookbook
Erlang
Know
Main
Plugins
Sandbox
Scm
TWiki  

Schematics


Schematics Home
Sourceforge Page
SchemeWiki.org
Original Cookbook
RSS

Scheme Links


Schemers.org
Scheme FAQ
R5RS
SRFIs
Scheme Cross Reference
PLT Scheme SISC
Scheme48 SCM
MIT Scheme scsh
JScheme Kawa
Chicken Guile
Bigloo Tiny
Gambit LispMe
GaucheChez

Lambda the Ultimate
TWiki.org

Functional Heap

Problem

A heap is data structure that in its basic form supports the operations insert and delete-min. More advanced heaps also support merge.

Solution

One solution is to use pairing heaps. Pairing heaps supports make-empty, empty?, find-min, insert, merge and delete-min.

(module heap mzscheme
  (provide make-empty empty? find-min insert merge delete-min)

  ; for first, second and rest
  (require (all-except (lib "list.ss" "mzlib") empty?))
  
  ; A PAIRING HEAP is either
  ;    (make-heap <= '() )
  ; or
  ;    (make-heap <= (make-node elm heaps))
  ; where <= is an order on the elements, elm is an element,
  ; and heaps is a list of heap-ordered trees.
  
  (define-struct heap (<= node-or-empty) (make-inspector))
  (define-struct node (elm heaps) (make-inspector))
  
  ; heaps : heap -> (list heap)
  ;  given a non-empty heap H return the list of subheaps
  ;  (for internal use)
  (define (heaps H)
    (node-heaps (heap-node-or-empty H)))
  
  ; make-empty : (element element -> boolean) -> heap
  ;  return an empty heap with <= as element order
  (define (make-empty <=)
    (make-heap <= '()))
  
  ; empty? : heap -> boolean
  ;  is the heap H empty?
  (define (empty? H)
    (and (heap? H)
         (null? (heap-node-or-empty H))))
  
  ; find-min : heap -> element
  ;  return the smallest element of the heap H with relation to
  ;  the heap order <=
  (define (find-min H) 
    (when (empty? H)
      (error "find-min: An empty heap has no root; given " H))
    (node-elm (heap-node-or-empty H)))
    
  ; merge : heap heap -> heap
  (define (merge H1 H2)
    ; return a heap holding the elements of both H1 and H2
    (let ([<= (heap-<= h1)])
      (cond
        [(empty? H1)  H2]
        [(empty? H2)  H1]
        [else         (let ([x (find-min H1)]
                            [y (find-min H2)])
                        (if (<= x y) 
                            (make-heap <= (make-node x (cons H2 (heaps H1))))
                            (make-heap <= (make-node y (cons H1 (heaps H2))))))])))
  
  ; insert : element heap -> heap
  ;  return a new heap holding the elements of the heap H and the element x
  (define (insert H x)
    (merge (make-heap (heap-<= H) (make-node x '()))
           H))
  
  ; merge-heap-pairs : (list heap) -> heap
  ;  return a new heap holding all the elements of the heaps in the list
  (define (merge-heap-pairs <= hs)
    (cond
      [(null? hs)        (make-empty <=)]
      [(null? (rest hs)) (first hs)]
      [else              (merge (merge (first hs) (second hs))
                                (merge-heap-pairs <= (rest (rest hs))))]))
  
  ; delete-min : heap -> heap
  ;  return a new heap holding all the elements of H but the smallest
  (define (delete-min H)
    (make-heap (heap-<= H)
               (heap-node-or-empty (merge-heap-pairs (heap-<= H) (heaps H))))))

(require heap)

(print-struct #t)
(define H (make-empty string<=?))
(insert H "foo")
(insert (insert H "foo") "bar")
(insert (insert (insert H "foo") "bar") "baz")
(insert (insert (insert (insert H "foo") "bar") "baz") "qux")
(find-min (insert (insert (insert (insert H "foo") "bar") "baz") "qux"))
(find-min (delete-min (insert (insert (insert (insert H "foo") "bar") "baz") "qux")))
(find-min (delete-min (delete-min (insert (insert (insert (insert H "foo") "bar") "baz") "qux"))))
(find-min (delete-min (delete-min (delete-min (insert (insert (insert (insert H "foo") "bar") "baz") "qux")))))

(define (heap-sort <= xs)
  (do ([H  (make-empty <=) (insert H (car xs))]
       [xs xs              (cdr xs)])
    [(null? xs) 
     (do ([H  H   (delete-min H)]
          [xs '() (cons (find-min H) xs)])
       [(empty? H) (reverse xs)])]))

(heap-sort string<=? (list "foo" "bar" "baz" "qux"))

Discussion

For applications that do not use merge, pairing heaps are almost as fast as splay trees. For applications that use merge, pairing heaps are much faster.

The operations have the following running times:

 Time               worst case   amortized

  make-empty         O(1)         O(1)
  empty?             O(1)         O(1)
  find-min           O(1)         O(1)   
  insert             O(1)         O(log n) \ conjectured better: O(1)
  merge              O(1)         O(log n) /
  delete-min         O(n)         O(log n) 

-- JensAxelSoegaard - 17 Apr 2004

CookbookForm
TopicType: Recipe
ParentTopic: DataStructureRecipes
TopicOrder:

 
 
Copyright © 2004 by the contributing authors. All material on the Schematics Cookbook web site is the property of the contributing authors.
The copyright for certain compilations of material taken from this website is held by the SchematicsEditorsGroup - see ContributorAgreement & LGPL.
Other than such compilations, this material can be redistributed and/or modified under the terms of the GNU Lesser General Public License (LGPL), version 2.1, as published by the Free Software Foundation.
Ideas, requests, problems regarding Schematics Cookbook? Send feedback.
/ You are Main.guest