blob: 337e5a64ef96066a503e3a4d37accdd0ebcf9307 (
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
|
(define-module (pq)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 q)
#:export (make-pq
pq?
pq-push!
pq-pop!
pq-length
pq-empty?
pq-front
pq-rear
q-ref
q-insert!))
(define (make-pq)
(make-q))
(define (pq? obj)
"Return #t if OBJ is a priority-queue.
An object is a priority-queue if it is a
queue, and if all elements are ordered from
largest to smallest."
(and (q? obj)
(or (q-empty? obj)
(sorted? (car obj) descending-priority?))))
(define (pq-push! pq e p)
"Given the priority queue PQ,
element E and its priority P, inserts E
in the appropriate spot given P."
(let ((ele (cons e p)))
(if (q-empty? pq)
(q-push! pq ele)
(let loop ((i 0))
(if (or (equal? i (q-length pq))
(>= p (cdr (q-ref pq i))))
(q-insert! pq i ele)
(loop (1+ i)))))))
(define (pq-pop! pq)
(q-pop! pq))
(define (pq-length pq)
(q-length pq))
(define (pq-empty? pq)
(q-empty? pq))
(define (pq-front pq)
(q-front pq))
(define (pq-rear pq)
(q-rear pq))
(define (descending-priority? a b)
"Helper for pq? Checks that two
adjacent elements in a priority queue
contain a descending number in their cdr
slots."
(not
(and (pair? a) (pair? b)
(integer? (cdr a))
(integer? (cdr b))
(>= (cdr b) (cdr a)))))
(define (q-ref q i)
"Given queue Q and integer I,
returns the element in Q at I, or
a out of range exception."
(list-ref (car q) i))
(define (q-insert! q i ele)
"Places item ELE in position I of
Q, or returns an index-out-of-range
exception."
(let ((lst (car q))
(len (q-length q)))
(cond
((> i len) (throw 'index-out-of-range q i))
((equal? i len)
(enq! q ele))
(#t
(set-car! q (append (list-head lst i)
(cons ele (list-tail lst i)))))))
q)
|
