blob: 78319e494ffb2ace0d6625fd0fa4006d60077201 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
#lang racket
(provide make-elem elem-priority elem-val empty-heap heap-insert heap-merge heap-min heap-pop heap-empty?)
(define (inc n)
(+ n 1))
;;; tagged lists
(define (tagged-list? len-xs tag xs)
(and (list? xs)
(= len-xs (length xs))
(eq? (first xs) tag)))
;;; ordered elements
(define (make-elem pri val)
(cons pri val))
(define (elem-priority x)
(car x))
(define (elem-val x)
(cdr x))
;;; leftist heaps (after Okasaki)
;; data representation
(define leaf 'leaf)
(define (leaf? h) (eq? 'leaf h))
(define (hnode? h)
(and (tagged-list? 5 'hnode h)
(natural? (caddr h))))
(define (make-hnode elem heap-a heap-b)
(if (< (rank heap-a) (rank heap-b))
(list 'hnode elem (+ (rank heap-a) 1) heap-b heap-a)
(list 'hnode elem (+ (rank heap-b) 1) heap-a heap-b)))
(define (hnode-elem h)
(second h))
(define (hnode-left h)
(fourth h))
(define (hnode-right h)
(fifth h))
(define (hnode-rank h)
(third h))
(define (hord? p h)
(or (leaf? h)
(<= p (elem-priority (hnode-elem h)))))
(define (heap? h)
(or (leaf? h)
(and (hnode? h)
(heap? (hnode-left h))
(heap? (hnode-right h))
(<= (rank (hnode-right h))
(rank (hnode-left h)))
(= (rank h) (inc (rank (hnode-right h))))
(hord? (elem-priority (hnode-elem h))
(hnode-left h))
(hord? (elem-priority (hnode-elem h))
(hnode-right h)))))
(define (rank h)
(if (leaf? h)
0
(hnode-rank h)))
;; operations
(define empty-heap leaf)
(define (heap-empty? h)
(leaf? h))
(define (heap-insert elt heap)
(heap-merge heap (make-hnode elt leaf leaf)))
(define (heap-min heap)
(hnode-elem heap))
(define (heap-pop heap)
(heap-merge (hnode-left heap) (hnode-right heap)))
(define (heap-merge h1 h2)
(cond
[(leaf? h1) h2]
[(leaf? h2) h1]
[else (let ((h1-min (heap-min h1))
(h2-min (heap-min h2)))
(if (< (elem-priority h1-min) (elem-priority h2-min))
(make-hnode h1-min (heap-merge (hnode-left h1) (hnode-right h1)) h2)
(make-hnode h2-min h1 (heap-merge (hnode-left h2) (hnode-right h2)))))]))
;;; check that a list is sorted (useful for longish lists)
(define (sorted? xs)
(cond [(null? xs) true]
[(null? (cdr xs)) true]
[(<= (car xs) (cadr xs)) (sorted? (cdr xs))]
[else false]))
|
