dane/graphgif
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use lexicographic comparisons for heap algorithms

Browse Source
This commit is contained in:
Dane Johnson 2024-11-11 15:44:18 -06:00
parent bcdb95211b
commit d0967f0580
1 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
graphgif.scm
View File

@ -179,6 +179,15 @@
;; ALGORITHMS!!! ;; ;; ALGORITHMS!!! ;;
;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;
(define (lex< a b)
(cond
[(and (number? a) (number? b)) (< a b)]
[(and (null? a) (null? b)) #f]
[(and (pair? a) (null? b)) #f]
[(and (null? a) (pair? b)) #t]
[(= (car a) (car b)) (lex< (cdr a) (cdr b))]
[else (< (car a) (car b))]))
;; Heap algorithms ;; Heap algorithms
(define-public (heap-insert priority item heap) (define-public (heap-insert priority item heap)
(define (fix-up! i heap) (define (fix-up! i heap)
@ -187,7 +196,7 @@
(let* ([parent (quotient (1- i) 2)] (let* ([parent (quotient (1- i) 2)]
[i-priority (car (vector-ref heap i))] [i-priority (car (vector-ref heap i))]
[parent-priority (car (vector-ref heap parent))]) [parent-priority (car (vector-ref heap parent))])
(when (<= i-priority parent-priority) (when (lex< i-priority parent-priority)
(vector-swap! heap i parent)) (vector-swap! heap i parent))
(fix-up! parent heap)))) (fix-up! parent heap))))
(fix-up! (vector-length heap) (vector-append heap (vector (cons priority item))))) (fix-up! (vector-length heap) (vector-append heap (vector (cons priority item)))))
@ -202,8 +211,8 @@
[right (1+ left)]) [right (1+ left)])
(if (< left len) (if (< left len)
(let ([min (if (< right len) (let ([min (if (< right len)
(argmin (compose car (partial vector-ref heap)) i left right) (argmin (compose car (partial vector-ref heap)) lex< i left right)
(argmin (compose car (partial vector-ref heap)) i left))]) (argmin (compose car (partial vector-ref heap)) lex< i left))])
(if (= min i) (if (= min i)
heap heap
(begin (begin