Ein Pairing Heap ist eine Datenstruktur aus verschachtelten Listen. Die auf dem Heap operierenden Funktionen erlauben die Nutzung als Prioritätswarteschlange: In diese kann man Elemente einfügen und das jeweils kleinste Element ermitteln und entnehmen.

Ein leerer Pairing Heap entspricht der leeren Liste.

(defclass pairing-heap ())

(defmethod initialize ((this pairing-heap) comparator)
  t
  (initialize this comparator nil))

(defmethod initialize ((this pairing-heap) comparator heap)
  t
  (progn
    (.= this comparator comparator)
    (.= this heap heap)
    (freeze this)))

(defmethod is-empty? ((this pairing-heap))
  t
  (null? (. this heap)))

Das kleinste Element im Heap ist das erste Element der Liste.
  
(defmethod head ((this pairing-heap))
  t
  (with-slots-read-only (heap) this
    (if
      (null? heap)
      (throw (quote error) "cannot get head of empty pairing heap")
      (first heap))))

Ein Element wird in den Heap eingefügt, indem ein einelementiger Heap (nur mit dem einzufügenden Element) mit dem ursprünglichen Heap zusammengeführt wird. Beim Zusammenführen entsteht eine Liste, deren erstes Element das Kleinste des neuen Heaps ist und deren restliche Elemente Unterheaps sind. Diese sind nicht geordnet.

(defmethod insert-into ((this pairing-heap) element)
  t
  (merge-two
    (new pairing-heap
      (. this comparator)
      (list element))
    this))

(defmethod merge-two ((this pairing-heap) (that pairing-heap))
  (= (. this comparator) (. that comparator))
  (let
    ((comparator (. this comparator))
     (this-heap (. this heap))
     (that-heap (. that heap)))
    (cond
      ((null? this-heap)
        that)
      ((null? that-heap)
        this)
      ((comparator (first that-heap) (first this-heap))
        (new pairing-heap
          comparator
          (cons (first that-heap) (cons this-heap (rest that-heap)))))
      (t
        (new pairing-heap
          comparator
          (cons (first this-heap) (cons that-heap (rest this-heap))))))))

Das kleinste Element wird aus dem Heap entfernt, indem die Unterheaps zusammengeführt werden.

(defmethod tail ((this pairing-heap)) t
  (with-slots-read-only (heap comparator) this
    (if
      (null? heap)
      (throw (quote error) "cannot get tail of empty pairing heap")
      (merge-all comparator (rest heap)))))

(defproc merge-all (comparator heaps)
  (cond
    ((null? heaps)
      (new pairing-heap comparator))
    ((single? heaps)
      (new pairing-heap comparator (first heaps)))
    (t
      (merge-two
        (merge-two
          (new pairing-heap comparator (first heaps))
          (new pairing-heap comparator (second heaps)))
        (merge-all comparator (rest (rest heaps)))))))