Extend `add-between'.

New keywords: `#:first', `#:before-last', `#:last', and `#:splice?'.
This commit is contained in:
Eli Barzilay 2012-06-23 04:14:10 -04:00
parent f7185bec91
commit 728687d9dc
3 changed files with 116 additions and 31 deletions

View File

@ -175,29 +175,50 @@
[(pair? sexp) (loop (car sexp) (loop (cdr sexp) acc))]
[else (cons sexp acc)])))
;; General note: many non-tail recursive, which are just as fast in mzscheme
;; General note: many non-tail recursive, which are just as fast in racket
(define (add-between l x)
(cond [(not (list? l)) (raise-argument-error 'add-between "list?" 0 l x)]
[(null? l) null]
[(null? (cdr l)) l]
[else (cons (car l)
(let loop ([l (cdr l)])
(if (null? l)
null
(list* x (car l) (loop (cdr l))))))]))
;; This is nice for symmetry, but confusing to use, and we can get it using
;; something like (append* (add-between l ls)), or even `flatten' for an
;; arbitrary nesting.
;; (define (lists-join ls l)
;; (cond [(null? ls) ls]
;; [(null? l) ls] ; empty separator
;; [else (append (car ls)
;; (let loop ([ls (cdr ls)])
;; (if (null? ls)
;; ls
;; (append l (car ls) (loop (cdr ls))))))]))
(define none (gensym 'none))
(define (add-between l x #:splice? [splice? #f]
#:first [first none] #:last [last none]
#:before-last [before-last none])
(unless (list? l)
(raise-argument-error 'add-between "list?" 0 l x))
(when splice?
(unless (list? x)
(raise-argument-error 'add-between "list?" 1 l x)))
(if (or (null? l) (null? (cdr l)))
(let* ([r (cond [(eq? last none) '()] [splice? last] [else (list last)])]
[r (cond [(null? l) r] [(null? r) l] [(cons (car l) r)])]
[r (cond [(eq? first none) r]
[splice? (append first r)]
[else (cons first r)])])
r)
(let* ([r ; main loop (two loops for efficiency, maybe not needed)
(if splice?
(let ([x (reverse x)]
[bl (and (not (eq? before-last none))
(reverse before-last))])
(let loop ([i (cadr l)] [l (cddr l)] [r '()])
(cond [(pair? l) (loop (car l) (cdr l) (cons i (append x r)))]
[bl (cons i (append bl r))]
[else (cons i (append x r))])))
(let loop ([i (cadr l)] [l (cddr l)] [r '()])
(cond [(pair? l) (loop (car l) (cdr l) (cons i (cons x r)))]
[(eq? before-last none) (cons i (cons x r))]
[else (cons i (cons before-last r))])))]
;; add `last'
[r (cond [(eq? last none) r]
[splice? (append (reverse last) r)]
[else (cons last r)])]
;; reverse
[r (reverse r)]
;; add first item
[r (cons (car l) r)]
;; add `first'
[r (cond [(eq? first none) r]
[splice? (append first r)]
[else (cons first r)])])
r)))
(define (remove-duplicates l [=? equal?] #:key [key #f])
;; `no-key' is used to optimize the case for long lists, it could be done for

View File

@ -860,15 +860,39 @@ except that it can be faster.
(split-at-right '(1 2 3 4 5 6) 4)
]}
@defproc[(add-between [lst list?] [v any/c]) list?]{
@defproc[(add-between [lst list?] [v any/c]
[#:before-last before-last any/c v]
[#:first first any/c ....]
[#:last last any/c ....]
[#:splice? splice? any/c #f])
list?]{
Returns a list with the same elements as @racket[lst], but with
@racket[v] between each pair of items in @racket[lst].
@racket[v] between each pair of items in @racket[lst]. The last pair of
items will have @racket[before-last] between them, which defaults to
@racket[v]. Giving a value for @racket[first] (or @racket[last])
will make the result have that value added to its beginning (or end).
@mz-examples[#:eval list-eval
(add-between '(x y z) 'or)
(add-between '(x) 'or)
]}
(add-between '(x y z) 'and)
(add-between '(x) 'and)
(add-between '("a" "b" "c" "d") "," #:before-last "and")
(add-between #:first "Todo:"
'("a" "b" "c") "," #:before-last "and"
#:last ".")
]
If @racket[splice?] is true, then @racket[v], @racket[before-last],
@racket[first], and @racket[last] should be lists, and their values are
spliced into the result.
@mz-examples[#:eval list-eval
(add-between '(x y z) '(-) #:before-last '(- -)
#:first '(begin) #:last '(end LF)
#:splice? #t)
]
}
@defproc*[([(append* [lst list?] ... [lsts (listof list?)]) list?]
[(append* [lst list?] ... [lsts list?]) any/c])]{

View File

@ -238,10 +238,50 @@
;; ---------- add-between ----------
(let ()
(test '() add-between '() 1)
(test '(9) add-between '(9) 1)
(test '(9 1 8 1 7) add-between '(9 8 7) 1)
(test '(9 (1) 8) add-between '(9 8) '(1)))
;; simple cases
(for ([l (in-list '(() (x) (x y) (x y z) (x y z w)))]
[r1 (in-list '(() (x) (x 5 y) (x 5 y 5 z) (x 5 y 5 z 5 w)))]
[r2 (in-list '(() (x) (x 7 y) (x 5 y 7 z) (x 5 y 5 z 7 w)))]
[r3 (in-list '(() (x) (x (5) y) (x (5) y (5) z)
(x (5) y (5) z (5) w)))])
(test r1 add-between l 5)
(test `(0 ,@r1) add-between l 5 #:first 0)
(test `(,@r1 9) add-between l 5 #:last 9)
(test `(0 ,@r1 9) add-between l 5 #:first 0 #:last 9)
(test r2 add-between l 5 #:before-last 7)
(test `(0 ,@r2) add-between l 5 #:first 0 #:before-last 7)
(test `(,@r2 9) add-between l 5 #:last 9 #:before-last 7)
(test `(0 ,@r2 9) add-between l 5 #:first 0 #:last 9 #:before-last 7)
(test r3 add-between l '(5))
(test `(0 ,@r3) add-between l '(5) #:first 0)
(test `(,@r3 9) add-between l '(5) #:last 9)
(test `(0 ,@r3 9) add-between l '(5) #:first 0 #:last 9))
;; spliced cases
(for* ([x (in-list '(() (4) (4 5)))]
[y (in-list '(() (6) (6 7)))])
(for ([l (in-list '(() (x) (x y) (x y z) (x y z w)))]
[r1 (in-list `(() (x) (x ,@x y) (x ,@x y ,@x z)
(x ,@x y ,@x z ,@x w)))]
[r2 (in-list `(() (x) (x ,@y y) (x ,@x y ,@y z)
(x ,@x y ,@x z ,@y w)))])
(test r1 add-between l x #:splice? #t)
(test r2 add-between l x #:splice? #t #:before-last y)
(for ([fst (in-list '(() (0) (0 1)))])
(test `(,@fst ,@r1) add-between l x
#:splice? #t #:first fst)
(test `(,@fst ,@r2) add-between l x
#:splice? #t #:first fst #:before-last y))
(for ([lst (in-list '(() (9) (8 9)))])
(test `(,@r1 ,@lst) add-between l x
#:splice? #t #:last lst)
(test `(,@r2 ,@lst) add-between l x
#:splice? #t #:last lst #:before-last y))
(for* ([fst (in-list '(() (0) (0 1)))]
[lst (in-list '(() (9) (8 9)))])
(test `(,@fst ,@r1 ,@lst) add-between l x
#:splice? #t #:first fst #:last lst)
(test `(,@fst ,@r2 ,@lst) add-between l x
#:splice? #t #:first fst #:last lst #:before-last y)))))
;; ---------- remove-duplicates ----------
(let ()