a11f9a96c80b — Linus Bj√∂rnstam tip 1 year, 1 month ago
found a persistent fifo.
1 files changed, 113 insertions(+), 0 deletions(-)

A => persistent-fifo.scm
A => persistent-fifo.scm +113 -0
@@ 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 <pfifo>
+  (%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))))
+