diff options
| -rw-r--r-- | reading-heap/heap.scm | 153 | ||||
| -rw-r--r-- | reading-heap/media.scm | 5 |
2 files changed, 74 insertions, 84 deletions
diff --git a/reading-heap/heap.scm b/reading-heap/heap.scm index a4d040c..770b055 100644 --- a/reading-heap/heap.scm +++ b/reading-heap/heap.scm @@ -18,92 +18,83 @@ (define empty-heap 'E) -(define heap-empty? - (lambda (heap) - (if (eq? empty-heap heap) #t - #f))) +(define (heap-empty? heap) + (if (eq? empty-heap heap) #t + #f)) -(define heap-node-rank - (lambda (heap) - (if (heap-empty? heap) - 0 - (node-rank heap)))) +(define (heap-node-rank heap) + (if (heap-empty? heap) + 0 + (node-rank heap))) -(define heap-make-node - (lambda (node heap-1 heap-2) - (let ((rank-1 (heap-node-rank heap-1)) - (rank-2 (heap-node-rank heap-2))) - (if (>= rank-1 rank-2) - (make-node (+ 1 rank-2) - (node-priority node) - (node-media node) - heap-1 - heap-2) - (make-node (+ 1 rank-1) - (node-priority node) - (node-media node) - heap-2 - heap-1))))) +(define (heap-make-node node heap-1 heap-2) + (let ((rank-1 (heap-node-rank heap-1)) + (rank-2 (heap-node-rank heap-2))) + (if (>= rank-1 rank-2) + (make-node (+ 1 rank-2) + (node-priority node) + (node-media node) + heap-1 + heap-2) + (make-node (+ 1 rank-1) + (node-priority node) + (node-media node) + heap-2 + heap-1)))) -(define heap-merge - (lambda (heap-1 heap-2) - (cond ((heap-empty? heap-1) heap-2) - ((heap-empty? heap-2) heap-1) - (#t - (let ((priority-1 (node-priority heap-1)) - (priority-2 (node-priority heap-2))) - (if (<= priority-1 priority-2) - (heap-make-node heap-1 - (node-left heap-1) - (heap-merge (node-right heap-1) heap-2)) - (heap-make-node heap-2 - (node-left heap-2) - (heap-merge heap-1 (node-right heap-2))))))))) +(define (heap-merge heap-1 heap-2) + (cond ((heap-empty? heap-1) heap-2) + ((heap-empty? heap-2) heap-1) + (#t + (let ((priority-1 (node-priority heap-1)) + (priority-2 (node-priority heap-2))) + (if (<= priority-1 priority-2) + (heap-make-node heap-1 + (node-left heap-1) + (heap-merge (node-right heap-1) heap-2)) + (heap-make-node heap-2 + (node-left heap-2) + (heap-merge heap-1 (node-right heap-2)))))))) -(define heap-insert - (lambda (priority media heap) - (heap-merge (make-node 1 priority media 'E 'E) heap))) +(define (heap-insert priority media heap) + (heap-merge (make-node 1 priority media 'E 'E) heap)) -(define heap-get-min - (lambda (heap) - (unless (heap-empty? heap) (node-media heap)))) +(define (heap-get-min heap) + (unless (heap-empty? heap) (node-media heap))) -(define heap-delete-min - (lambda (heap) - (if (heap-empty? heap) heap - (heap-merge (node-left heap) - (node-right heap))))) +(define (heap-delete-min heap) + (if (heap-empty? heap) heap + (heap-merge (node-left heap) + (node-right heap)))) -(define heap-traverse - (lambda (visit heap) - (visit heap (node-left heap) (node-right heap)) - (unless (heap-empty? (node-left heap)) (heap-traverse visit (node-left heap))) - (unless (heap-empty? (node-right heap)) (heap-traverse visit (node-right heap))))) +(define (heap-traverse visit heap) + (visit heap (node-left heap) (node-right heap)) + (unless (heap-empty? (node-left heap)) (heap-traverse visit (node-left heap))) + (unless (heap-empty? (node-right heap)) (heap-traverse visit (node-right heap)))) -(define heap-graphviz-traverse - (lambda (filename heap) - (let ((port (open-output-file filename))) - (display "digraph { rankdir=TB; splines=true; node [shape=box];\n" port) - (heap-traverse (lambda (heap heap-left heap-right) - (let ((head-data (node-media heap)) - (head-priority (node-priority heap))) - (display "\"" port) - (display head-data port) - (display "\" [shape=Mrecord,label=\"" port) - (display head-data port) - (display "\"]\n" port) - (unless (heap-empty? heap-left) - (display "\"" port) - (display head-data port) - (display "\"->\"" port) - (display (node-media heap-left) port) - (display "\"\n" port)) - (unless (heap-empty? heap-right) - (display "\"" port) - (display head-data port) - (display "\"->\"" port) - (display (node-media heap-left) port) - (display "\"\n" port)))) - heap) - (display "}" port) - (close-port port)))) +(define (heap-graphviz-traverse filename heap) + (let ((port (open-output-file filename))) + (display "digraph { rankdir=TB; splines=true; node [shape=box];\n" port) + (heap-traverse (lambda (heap heap-left heap-right) + (let ((head-data (node-media heap)) + (head-priority (node-priority heap))) + (display "\"" port) + (display head-data port) + (display "\" [shape=Mrecord,label=\"" port) + (display head-data port) + (display "\"]\n" port) + (unless (heap-empty? heap-left) + (display "\"" port) + (display head-data port) + (display "\"->\"" port) + (display (node-media heap-left) port) + (display "\"\n" port)) + (unless (heap-empty? heap-right) + (display "\"" port) + (display head-data port) + (display "\"->\"" port) + (display (node-media heap-left) port) + (display "\"\n" port)))) + heap) + (display "}" port) + (close-port port))) diff --git a/reading-heap/media.scm b/reading-heap/media.scm index 12b6b0e..ec5ee92 100644 --- a/reading-heap/media.scm +++ b/reading-heap/media.scm @@ -23,9 +23,8 @@ (display "\nauthor:" port) (display (media-author record) port))) -(define file->media - (lambda (filename) - (json->media (call-with-input-file filename get-string-all)))) +(define (file->media filename) + (json->media (call-with-input-file filename get-string-all))) (define (filetree->media-list dirname) (define (enter? name stat result) |