# HG changeset patch # User Arne Babenhauserheide # Date 1589487703 -7200 # Thu May 14 22:21:43 2020 +0200 # Node ID 4e2d4b6f7658e0bb868955a599adb4ccc882f595 # Parent 5f6cf0d8db2680d66ce0092642b6138738b8613b complete SRFI-134 diff --git a/deque.scm b/deque.scm old mode 100644 new mode 100755 --- a/deque.scm +++ b/deque.scm @@ -1,15 +1,12 @@ #!/usr/bin/env bash -(# -*- wisp -*-) -(if ! guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -c '' 2>/dev/null; then - (guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) -c '(import (language wisp) (language wisp spec))' >/dev/null 2>&1)) -(fi) -(PROG="$0") -(if [[ "$1" == "-i" ]]; then - (shift) - (exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(deque)' -- "${@}")) -(else - (exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(deque)' -c '' "${@}" 2>/dev/null || echo "${PROG} died" >2 && false)) -(fi) +# -*- wisp -*- +PROG="$0" +if [[ "$1" == "-i" ]]; then + shift + exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) -e '(deque)' -- "${@}" +else + exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) -e '(deque)' -c '' "${@}" 2>/dev/null || echo "${PROG} died" >2 && false +fi ; !# ;; deque.w --- immutable deques for Guile following srfi-134 @@ -50,9 +47,9 @@ ;; SRFI-134 operations TODO: -;; Filtering: ideque-filter, ideque-remove, ideque-partition -;; Searching: ideque-find, ideque-find-right, ideque-take-while, ideque-take-while-right, ideque-drop-while, ideque-drop-while-right, ideque-span, ideque-break -;; Conversion: generator->ideque, ideque->generator +;; Searching: + +;; Conversion: generator->ideque, ideque->generator ;; cannot implement since SRFI-121 is not in Guile (define-module (deque) #:export @@ -70,8 +67,12 @@ ideque-length ideque-append ideque-reverse ideque-count ideque-zip ;; Mapping ideque-map ideque-filter-map ideque-for-each ideque-for-each-right ideque-fold ideque-fold-right ideque-append-map + ;; Filtering + ideque-filter ideque-remove ideque-partition + ;; Searching + ideque-find ideque-find-right ;; Conversion - ideque->list list->ideque + ideque->list list->ideque ideque-take-while ideque-take-while-right ideque-drop-while ideque-drop-while-right ideque-span ideque-break ;; Extensions to SRFI-134 make-ideque ideque-add-front! ideque-add-back! ideque-pop-front ideque-pop-back ideque-pop-front! ideque-pop-back!)) @@ -79,7 +80,8 @@ (srfi srfi-1) (srfi srfi-9) (srfi srfi-11 );; let-values - (doctests)) + (doctests) + (only (rnrs io ports) eof-object eof-object?)) (define-record-type (make-ideque front back) @@ -103,7 +105,6 @@ (define (ideque-add-back ideq value) "Returns an ideque with obj pushed to the back of ideque. Takes O(1) time. " - (pretty-print (cons ideq value)) (make-ideque (ideque-front-elements ideq) (cons value (ideque-back-elements ideq)))) @@ -112,24 +113,85 @@ "get the first value from the deque, shifting back to front if necessary. Returns the values front, back, and retrieved value." - #( - (tests + #((tests (test-equal #f (ideque-remove/internal '() '())) (test-equal '((b c) () a) (let-values (((front back value) (ideque-remove/internal '(a b c) '()))) (list front back value))) - (test-equal '((b c) () a) + (test-equal '((b) (c) a) (let-values (((front back value) (ideque-remove/internal '() '(c b a)))) + (list front back value))) + (test-equal '((b c) (d) a) + (let-values (((front back value) (ideque-remove/internal '() '(d c b a)))) + (list front back value))) + (test-equal '((b c d) (f e) a) + (let-values (((front back value) (ideque-remove/internal '() '(f e d c b a)))) + (list front back value))) + (test-equal '(() () 0) + (let-values (((front back value) (ideque-remove/internal '() '(0)))) + (list front back value))) + (test-equal '((1) () 0) + (let-values (((front back value) (ideque-remove/internal '() '(1 0)))) + (list front back value))) + (test-equal '((1) (2) 0) + (let-values (((front back value) (ideque-remove/internal '() '(2 1 0)))) + (list front back value))) + (test-equal '((1 2) (3) 0) + (let-values (((front back value) (ideque-remove/internal '() '(3 2 1 0)))) + (list front back value))) + (test-equal '((1 2) (4 3) 0) + (let-values (((front back value) (ideque-remove/internal '() '(4 3 2 1 0)))) + (list front back value))) + (test-equal '((1 2 3) (5 4) 0) + (let-values (((front back value) (ideque-remove/internal '() '(5 4 3 2 1 0)))) + (list front back value))) + (test-equal '((1 2 3 4) (6 5) 0) + (let-values (((front back value) (ideque-remove/internal '() '(6 5 4 3 2 1 0)))) + (list front back value))) + (test-equal '((1 2 3 4) (7 6 5) 0) + (let-values (((front back value) (ideque-remove/internal '() '(7 6 5 4 3 2 1 0)))) + (list front back value))) + (test-equal '((1 2 3 4 5) (8 7 6) 0) + (let-values (((front back value) (ideque-remove/internal '() '(8 7 6 5 4 3 2 1 0)))) + (list front back value))) + (test-equal '((1 2 3 4 5 6) (9 8 7) 0) + (let-values (((front back value) (ideque-remove/internal '() '(9 8 7 6 5 4 3 2 1 0)))) (list front back value))))) (cond ((and (null? front) (null? back)) (values #f #f #f)) ((null? front) - (let ((reversed-back (reverse back))) - (values (cdr reversed-back) - (reverse front) - (car reversed-back)))) + (let loop ((count 0) (reversed '()) (back back)) + (if (null? (cdr back)) + (cond + ((= count 0 );; reversed is empty so the result is empty + (values '() '() (car back))) + ((= count 1 );; needs no splitting of the reversed list + (values reversed '() (car back))) + ((= count 2 );; needs no reversing of elements + (values + (list (car reversed)) + (cdr reversed );; new back, single element so needs no reversing + (car back))) + (else + ;; move only 2/3rd of the reversed list to + ;; the front to prevent worst-case O(N²) when + ;; alternating between front and back; needs + ;; a let loop to track the length while + ;; reversing. This doubles the cost of + ;; removing, but keeps the amortized cost + ;; linear for the worst case access pattern + ;; of alternating front-and-back. + (let-values (((front back-reversed) (split-at reversed (floor/ (* count 2) 3)))) + (values + front + (reverse back-reversed) + (car back))))) + (loop + (+ count 1) + (cons (car back) reversed) + (cdr back))))) (else (values (cdr front) back @@ -137,8 +199,7 @@ (define (ideque-remove-front ideq) "Returns an ideque with the front element of ideque removed. It is an error for ideque to be empty. Takes O(1) time." - #( - (tests + #((tests (test-equal (ideque '()) (ideque-remove-front (make-ideque '(1) '()))) (test-equal (ideque '()) @@ -159,8 +220,7 @@ (define (ideque-remove-back ideq) "Returns an ideque with the back element of ideque removed. It is an error for ideque to be empty. Takes O(1) time." - #( - (tests + #((tests (test-equal (ideque '()) (ideque-remove-back (make-ideque '(1) '()))) (test-equal (ideque '()) @@ -180,8 +240,7 @@ (define (ideque-front ideq) - #( - (tests + #((tests (test-error (ideque-front (make-ideque '() '()))))) (define front (ideque-front-elements ideq)) @@ -194,8 +253,7 @@ (define (ideque-back ideq) - #( - (tests + #((tests (test-error (ideque-back (make-ideque '() '()))))) (define back (ideque-back-elements ideq)) @@ -207,8 +265,7 @@ (first back))) (define (ideque->list ideq) - #( - (tests + #((tests (test-equal (list 1 2 3) (ideque->list (ideque '(1 2 3)))))) (append (ideque-front-elements ideq) @@ -219,8 +276,7 @@ (define (ideque elements) "Returns an ideque containing the elements. The first element (if any) will be at the front of the ideque and the last element (if any) will be at the back. Takes O(n) time, where n is the number of elements. " - #( - (tests + #((tests ;; the ideque is initialized with a filled back, because it is most likely used as a fifo (test-equal '(World Hello) (ideque-back-elements (ideque '(Hello World)))))) @@ -228,16 +284,14 @@ (define (ideque-tabulate n proc) " Invokes the predicate proc on every exact integer from 0 (inclusive) to n (exclusive). Returns an ideque containing the results in order of generation. Takes O(n) time. " - #( - (tests + #((tests (test-equal (ideque '(0 1 2 3)) (ideque-tabulate 4 (λ(x) x))))) (ideque (map proc (iota n)))) (define (ideque-unfold stop? mapper successor seed) "Invokes the predicate stop? on seed. If it returns false, generate the next result by applying mapper to seed, generate the next seed by applying successor to seed, and repeat this algorithm with the new seed. If stop? returns true, return an ideque containing the results in order of accumulation. Takes O(n) time. " - #( - (tests + #((tests (test-equal (list 0 1 2 3) (ideque->list (ideque-unfold @@ -253,8 +307,7 @@ (define (ideque-unfold-right stop? mapper successor seed) "Invokes the predicate stop? on seed. If it returns false, generate the next result by applying mapper to seed, generate the next seed by applying successor to seed, and repeat the algorithm with the new seed. If stop? returns true, return an ideque containing the results in reverse order of accumulation. Takes O(n) time." - #( - (tests + #((tests (test-equal (list 3 2 1 0) (ideque->list (ideque-unfold-right @@ -270,8 +323,7 @@ (define (ideque-empty? ideq) "Returns #t if ideque contains zero elements, and #f otherwise. Takes O(1) time. " - #( - (tests + #((tests (test-equal #t (ideque-empty? (ideque '()))) (test-equal #f (ideque-empty? (ideque '(1)))) (test-equal #t (ideque-empty? (make-ideque '() '()))) @@ -282,8 +334,7 @@ (null? (ideque-back-elements ideq)))) (define (ideque= elt= . ideques) - #( - (tests + #((tests (test-equal #f (ideque= = (ideque '(1 2)) (ideque '(1 3)))) (test-equal #f (ideque= = (ideque '(1 2)) (ideque '(1)))))) (if @@ -306,8 +357,7 @@ (define (ideque-any pred ideq) "Invokes pred on the elements of the ideque in order until one call returns a true value, which is then returned. If there are no elements, returns #f. Takes O(n) time." - #( - (tests + #((tests (test-equal #t (ideque-any zero? (ideque '(0 0 0)))) (test-equal #t (ideque-any zero? (ideque '(0 1 0)))) (test-equal #t (ideque-any zero? (ideque '(1 0)))) @@ -330,8 +380,7 @@ (define (ideque-every pred ideq) "Invokes pred on the elements of the ideque in order until one call returns a false value, which is then returned. If there are no elements, returns #t. Takes O(n) time." - #( - (tests + #((tests (test-equal #t (ideque-every zero? (ideque '(0 0 0)))) (test-equal #f (ideque-every zero? (ideque '(0 1 0)))) (test-equal #f (ideque-every zero? (ideque '(1 0)))) @@ -354,8 +403,7 @@ (define (ideque-ref ideq n) "Returns the nth element of ideque. It is an error unless n is less than the length of ideque. Takes O(n) time." - #( - (tests + #((tests (test-error (ideque-ref (ideque '()) 0)) (test-equal 1 (ideque-ref (ideque '(1)) 0)) (test-equal 'b (ideque-ref (ideque '(a b)) 1)) @@ -368,8 +416,7 @@ (define (ideque-take ideq n) "Returns an ideque containing the first n elements of ideque. It is an error if n is greater than the length of ideque. Takes O(n) time." - #( - (tests + #((tests (test-error (ideque-take (ideque '()) 1)) (test-equal '() (ideque-take (ideque '(1)) 0)) (test-equal '(a) (ideque-take (ideque '(a b)) 1)) @@ -385,8 +432,7 @@ (define (ideque-take-right ideq n) "Returns an ideque containing the last n elements of ideque. It is an error if n is greater than the length of ideque. Takes O(n) time." - #( - (tests + #((tests (test-error (ideque-take (ideque '()) 1)) (test-equal '() (ideque-take-right (ideque '(1)) 0)) (test-equal '(b) (ideque-take-right (ideque '(a b)) 1)) @@ -402,8 +448,7 @@ (define (ideque-drop ideq n) "Returns an ideque containing all but the first n elements of ideque. It is an error if n is greater than the length of ideque. Takes O(n) time. " - #( - (tests + #((tests (test-error (ideque-drop (ideque '()) 1)) (test-equal '(1) (ideque->list (ideque-drop (ideque '(1)) 0))) (test-equal '(b) (ideque->list (ideque-drop (ideque '(a b)) 1))) @@ -416,8 +461,7 @@ (define (ideque-drop-right ideq n) "Returns an ideque containing all but the last n elements of ideque. It is an error if n is greater than the length of ideque. Takes O(n) time. " - #( - (tests + #((tests (test-error (ideque-drop (ideque '()) 1)) (test-equal '(1) (ideque->list (ideque-drop-right (ideque '(1)) 0))) (test-equal '(a b) (ideque->list (ideque-drop-right (ideque '(a b c)) 1))) @@ -430,8 +474,7 @@ (define (ideque-split-at ideq n) "Returns an ideque containing the first n elements of ideque. It is an error if n is greater than the length of ideque. Takes O(n) time." - #( - (tests + #((tests (test-error (ideque-split-at (ideque '()) 1)) (test-equal '() (ideque-split-at (ideque '(1)) 0)) (test-equal '(a) (ideque-split-at (ideque '(a b c)) 1)) @@ -450,8 +493,7 @@ (define (ideque-length ideq) "Returns the length of ideque as an exact integer. Takes O(n) time." - #( - (tests + #((tests (test-equal 2 (ideque-length (ideque '(1 2)))) (test-equal 3 (ideque-length (make-ideque '(1 2) '(1)))) (test-equal 0 (ideque-length (ideque '()))))) @@ -460,8 +502,7 @@ (define (ideque-append . ideqs) "Returns an ideque with the contents of the ideque followed by the others, or an empty ideque if there are none. Takes O(kn) time, where k is the number of ideques and n is the number of elements involved. For ideques that have all elements in the back elements, the time can be O(n - m), with m the elements in the last ideque, as for append." - #( - (tests + #((tests (test-equal '() (ideque->list (ideque-append))) (test-equal '(1) (ideque->list (ideque-append (ideque '(1))))) (test-equal '(1 2 3) (ideque->list (ideque-append (ideque '(1 2 3))))) @@ -491,8 +532,7 @@ (define (ideque-reverse ideq) "Returns an ideque containing the elements of ideque in reverse order. Takes O(1) time. " - #( - (tests + #((tests (test-equal (ideque->list (ideque '(3 2 1))) (ideque->list (ideque-reverse (ideque '(1 2 3))))) (test-equal (ideque->list (ideque '(x a v))) @@ -501,11 +541,9 @@ (ideque-back-elements ideq) (ideque-front-elements ideq))) - (define (ideque-count pred ideq) "Pred is a procedure taking a single value and returning a single value. It is applied element-wise to the elements of ideque, and a count is tallied of the number of elements that produce a true value. This count is returned. Takes O(n) time. The dynamic order of calls to pred is unspecified." - #( - (tests + #((tests (test-equal 3 (ideque-count zero? (ideque '(1 3 5 9 0 7 4 0 3 0)))) (test-equal 2 @@ -522,8 +560,7 @@ (define (ideque-zip . ideques) "Returns an ideque of lists (not ideques) each of which contains the corresponding elements of ideques in the order specified. Terminates when all the elements of any of the ideques have been processed. Takes O(kn) time, where k is the number of ideques and n is the number of elements in the shortest ideque." - #( - (tests + #((tests (test-equal '((11 21) (12 22) (13 23)) (ideque->list (ideque-zip @@ -531,35 +568,38 @@ (ideque '(21 22 23))))))) (list->ideque (apply zip (map ideque->list ideques)))) +(define-syntax-rule (ideque-operate-on-elements/internal ideq proc args ...) + (make-ideque + (proc args ... (ideque-front-elements ideq)) + (proc args ... (ideque-back-elements ideq)))) + +(define-syntax-rule (ideque-operate-on-elements-right/internal ideq proc args ...) + (make-ideque + (proc args ... (ideque-back-elements ideq)) + (proc args ... (ideque-front-elements ideq)))) + (define (ideque-map proc ideq) "Applies proc to the elements of ideque and returns an ideque containing the results in order. The dynamic order of calls to proc is unspecified. Takes O(n) time." - #( - (tests + #((tests (test-equal '(2 3 4) (ideque->list (ideque-map 1+ (ideque '(1 2 3))))))) - (make-ideque - (map proc (ideque-front-elements ideq)) - (map proc (ideque-back-elements ideq)))) + (ideque-operate-on-elements/internal ideq map proc)) (define (ideque-filter-map proc ideq) "Applies proc to the elements of ideque and returns an ideque containing the true (i.e. non-#f) results in order. The dynamic order of calls to proc is unspecified. Takes O(n) time." - #( - (tests + #((tests (test-equal '(4 8) (ideque->list (ideque-filter-map (λ(x) (and (even? x) (* 2 x))) (ideque '(1 2 3 4))))))) - (make-ideque - (filter-map proc (ideque-front-elements ideq)) - (filter-map proc (ideque-back-elements ideq)))) + (ideque-operate-on-elements/internal ideq filter-map proc)) (define (ideque-for-each proc ideq) "Applies proc to the elements of ideque in forward order and returns an unspecified result. Takes O(n) time." - #( - (tests + #((tests (test-equal '(1 2 3) (let ((l (list))) (ideque-for-each (λ(x) (set! l (cons x l))) @@ -570,8 +610,7 @@ (define (ideque-for-each-right proc ideq) "Applies proc to the elements of ideque in reverse order and returns an unspecified result. Takes O(n) time." - #( - (tests + #((tests (test-equal '(3 2 1) (let ((l (list))) (ideque-for-each-right (λ(x) (set! l (cons x l))) @@ -582,8 +621,7 @@ (define (ideque-fold proc nil ideq) "Invokes proc on the elements of ideque in forward order, passing the result of the previous invocation as a second argument. For the first invocation, nil is used as the second argument. Returns the result of the last invocation, or nil if there was no invocation. Takes O(n) time." - #( - (tests + #((tests (test-equal (fold cons '() '(a b c)) (ideque-fold cons '() (ideque '(a b c)))) (test-equal (fold cons '() '(a b c d e f)) @@ -594,8 +632,7 @@ (define (ideque-fold-right proc nil ideq) "Invokes proc on the elements of ideque in reverse order, passing the result of the previous invocation as a second argument. For the first invocation, nil is used as the second argument. Returns the result of the last invocation, or nil if there was no invocation. Takes O(n) time." - #( - (tests + #((tests (test-equal (fold-right cons '() '(a b c)) (ideque-fold-right cons '() (ideque '(a b c)))) (test-equal (fold-right cons '() '(a b c d e f)) @@ -606,17 +643,200 @@ (define (ideque-append-map proc ideq) "Applies proc to the elements of ideque. It is an error if the result is not a list. Returns an ideque containing the elements of the lists in order. Takes O(n) time, where n is the number of elements in all the lists returned." - #( - (tests + #((tests (test-equal '(1 2 3) (ideque->list (ideque-append-map (λ(x) (list x)) (ideque '(1 2 3))))))) ;; test-error : ideque-append-map zero? : ideque '(1 2 3) - (make-ideque - (append-map proc (ideque-front-elements ideq)) - (append-map proc (ideque-back-elements ideq)))) + (ideque-operate-on-elements/internal ideq append-map proc)) + +(define (ideque-filter pred ideq) + "Returns an ideque containing the elements of ideque that do satisfy pred. Takes O(n) time." + #((tests + (test-equal '(2 4 6) + (ideque->list (ideque-filter even? (make-ideque '(1 2 3) '(7 6 5 4))))) + (test-equal '(1 3) + (ideque->list (ideque-filter odd? (ideque '(1 2 3))))))) + (ideque-operate-on-elements/internal ideq filter pred)) + + +(define (ideque-remove pred ideq) + "Returns an ideque containing the elements of ideque that do not satisfy pred. Takes O(n) time." + #((tests + (test-equal '(2 4 6) + (ideque->list (ideque-remove odd? (make-ideque '(1 2 3) '(7 6 5 4))))) + (test-equal '(1 3) + (ideque->list (ideque-remove even? (ideque '(1 2 3))))))) + (ideque-operate-on-elements/internal ideq remove pred)) + +(define (ideque-partition proc ideq) + "Returns two values, the results of (ideque-filter pred ideque) and (ideque-remove pred ideque) respectively, but may be more efficient. Takes O(n) time." + #((tests + (test-equal '((1 3) (2 4)) + (let-values (((true false) (ideque-partition odd? (ideque '(1 2 3 4))))) + (map ideque->list (list true false)))))) + (let-values + (((true-front false-front) (partition proc (ideque-front-elements ideq))) + ((true-back false-back) (partition proc (ideque-back-elements ideq)))) + (values + (make-ideque true-front true-back) + (make-ideque false-front false-back)))) + +(define (ideque-find/internal pred front-elements back-elements . failure) + (define found + (or + (find-tail pred front-elements) + (find-tail pred (reverse back-elements)))) + (cond + (found + (car found)) + ((not (null? failure)) + ((car failure))) + (else + #f))) + +(define (ideque-find pred ideq . failure) + "Returns the first element of ideque that satisfies pred. If there is no such element, returns the result of invoking the thunk failure; the default thunk is (lambda () #f). Takes O(n) time." + #((tests + (test-equal 0 + (ideque-find zero? (ideque '(1 2 0 3)))) + (test-equal 2 + (ideque-find even? (ideque '(1 2 0 3)))) + (test-equal 'failed + (ideque-find even? (ideque '(1 3)) + (λ() 'failed))) + (test-equal #f + (ideque-find even? (ideque '(1 3)))) + (test-equal #f + (ideque-find even? (ideque '()))))) + (apply ideque-find/internal pred + (ideque-front-elements ideq) + (ideque-back-elements ideq) + failure)) + +(define (ideque-find-right pred ideq . failure) + "Returns the last element of ideque that satisfies pred. If there is no such element, returns the result of invoking the thunk failure; the default thunk is (lambda () #f). Takes O(n) time." + #((tests + (test-equal 0 + (ideque-find-right zero? (ideque '(1 2 0 3)))) + (test-equal 0 + (ideque-find-right even? (ideque '(1 2 0 3)))) + (test-equal 'failed + (ideque-find-right even? (ideque '(1 3)) + (λ() 'failed))) + (test-equal #f + (ideque-find-right even? (ideque '(1 3)))) + (test-equal #f + (ideque-find-right even? (ideque '()))))) + (apply ideque-find/internal pred + (ideque-back-elements ideq) + (ideque-front-elements ideq) + failure)) +(define (ideque-take-while pred ideq) + "Returns an ideque containing the longest initial prefix of elements in ideque all of which satisfy pred. Takes O(n) time. " + #((tests + (test-equal '(2 4 6) + (ideque->list (ideque-take-while even? (ideque '(2 4 6 1 3 5 8))))))) + (let loop ((res (ideque '())) (ideq ideq)) + (if (or (ideque-empty? ideq) (not (pred (ideque-front ideq)))) + res + (loop + (ideque-add-back res (ideque-front ideq)) + (ideque-remove-front ideq))))) + + +(define (ideque-take-while-right pred ideq) + "Returns an ideque containing the longest final prefix of elements in ideque all of which satisfy pred. Takes O(n) time. " + #((tests + (test-equal '(8) + (ideque->list (ideque-take-while-right even? (ideque '(2 4 6 1 3 5 8))))))) + (let loop ((res (ideque '())) (ideq ideq)) + (if (or (ideque-empty? ideq) (not (pred (ideque-back ideq)))) + res + (loop + (ideque-add-front res (ideque-back ideq)) + (ideque-remove-back ideq))))) + +(define (ideque-drop-while pred ideq) + "Returns an ideque which omits the longest initial prefix of elements in ideque all of which satisfy pred, but includes all other elements of ideque. Takes O(n) time." + #((tests + (test-equal '(1 3 5 8) + (ideque->list (ideque-drop-while even? (ideque '(2 4 6 1 3 5 8))))))) + (let loop ((ideq ideq)) + (if (or (ideque-empty? ideq) (not (pred (ideque-front ideq)))) + ideq + (loop (ideque-remove-front ideq))))) + + +(define (ideque-drop-while-right pred ideq) + "Returns an ideque which omits the longest final prefix of elements in ideque all of which satisfy pred, but includes all other elements of ideque. Takes O(n) time." + #((tests + (test-equal '(2 4 6 1 3 5) + (ideque->list (ideque-drop-while-right even? (ideque '(2 4 6 1 3 5 8))))))) + (let loop ((ideq ideq)) + (if (or (ideque-empty? ideq) (not (pred (ideque-back ideq)))) + ideq + (loop (ideque-remove-back ideq))))) + +(define (ideque-span pred ideq) + "Returns two values, the initial prefix of the elements of ideque which do satisfy pred, and the remaining elements. Takes O(n) time." + #((tests + (test-equal '((1 3) (6 7 8)) + (map ideque->list + (let-values (((do do-not) (ideque-span odd? (ideque '(1 3 6 7 8))))) + (list do do-not)))))) + (let loop ((res (ideque '())) (ideq ideq)) + (if (or (ideque-empty? ideq) (not (pred (ideque-front ideq)))) + (values res ideq) + (loop + (ideque-add-back res (ideque-front ideq)) + (ideque-remove-front ideq))))) + + +(define (ideque-break pred ideq) + "Returns two values, the initial prefix of the elements of ideque which do not satisfy pred, and the remaining elements. Takes O(n) time." + #((tests + (test-equal '((1 3) (6 7 8)) + (map ideque->list + (let-values (((do do-not) (ideque-break even? (ideque '(1 3 6 7 8))))) + (list do do-not)))))) + (let loop ((res (ideque '())) (ideq ideq)) + (if (or (ideque-empty? ideq) (pred (ideque-front ideq))) + (values res ideq) + (loop + (ideque-add-back res (ideque-front ideq)) + (ideque-remove-front ideq))))) + +(define (ideque->generator ideq) + "Conversion from an ideque to a SRFI 121 generator. Takes O(n) time. A generator is a procedure that is called repeatedly with no arguments to generate consecutive values, and returns an end-of-file object when it has no more values to return. " + #((tests + (test-equal 1 + ((ideque->generator (ideque '(1 2 3))))))) + (define gen + (let ((ideq ideq)) + (lambda () + (if (ideque-empty? ideq) + (eof-object) + (let ((val (ideque-front ideq))) + (set! ideq (ideque-remove-front ideq)) + val))))) + gen) + +(define (generator->ideque gen) + "Conversion from a SRFI 121 generator and an ideque. Takes O(n) time. A generator is a procedure that is called repeatedly with no arguments to generate consecutive values, and returns an end-of-file object when it has no more values to return." + #((tests + (test-equal '(1 2 3) + (ideque->list + (generator->ideque + (ideque->generator + (ideque '(1 2 3)))))))) + (let loop ((ideq (ideque '()))) + (define res (gen)) + (if (eof-object? res) + ideq + (loop (ideque-add-back ideq res))))) @@ -624,8 +844,7 @@ (define (ideque-pop-front ideq) "Returns a cons of the ideque with the front element of ideque removed and the retrieved value, similar to assoc. Returns #f for an empty ideque. Takes O(1) time." - #( - (tests + #((tests (test-equal (cons (ideque '()) 1) (ideque-pop-front (make-ideque '(1) '()))) (test-equal (cons (ideque '()) 1) @@ -645,8 +864,7 @@ (define (ideque-pop-front! ideq) "Returns a cons of the ideque with the front element of ideque removed and the retrieved value, similar to assoc. Returns #f for an empty ideque. Takes O(1) time." - #( - (tests + #((tests (test-equal (cons (ideque '()) 1) (ideque-pop-front (make-ideque '(1) '()))) (test-equal (cons (ideque '()) 1) @@ -667,8 +885,7 @@ (define (ideque-pop-back ideq) "Returns a cons of the ideque with the front element of ideque removed and the retrieved value, similar to assoc. Returns #f for an empty ideque. Takes O(1) time." - #( - (tests + #((tests (test-equal (cons (ideque '()) 1) (ideque-pop-back (make-ideque '(1) '()))) (test-equal (cons (ideque '()) 1) @@ -687,8 +904,7 @@ (define (ideque-pop-back! ideq) "Returns a cons of the ideque with the front element of ideque removed and the retrieved value, similar to assoc. Returns #f for an empty ideque. Takes O(1) time." - #( - (tests + #((tests (test-equal (cons (ideque '()) 1) (ideque-pop-back (make-ideque '(1) '()))) (test-equal (cons (ideque '()) 1) diff --git a/deque.w b/deque.w --- a/deque.w +++ b/deque.w @@ -50,9 +50,9 @@ ;; SRFI-134 operations TODO: -;; Filtering: ideque-filter, ideque-remove, ideque-partition -;; Searching: ideque-find, ideque-find-right, ideque-take-while, ideque-take-while-right, ideque-drop-while, ideque-drop-while-right, ideque-span, ideque-break -;; Conversion: generator->ideque, ideque->generator +;; Searching: + +;; Conversion: generator->ideque, ideque->generator ;; cannot implement since SRFI-121 is not in Guile define-module : deque . #:export @@ -70,8 +70,12 @@ . ideque-length ideque-append ideque-reverse ideque-count ideque-zip ;; Mapping . ideque-map ideque-filter-map ideque-for-each ideque-for-each-right ideque-fold ideque-fold-right ideque-append-map + ;; Filtering + . ideque-filter ideque-remove ideque-partition + ;; Searching + . ideque-find ideque-find-right ;; Conversion - . ideque->list list->ideque + . ideque->list list->ideque ideque-take-while ideque-take-while-right ideque-drop-while ideque-drop-while-right ideque-span ideque-break ;; Extensions to SRFI-134 . make-ideque ideque-add-front! ideque-add-back! ideque-pop-front ideque-pop-back ideque-pop-front! ideque-pop-back! @@ -80,7 +84,7 @@ srfi srfi-9 srfi srfi-11 ;; let-values doctests - guarded-commands + only (rnrs io ports) eof-object eof-object? define-record-type make-ideque front back @@ -104,7 +108,6 @@ define : ideque-add-back ideq value . "Returns an ideque with obj pushed to the back of ideque. Takes O(1) time. " - pretty-print : cons ideq value make-ideque ideque-front-elements ideq cons value : ideque-back-elements ideq @@ -118,19 +121,81 @@ test-equal #f ideque-remove/internal '() '() test-equal '((b c) () a) - let-values (((front back value) (ideque-remove/internal '(a b c) '()))) + let-values : : (front back value) : ideque-remove/internal '(a b c) '() + list front back value + test-equal '((b) (c) a) + let-values : : (front back value) : ideque-remove/internal '() '(c b a) + list front back value + test-equal '((b c) (d) a) + let-values : : (front back value) : ideque-remove/internal '() '(d c b a) + list front back value + test-equal '((b c d) (f e) a) + let-values : : (front back value) : ideque-remove/internal '() '(f e d c b a) + list front back value + test-equal '(() () 0) + let-values : : (front back value) : ideque-remove/internal '() '(0) + list front back value + test-equal '((1) () 0) + let-values : : (front back value) : ideque-remove/internal '() '(1 0) + list front back value + test-equal '((1) (2) 0) + let-values : : (front back value) : ideque-remove/internal '() '(2 1 0) list front back value - test-equal '((b c) () a) - let-values (((front back value) (ideque-remove/internal '() '(c b a)))) + test-equal '((1 2) (3) 0) + let-values : : (front back value) : ideque-remove/internal '() '(3 2 1 0) + list front back value + test-equal '((1 2) (4 3) 0) + let-values : : (front back value) : ideque-remove/internal '() '(4 3 2 1 0) + list front back value + test-equal '((1 2 3) (5 4) 0) + let-values : : (front back value) : ideque-remove/internal '() '(5 4 3 2 1 0) + list front back value + test-equal '((1 2 3 4) (6 5) 0) + let-values : : (front back value) : ideque-remove/internal '() '(6 5 4 3 2 1 0) + list front back value + test-equal '((1 2 3 4) (7 6 5) 0) + let-values : : (front back value) : ideque-remove/internal '() '(7 6 5 4 3 2 1 0) + list front back value + test-equal '((1 2 3 4 5) (8 7 6) 0) + let-values : : (front back value) : ideque-remove/internal '() '(8 7 6 5 4 3 2 1 0) + list front back value + test-equal '((1 2 3 4 5 6) (9 8 7) 0) + let-values : : (front back value) : ideque-remove/internal '() '(9 8 7 6 5 4 3 2 1 0) list front back value cond : and (null? front) (null? back) values #f #f #f : null? front - let : : reversed-back : reverse back - values : cdr reversed-back - reverse front - car reversed-back + let loop : (count 0) (reversed '()) (back back) + if : null? : cdr back + cond + : = count 0 ;; reversed is empty so the result is empty + values '() '() : car back + : = count 1 ;; needs no splitting of the reversed list + values reversed '() : car back + : = count 2 ;; needs no reversing of elements + values + list : car reversed + cdr reversed ;; new back, single element so needs no reversing + car back + else + ;; move only 2/3rd of the reversed list to + ;; the front to prevent worst-case O(N²) when + ;; alternating between front and back; needs + ;; a let loop to track the length while + ;; reversing. This doubles the cost of + ;; removing, but keeps the amortized cost + ;; linear for the worst case access pattern + ;; of alternating front-and-back. + let-values : : (front back-reversed) : split-at reversed : floor/ (* count 2) 3 + values + . front + reverse back-reversed + car back + loop + + count 1 + cons (car back) reversed + cdr back else values : cdr front . back @@ -502,7 +567,6 @@ ideque-back-elements ideq ideque-front-elements ideq - define : ideque-count pred ideq . "Pred is a procedure taking a single value and returning a single value. It is applied element-wise to the elements of ideque, and a count is tallied of the number of elements that produce a true value. This count is returned. Takes O(n) time. The dynamic order of calls to pred is unspecified." ## @@ -532,6 +596,16 @@ ideque '(21 22 23) list->ideque : apply zip : map ideque->list ideques +define-syntax-rule : ideque-operate-on-elements/internal ideq proc args ... + make-ideque + proc args ... : ideque-front-elements ideq + proc args ... : ideque-back-elements ideq + +define-syntax-rule : ideque-operate-on-elements-right/internal ideq proc args ... + make-ideque + proc args ... : ideque-back-elements ideq + proc args ... : ideque-front-elements ideq + define : ideque-map proc ideq . "Applies proc to the elements of ideque and returns an ideque containing the results in order. The dynamic order of calls to proc is unspecified. Takes O(n) time." ## @@ -540,9 +614,7 @@ ideque->list ideque-map 1+ ideque '(1 2 3) - make-ideque - map proc : ideque-front-elements ideq - map proc : ideque-back-elements ideq + ideque-operate-on-elements/internal ideq map proc define : ideque-filter-map proc ideq . "Applies proc to the elements of ideque and returns an ideque containing the true (i.e. non-#f) results in order. The dynamic order of calls to proc is unspecified. Takes O(n) time." @@ -553,9 +625,7 @@ ideque-filter-map λ(x) : and (even? x) : * 2 x ideque '(1 2 3 4) - make-ideque - filter-map proc : ideque-front-elements ideq - filter-map proc : ideque-back-elements ideq + ideque-operate-on-elements/internal ideq filter-map proc define : ideque-for-each proc ideq . "Applies proc to the elements of ideque in forward order and returns an unspecified result. Takes O(n) time." @@ -614,10 +684,207 @@ ideque-append-map : λ(x) : list x ideque '(1 2 3) ;; test-error : ideque-append-map zero? : ideque '(1 2 3) - make-ideque - append-map proc : ideque-front-elements ideq - append-map proc : ideque-back-elements ideq + ideque-operate-on-elements/internal ideq append-map proc + +define : ideque-filter pred ideq + . "Returns an ideque containing the elements of ideque that do satisfy pred. Takes O(n) time." + ## + tests + test-equal '(2 4 6) + ideque->list : ideque-filter even? : make-ideque '(1 2 3) '(7 6 5 4) + test-equal '(1 3) + ideque->list : ideque-filter odd? : ideque '(1 2 3) + ideque-operate-on-elements/internal ideq filter pred + + +define : ideque-remove pred ideq + . "Returns an ideque containing the elements of ideque that do not satisfy pred. Takes O(n) time." + ## + tests + test-equal '(2 4 6) + ideque->list : ideque-remove odd? : make-ideque '(1 2 3) '(7 6 5 4) + test-equal '(1 3) + ideque->list : ideque-remove even? : ideque '(1 2 3) + ideque-operate-on-elements/internal ideq remove pred + +define : ideque-partition proc ideq + . "Returns two values, the results of (ideque-filter pred ideque) and (ideque-remove pred ideque) respectively, but may be more efficient. Takes O(n) time." + ## + tests + test-equal '((1 3) (2 4)) + let-values : : (true false) : ideque-partition odd? : ideque '(1 2 3 4) + map ideque->list : list true false + let-values + : (true-front false-front) : partition proc : ideque-front-elements ideq + (true-back false-back) : partition proc : ideque-back-elements ideq + values + make-ideque true-front true-back + make-ideque false-front false-back + +define : ideque-find/internal pred front-elements back-elements . failure + define found + or + find-tail pred front-elements + find-tail pred : reverse back-elements + cond + found + car found + : not : null? failure + : car failure + else + . #f + +define : ideque-find pred ideq . failure + . "Returns the first element of ideque that satisfies pred. If there is no such element, returns the result of invoking the thunk failure; the default thunk is (lambda () #f). Takes O(n) time." + ## + tests + test-equal 0 + ideque-find zero? : ideque '(1 2 0 3) + test-equal 2 + ideque-find even? : ideque '(1 2 0 3) + test-equal 'failed + ideque-find even? : ideque '(1 3) + λ() 'failed + test-equal #f + ideque-find even? : ideque '(1 3) + test-equal #f + ideque-find even? : ideque '() + apply ideque-find/internal pred + ideque-front-elements ideq + ideque-back-elements ideq + . failure + +define : ideque-find-right pred ideq . failure + . "Returns the last element of ideque that satisfies pred. If there is no such element, returns the result of invoking the thunk failure; the default thunk is (lambda () #f). Takes O(n) time." + ## + tests + test-equal 0 + ideque-find-right zero? : ideque '(1 2 0 3) + test-equal 0 + ideque-find-right even? : ideque '(1 2 0 3) + test-equal 'failed + ideque-find-right even? : ideque '(1 3) + λ() 'failed + test-equal #f + ideque-find-right even? : ideque '(1 3) + test-equal #f + ideque-find-right even? : ideque '() + apply ideque-find/internal pred + ideque-back-elements ideq + ideque-front-elements ideq + . failure +define : ideque-take-while pred ideq + . "Returns an ideque containing the longest initial prefix of elements in ideque all of which satisfy pred. Takes O(n) time. " + ## + tests + test-equal '(2 4 6) + ideque->list : ideque-take-while even? : ideque '(2 4 6 1 3 5 8) + let loop : (res (ideque '())) (ideq ideq) + if : or (ideque-empty? ideq) : not : pred : ideque-front ideq + . res + loop + ideque-add-back res : ideque-front ideq + ideque-remove-front ideq + + +define : ideque-take-while-right pred ideq + . "Returns an ideque containing the longest final prefix of elements in ideque all of which satisfy pred. Takes O(n) time. " + ## + tests + test-equal '(8) + ideque->list : ideque-take-while-right even? : ideque '(2 4 6 1 3 5 8) + let loop : (res (ideque '())) (ideq ideq) + if : or (ideque-empty? ideq) : not : pred : ideque-back ideq + . res + loop + ideque-add-front res : ideque-back ideq + ideque-remove-back ideq + +define : ideque-drop-while pred ideq + . "Returns an ideque which omits the longest initial prefix of elements in ideque all of which satisfy pred, but includes all other elements of ideque. Takes O(n) time." + ## + tests + test-equal '(1 3 5 8) + ideque->list : ideque-drop-while even? : ideque '(2 4 6 1 3 5 8) + let loop : : ideq ideq + if : or (ideque-empty? ideq) : not : pred : ideque-front ideq + . ideq + loop : ideque-remove-front ideq + + +define : ideque-drop-while-right pred ideq + . "Returns an ideque which omits the longest final prefix of elements in ideque all of which satisfy pred, but includes all other elements of ideque. Takes O(n) time." + ## + tests + test-equal '(2 4 6 1 3 5) + ideque->list : ideque-drop-while-right even? : ideque '(2 4 6 1 3 5 8) + let loop : : ideq ideq + if : or (ideque-empty? ideq) : not : pred : ideque-back ideq + . ideq + loop : ideque-remove-back ideq + +define : ideque-span pred ideq + . "Returns two values, the initial prefix of the elements of ideque which do satisfy pred, and the remaining elements. Takes O(n) time." + ## + tests + test-equal '((1 3) (6 7 8)) + map ideque->list + let-values : : (do do-not) : ideque-span odd? : ideque '(1 3 6 7 8) + list do do-not + let loop : (res (ideque '())) (ideq ideq) + if : or (ideque-empty? ideq) : not : pred : ideque-front ideq + values res ideq + loop + ideque-add-back res : ideque-front ideq + ideque-remove-front ideq + + +define : ideque-break pred ideq + . "Returns two values, the initial prefix of the elements of ideque which do not satisfy pred, and the remaining elements. Takes O(n) time." + ## + tests + test-equal '((1 3) (6 7 8)) + map ideque->list + let-values : : (do do-not) : ideque-break even? : ideque '(1 3 6 7 8) + list do do-not + let loop : (res (ideque '())) (ideq ideq) + if : or (ideque-empty? ideq) : pred : ideque-front ideq + values res ideq + loop + ideque-add-back res : ideque-front ideq + ideque-remove-front ideq + +define : ideque->generator ideq + . "Conversion from an ideque to a SRFI 121 generator. Takes O(n) time. A generator is a procedure that is called repeatedly with no arguments to generate consecutive values, and returns an end-of-file object when it has no more values to return. " + ## + tests + test-equal 1 + : ideque->generator : ideque '(1 2 3) + define gen + let : : ideq ideq + lambda : + if : ideque-empty? ideq + eof-object + let : : val : ideque-front ideq + set! ideq : ideque-remove-front ideq + . val + . gen + +define : generator->ideque gen + . "Conversion from a SRFI 121 generator and an ideque. Takes O(n) time. A generator is a procedure that is called repeatedly with no arguments to generate consecutive values, and returns an end-of-file object when it has no more values to return." + ## + tests + test-equal '(1 2 3) + ideque->list + generator->ideque + ideque->generator + ideque '(1 2 3) + let loop : : ideq : ideque '() + define res : gen + if : eof-object? res + . ideq + loop : ideque-add-back ideq res