diff --git a/graph/graph/queue.lp2.rkt b/graph/graph/queue.lp2.rkt new file mode 100644 index 00000000..8766c87f --- /dev/null +++ b/graph/graph/queue.lp2.rkt @@ -0,0 +1,361 @@ +#lang scribble/lp2 +@(require "../lib/doc.rkt") +@doc-lib-setup + +@title[#:style manual-doc-style]{Purely functional queue library} + +@(table-of-contents) + +@section{Introduction} + +We need a function behaving like @tc[fold], but which allows to add elements to +the list being processed. In other words, we want to apply a @tc[lambda] to all +elements inside a queue, with the possibility to return new elements that should +be added to the queue. + +We will first define a general version in section @secref{sec:general}, where +most implementation details are parametrizable. We then use this as a building +block to define more specialized version, for example the section +@secref{sec:sets-add} defines a version where the queue is a set, and elements +can only be added to the queue, not removed (therefore the @tc[lambda] is +expected to return only the elements to be added, and not the ones already +present in the queue). + +@section[#:tag "sec:general"]{General version} + +Since both lists, sets and other structures could be used to represent the +queue, we don't specify them here, and instead take the @tc[dequeue] and +@tc[empty?] functions as a parameter. + +We also will leave the choice of how the result value is constructed: the third +argument transforms the accumulator into the result value for an empty queue, +but for non-empty queues, we directly return the result of calling @tc[process] +on the first element, leaving to @tc[process] the responsibility to combine the +result for this element with the remaining ones, either by constructing the +overall result in the @tc[accumulator], or by using the value returned by +@tc[rec]. + +The former case is shown in section @secref{sec:tail-call-reverse-map}, where +each element's result is combined with the accumulator using @tc[cons], whereas +the latter case is shown in @secref{sec:map}, where the result for an element is +combined with @tc[cons] to what @tc[process-rest] will return. + +The lambda @tc[process] takes four parameters: the @tc[element] to process, the +current accumulator, current queue, and a function to call recursively with the +new accumulator and queue, and which will return the final result once recursive +calls have exhausted the queue. + +The new queue passed to the recursive function should contain both the new +pending elements to add to the queue, and the ones passed as argument (unless +some of those need to be deleted before being processed). + +@chunk[ + (: fold-queue (∀ (Queue Element Accumulator Result) + (→ Queue + Accumulator + (→ Accumulator Result) + (→ Queue (Values Element Queue)) + (→ Queue Boolean) + (→ Element + Accumulator + Queue + (→ Queue Accumulator Result) + Result) + Result)))] + +@chunk[ + (define (fold-queue initial-queue accumulator last-result dequeue empty? process) + (let process-rest ([queue initial-queue] [accumulator accumulator]) + (if (empty? queue) + (last-result accumulator) + (% element rest-queue = (dequeue queue) + (process element accumulator rest-queue process-rest)))))] + +@section[#:tag "sec:map"]{@racket[map]} + +Here is a version that behaves like @tc[map] on the queue, returning a list of +the result of @tc[process] on the queue's elements, in the order in which they +were dequeued. + +Here, @tc[process] takes an element, the current @tc[accumulator], the remaining +unprocessed elements in @tc[rest-queue], and returns three values: the +@tc[result] of processing the @tc[element], the @tc[new-accumulator] (which will +be discarded once all elements have been processed), and the @tc[new-queue]. + +@chunk[ + (: map-queue (∀ (Queue Element Result Accumulator) + (→ Queue + Accumulator + (→ Queue (Values Element Queue)) + (→ Queue Boolean) + (→ Element + Accumulator + Queue + (Values Result Queue Accumulator)) + (Listof Result))))] + +@chunk[ + (define (map-queue queue accumulator dequeue empty? process) + (fold-queue queue + accumulator + (λ (_) : (Listof Result) '()) + dequeue + empty? + ))] + +@chunk[ + (ann (λ (element accumulator rest-queue process-rest) + (% result new-queue new-accumulator + = (process element accumulator rest-queue) + (cons result (process-rest new-queue new-accumulator)))) + (→ Element Accumulator Queue (→ Queue Accumulator (Listof Result)) + (Listof Result)))] + +@section[#:tag "sec:tail-call-reverse-map"]{Tail-call @racket[map], with results + in reverse order} + +@chunk[ + (: tail-call-reverse-map-queue + (∀ (Queue Element Result Accumulator) + (→ Queue + Accumulator + (→ Queue (Values Element Queue)) + (→ Queue Boolean) + (→ Element + Accumulator + Queue + (Values Result Queue Accumulator)) + (Listof Result))))] + +@chunk[ + (define (tail-call-reverse-map-queue + queue accumulator dequeue empty? process) + (define-type RAccumulator (Pairof (Listof Result) Accumulator)) + (fold-queue queue + (cons (ann '() (Listof Result)) accumulator) + (inst car (Listof Result) Accumulator) + dequeue + empty? + ))] + +@chunk[ + (ann (λ (element accumulator rest-queue process-rest) + (% result new-queue new-accumulator + = (process element (cdr accumulator) rest-queue) + (process-rest new-queue + (cons (cons result (car accumulator)) + new-accumulator)))) + (→ Element RAccumulator Queue (→ Queue RAccumulator (Listof Result)) + (Listof Result)))] + +@section[#:tag "sec:sets-add"]{Variant using sets} + +We define in this section a fold over queues represented using sets. This +version also disallows removing elements from the queue by making the union of +the existing queue and the new one returned by the @tc[process] function, +instead of using the latter to replace the former. + +Moreover, this function does not build just a list of results, instead it builds +a dictionary with the processed elements as keys, and the corresponding results +as values. + +@chunk[ + (: fold-queue-sets + (∀ (Element Accumulator Result) + (→ (Setof Element) + Accumulator + (→ Element Accumulator + (Values Result Accumulator (Setof Element))) + (values (HashTable Element Result) Accumulator))))] + +@chunk[ + (inst fold-queue + (Setof Element) + Element + (List (Setof Element) (HashTable Element Result) Accumulator) + (List (HashTable Element Result) Accumulator))] + +@chunk[ + (define (fold-queue-sets initial-queue accumulator process) + (apply values + ( + initial-queue + (list ((inst set Element)) + ((inst hash Element Result)) + accumulator) + cdr + (λ ([s : (Setof Element)]) (values (set-first s) (set-rest s))) + set-empty? + )))] + +@chunk[ + (λ (element accumulator rest-queue process-rest) + (% (past-queue result-hash acc) = accumulator + result new-acc more-elements = (process element acc) + + (process-rest + (set-union rest-queue (set-subtract more-elements past-queue)) + (list (set-add past-queue element) + (if (hash-has-key? result-hash element) + (error (string-append + "Duplicate key in fold-queue-sets." + "Are you using mutable elements?")) + (hash-set result-hash element result)) + new-acc))))] + +@subsection{Adding tags, using a mutable dictionary} + +We build upon this version a new one which allows associating a custom tag for +each element. This tag allows symbolically to refer to an element which hasn't +been processed yet, and we return two dictionaries, one associating elements +with their tag and result, and the other associating tags with their element and +result. + +Here is a first implementation using a mutable store of tags, and also makes it +unnecessary for the @tc[process] lambda to return the set of elements to add to +the queue (since all elements for which a tag is requested are implicitly added +to the queue). + +@chunk[ + (: fold-queue-sets-tags + (∀ (Element Accumulator Tag Result) + (→ (Setof Element) + Accumulator + (→ Element Accumulator (Values Tag Accumulator)) + (→ Element + Accumulator + (→ Element Accumulator (Values Tag Accumulator)) + (values Result Accumulator)) + (Values (HashTable (Pairof Element Tag) Result) Accumulator))))] + +@chunk[ + (inst fold-queue-sets + (Pairof Element Tag) + Accumulator + Result)] + +@chunk[ + (define (fold-queue-sets-tags initial-queue accumulator make-tag process) + (% all-tags = ((inst hash Element Tag)) + initial-tagged-queue new-accumulator = + (map+fold (λ ([e : Element] [acc : Accumulator]) + (% tag new-acc = (make-tag e acc) + (values (cons e tag) new-acc))) + accumulator + (set->list initial-queue)) + + ( + (list->set initial-tagged-queue) + new-accumulator + (λ (e acc) + (let ([new-tagged ((inst set (Pairof Element Tag)))]) + + (% result new-acc = (process (car e) acc get-tag-for) + (values result new-acc new-tagged)))))))] + +@chunk[ + (define (get-tag-for [x : Element] [acc : Accumulator]) + (if (hash-has-key? all-tags x) + (values (hash-ref all-tags x) acc) + (% tag new-acc = (make-tag x acc) + (set! new-tagged (set-add new-tagged (cons x tag))) + (hash-set all-tags x tag) + (values tag new-acc))))] + +@subsection{Adding tags, using an immutable dictionary} + +An alternative approach is to provide these tags using an immutable dictionary: +the @tc[get-tag] function now returns a tag and the new dictionary. + +@chunk[ + (: fold-queue-sets-immutable-tags + (∀ (Element Accumulator Tag Result) + (→ (Setof Element) + Accumulator + (→ Element Accumulator (Values Tag Accumulator)) + + (Values (HashTable (Pairof Element Tag) Result) + (Pairof (HashTable Element Tag) + Accumulator)))))] + +The @tc[process] lambda now takes an element, as well as a purely functional tag +provider, which uses an opaque database type @tc[X] to know for which elements +was a tag requested. + +@chunk[ + (∀ (X) (→ Element Accumulator X (→ Element Accumulator X (Values Tag Accumulator X)) + (Values Result Accumulator X)))] + +@chunk[ + (inst fold-queue-sets + (Pairof Element Tag) + (Pairof (HashTable Element Tag) Accumulator) + Result)] + +@chunk[ + (define (fold-queue-sets-immutable-tags initial-queue + accumulator + make-tag + process) + + (% initial-tagged-queue new-accumulator = + (map+fold (λ ([e : Element] [acc : Accumulator]) + (% tag new-acc = (make-tag e acc) + (values (cons e tag) new-acc))) + accumulator + (set->list initial-queue)) + + ( + (list->set initial-tagged-queue) + (cons ((inst hash Element Tag)) new-accumulator) + (λ (e h+acc) + (% (h . acc) = h+acc + empty-s = ((inst set (Pairof Element Tag))) + r new-acc (_ . s) = (process (car e) + acc + (cons h empty-s) + get-tag-for) + new-h = (hash-set** h (set->list s)) + (values r (cons new-h new-acc) s))))))] + +@chunk[ + (define% (get-tag-for [x : Element] + [acc : Accumulator] + [(h . s) : (Pairof (HashTable Element Tag) + (Setof (Pairof Element Tag)))]) + (if (hash-has-key? h x) + (values (hash-ref h x) + acc + (cons h s)) + (% tag new-acc = (make-tag x acc) + (values tag + new-acc + (cons (hash-set h x tag) (set-add s `(,x . ,tag)))))))] + +@section{Conclusion} + +@chunk[<*> + (begin + (module main typed/racket + (require (for-syntax syntax/parse + racket/syntax + "../lib/low-untyped.rkt") + "../lib/low.rkt" + racket/set) + + + + + + + ) + + (require 'main) + (provide (all-from-out 'main)) + + (module* test typed/racket + (require (submod "..") + typed/rackunit) + + + (require (submod ".." doc))))] \ No newline at end of file