# HG changeset patch # User Linus Björnstam # Date 1575444130 -3600 # Wed Dec 04 08:22:10 2019 +0100 # Node ID a11f9a96c80b16ee5e018977b51b3d5062f1fbc8 # Parent 668e8eba03afe810255c80cbbbfbc145a7b535e1 found a persistent fifo. diff --git a/persistent-fifo.scm b/persistent-fifo.scm new file mode 100644 --- /dev/null +++ b/persistent-fifo.scm @@ -0,0 +1,113 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Copyright 2019 Linus Björnstam +;; +;; Permission to use, copy, modify, and/or distribute this software for any +;; purpose with or without fee is hereby granted, provided that the above +;; copyright notice and this permission notice appear in all source copies. +;; The software is provided "as is", without any express or implied warranties. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Yall should check out the following srfis before deciding to use this: +;; srfi-134 (ideques): a generalisation of fifo/lifo that is persistent. +;; as described by Chris Okasaki. If you only want a +;; fifo, this library should be slightly faster, since it does +;; not do any "balancing". +;; srfi-117 (list-queues): a mutable general queue. Could be both fifo and lifo. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; A persistent fifo. Enqueue operations are O(1), while dequeue is amortized O(1). +;; It is a simple system of 2 lists, one of items available for dequeue with the next +;; element to dequeue in it's car. The second list contains enqueued items where the +;; car being the most recently enqueued. The worst case for a dequeue is then O(n) +;; which entails a reverse of the enqueued items. +;; +;; pfifo-length, pfifo-merge, pfifo-fold, pfifo-map and pfifo-filter are all O(n)-ish +;; as they just transverse the deq and (reverse enq). +;; +;; Now, as they say: "Take my clothes off, dip me in chocolate and throw me to the +;; homophobes". + +(define-module (persistent-fifo) + #:use-module ((srfi srfi-1) + #:select (fold)) + #:use-module (srfi srfi-8) + #:use-module (srfi srfi-9) + #:export (pfifo + pfifo-empty? + pfifo-length + pfifo-enqueue + pfifo-dequeue + pfifo-dequeue/pair + pfifo->list + pfifo-merge + pfifo-fold + pfifo-map + pfifo-filter)) + +(define-record-type + (%make-pfifo enq deq) + pfifo? + (enq pfifo-get-enq) + (deq pfifo-get-deq)) + + +(define (pfifo . items) + (pfifo-enqueue (%make-pfifo '() items))) + +(define (pfifo-empty? pfifo) + (and (null? (pfifo-get-deq pfifo)) (null? (pfifo-get-enq pfifo)))) + +;; Helper function so that I don't have to do (when (pfifo-empty? pf) ...) +(define (check-pfifo pf) + (when (pfifo-empty? pf) + (error "Pfifo is empty" pf))) + +(define (pfifo-length pfifo) + (+ (length (pfifo-get-enq pfifo)) (length (pfifo-get-enq pfifo)))) + +;; enqueues items in pfifo. items are enqueued front to back. +;; It is faster to enqueue many items at once than to enqueue +;; several items in separate pfifo-enqueue calls. +(define (pfifo-enqueue pfifo . items) + (define enq (pfifo-get-enq pfifo)) + (define new-enq (fold cons enq items)) + (%make-pfifo new-enq (pfifo-get-deq pfifo))) + +;; Dequeues an element from the pfifo. +;; returns 2 values: a new pfifo, the dequeued element. +(define (pfifo-dequeue pfifo) + (check-pfifo pfifo) + (receive (enq deq) + (if (null? (pfifo-get-deq pfifo)) + (values '() (reverse (pfifo-get-enq pfifo))) + (values (pfifo-get-enq pfifo) (pfifo-get-deq pfifo))) + (values (%make-pfifo enq (cdr deq)) (car deq)))) + +(define (pfifo-dequeue/pair pfifo) + (call-with-values (lambda () (pfifo-dequeue pfifo)) cons)) + + +(define (pfifo->list pf) + (append (pfifo-get-deq pf) (reverse (pfifo-get-enq pf)))) + +;; Merges the content of p2 into p1, by putting all of the elements in both p1 and p2 +;; in a new pfifo's deq. o(n)-ish. +(define (pfifo-merge p1 p2) + (%make-pfifo '() (append (pfifo-get-deq p1) (reverse (pfifo-get-enq p1)) + (pfifo-get-deq p2) (reverse (pfifo-get-deq p2))))) + + +(define (pfifo-fold proc identity pf) + (define first-round (fold proc identity (pfifo-get-deq pf))) + (fold proc first-round (reverse (pfifo-get-enq pf)))) + + +(define (pfifo-map proc pf) + (check-pfifo pf) + (%make-pfifo '() (reverse (pfifo-fold (lambda (x acc) (cons (proc x) acc)) '() pf)))) + + +(define (pfifo-filter pred pf) + (check-pfifo pf) + (%make-pfifo '() (reverse (pfifo-fold (lambda (x acc) (if (pred x) (cons x acc) acc)) '() pf)))) +