Fix indentation.
Add missing variable annotation. Remove unecessary annotations. Now pass. svn: r9522 original commit: 53709f1faffae5533a8a700582d13a817c829dd6
This commit is contained in:
parent
66febb5ba5
commit
16fffb8706
|
@ -77,7 +77,7 @@
|
|||
(define empty
|
||||
(case-lambda
|
||||
[() (make-heap-empty (current-compare))]
|
||||
[(cmp) (make-heap-empty cmp)]))
|
||||
[(#{cmp : comparator}) (make-heap-empty cmp)]))
|
||||
|
||||
(define: empty? : (pred heap-empty) heap-empty?)
|
||||
|
||||
|
@ -98,11 +98,8 @@
|
|||
(cond
|
||||
[(empty? h1) h2]
|
||||
[(empty? h2) h1]
|
||||
[else (let*: (;; added new bindings at simpler types
|
||||
[h1 : (heap-node a) h1]
|
||||
[h2 : (heap-node a) h2]
|
||||
[x : a (heap-node-elm h1)] ;; FIXME - FUCK FUCK FUCK - why not x?
|
||||
[y : a (heap-node-elm h2)])
|
||||
[else (let* ([x (heap-node-elm h1)]
|
||||
[y (heap-node-elm h2)])
|
||||
(if<=? ((heap-compare h1) x y)
|
||||
(make x (heap-node-left h1) (union (heap-node-right h1) h2))
|
||||
(make y (heap-node-left h2) (union h1 (heap-node-right h2)))))]))
|
||||
|
@ -197,11 +194,8 @@
|
|||
(heap-node-left h))
|
||||
(heap-node-right h))))
|
||||
|
||||
;; FIXME
|
||||
(pdefine: (a) (elements [h : (Heap a)]) : (list-of a)
|
||||
(fold (lambda: ([x : a] [l : (list-of a)]) (cons x l))
|
||||
#;#{cons : (a (list-of a) -> (list-of a))}
|
||||
#{'() :: (list-of a)} h))
|
||||
(fold (lambda: ([x : a] [l : (list-of a)]) (cons x l)) '() h))
|
||||
|
||||
(pdefine: (a) (count [x : a] [h : (Heap a)]) : number
|
||||
(let ([cmp (heap-compare h)])
|
||||
|
@ -211,16 +205,20 @@
|
|||
s))
|
||||
0 h)))
|
||||
|
||||
(pdefine: (a) (-heap . [xs : a]) : (Heap a)
|
||||
(list->heap xs))
|
||||
|
||||
|
||||
(define: list->heap : (All (a) (case-lambda (comparator (list-of a) -> (Heap a)) ((list-of a) -> (Heap a))))
|
||||
; time: O(n)
|
||||
(pcase-lambda: (a)
|
||||
[([l : (list-of a)]) (list->heap (current-compare) l)]
|
||||
[([cmp : comparator] [l : (list-of a)])
|
||||
(let* ([e (empty cmp)]
|
||||
(let* ([e (#{empty @ a} cmp)]
|
||||
[hs (map (lambda: ([x : a]) (insert x e)) l)])
|
||||
; (list heap) -> (list heap)
|
||||
; merge adjacent pairs of heaps
|
||||
(define: (merge-pairs [hs : (list-of (Heap a))]) : (list-of (Heap a))
|
||||
(define: (merge-pairs [hs : (Listof (Heap a))]) : (list-of (Heap a))
|
||||
(cond
|
||||
[(or (null? hs)
|
||||
(null? (cdr hs))) hs]
|
||||
|
@ -236,9 +234,6 @@
|
|||
[(null? (cdr hs)) (car hs)]
|
||||
[else (loop (merge-pairs hs))]))))]))
|
||||
|
||||
;; FIXME - moved to after list->heap
|
||||
(pdefine: (a) (-heap . [xs : a]) : (Heap a)
|
||||
(list->heap xs))
|
||||
|
||||
|
||||
(pdefine: (a) (insert* [xs : (list-of a)] [h : (Heap a)]) : (Heap a)
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
#lang typed-scheme
|
||||
;;; priority-queue.scm -- Jens Axel Søgaard
|
||||
;;; PURPOSE
|
||||
|
||||
; This file implements priority queues on top of
|
||||
; a heap library.
|
||||
#lang typed-scheme
|
||||
; This file implements priority queues on top of
|
||||
; a heap library.
|
||||
(define-type-alias number Number)
|
||||
(define-type-alias boolean Boolean)
|
||||
(define-type-alias symbol Symbol)
|
||||
|
@ -17,7 +17,7 @@
|
|||
(require/typed =? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
|
||||
(require/typed <? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
|
||||
|
||||
; a priority-queue is a heap of (cons <priority> <element>)
|
||||
; a priority-queue is a heap of (cons <priority> <element>)
|
||||
|
||||
(define-type-alias (elem a) (cons number a))
|
||||
|
||||
|
@ -25,18 +25,18 @@
|
|||
|
||||
(define-type-alias (pqh a) (heap:Heap (elem a)))
|
||||
|
||||
; conveniences
|
||||
; conveniences
|
||||
(pdefine: (a) (heap [pq : (priority-queue a)]) : (pqh a) (priority-queue-heap pq))
|
||||
(pdefine: (a) (pri [p : (elem a)]) : number (car p))
|
||||
(pdefine: (a) (elm [p : (elem a)]) : a (cdr p))
|
||||
(pdefine: (a) (make [h : (pqh a)]) : (priority-queue a) (make-priority-queue h))
|
||||
|
||||
; sort after priority
|
||||
; TODO: and then element?
|
||||
; sort after priority
|
||||
; TODO: and then element?
|
||||
(pdefine: (a) (compare [p1 : (elem a)] [p2 : (elem a)]) : number
|
||||
(number-compare (pri p1) (pri p2)))
|
||||
|
||||
;;; OPERATIONS
|
||||
;;; OPERATIONS
|
||||
|
||||
(define: (num-elems [h : (heap:Heap (cons number number))]) : (list-of (cons number number))
|
||||
(heap:elements h))
|
||||
|
@ -78,11 +78,9 @@
|
|||
(pdefine: (a) (insert [x : a] [p : number] [pq : (priority-queue a)]) : (priority-queue a)
|
||||
(make (heap:insert (#{cons :: (case-lambda (a (list-of a) -> (list-of a)) (number a -> (cons number a)))} p x) (heap pq))))
|
||||
|
||||
;; FIXME - had to insert extra binding to give the typechecker more help
|
||||
;; could have done this with annotation on map, probably
|
||||
;; FIXME -- too many annotations needed on cons
|
||||
(pdefine: (a) (insert* [xs : (list-of a)] [ps : (list-of number)] [pq : (priority-queue a)]) : (priority-queue a)
|
||||
(let ([cons #{cons :: (case-lambda (a (list-of a) -> (list-of a)) (number a -> (cons number a)))}])
|
||||
(make (heap:insert* (map #{cons :: (number a -> (cons number a))} ps xs) (heap pq)))))
|
||||
(make (heap:insert* (map #{#{cons @ number a} :: (number a -> (cons number a))} ps xs) (heap pq))))
|
||||
|
||||
(pdefine: (a) (delete-min [pq : (priority-queue a)]) : (priority-queue a)
|
||||
(let ([h (heap pq)])
|
||||
|
|
|
@ -19,8 +19,8 @@
|
|||
(pdefine: (b) (heap-size [h : (Heap b)]) : number
|
||||
(cond [(heap-empty? h) 0]
|
||||
[(heap-node? h)
|
||||
(+ 1 (+ (#{heap-size @ b} (heap-node-left h))
|
||||
(#{heap-size @ b} (heap-node-right h))))]
|
||||
(+ 1 (+ (heap-size (heap-node-left h))
|
||||
(heap-size (heap-node-right h))))]
|
||||
;; FIXME - shouldn't need else clause
|
||||
[else (error "Never happens!")]))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user