(module lst (lib "swindle.ss" "swindle") (provide random-choice bifilter unzip transpose enumerate nil-cdr? group window cross binary->n-ary same? split-step sum avg avglists append-unique uniq flatten shuffle! shuffle split-at times (rename concat~ concat)) ; (provide (all-defined)) "lst.ss -- list things that aren't built in to Scheme or available from SRFI-1 or MzScheme's list.ss" (require "fnc.ss") (require "macro.ss") (require (only "cl.ss" subseq take drop)) (require (only (lib "list.ss" "srfi" "1") zip iota concatenate)) (require (only (lib "13.ss" "srfi") string-concatenate string-join)) (define (random-choice l) (list-ref l (random (length l)))) (define (bifilter fn l) "fn*()->(() ())--like filter, but returns both halves of the list srfi-1 has multi-valued partition, but I don't know of a sleek way to get" (let loop ((l l) (t '()) (f '())) (cond ((null? l) (list t f)) ((fn (car l)) (loop (cdr l) (cons (car l) t) f)) (else (loop (cdr l) t (cons (car l) f)))))) (define (split-step step l) "NOTE: Call to floor is only necessary if you pass in a list where (/= (mod l step) 0). Which you shouldn't, because the last (mod l step) items are ignored" (map (lambda (i) (map (lambda (j) (ref l j)) (iota (floor (/ (length l) step)) i step))) (iota step))) (define (split-at n l) (list (subseq l 0 n) (subseq l n))) (define (sum l) ; Isn't there a more efficient definition somewhere? Oh well. (foldl + 0 l)) (define (avg l) (/ (sum l) (length l))) (define (avglists . ls) (map avg ls)) (define (shuffle! l) (for-each (lambda (i) (bind j (random (length l)) (swap! (ref l i) (ref l j)))) (iota (length l)))) (define (shuffle l) (bind copy (list-copy l) (shuffle! copy) copy)) (define (times x n) (map (lambda _ x) (iota n))) (define (append-unique l1 l2) "This definition is inefficient. It copies AND traverses l1 twice" (bind h1 (make-hash (map (lambda (x) (cons x #f)) l1)) (append l1 (filter (lambda (x) (not (has-key? h1 x))) l2)))) (define (uniq l) (bind h1 (make-hash (map (lambda (x) (cons x #f)) l)) (hash-keys h1))) (define (unzip args) "I don't know how to use multi-valued unzipN from list.ss. so here it is. Also named transpose." (apply zip args)) (define transpose unzip) (define (enumerate l) (zip l (iota (length l)))) (define nil-cdr? (add null? cdr)) ;(define (mapply fn l) ; "fn*()->()--Avoid the use of (map(star(lambda )))" ; (let map* ((l l) ; (acc ())) ; (if (null? l) ; (reverse acc) ; (map* (cdr l) (cons (apply fn (car l)) acc))))) (define (group source n) "I think this definition favours efficiency over readability" (cond ((zero? n) (error "zero length")) ((null? source) ()) (else (let rec ((source source) (acc ())) (let ((rest (drop source n))) (if (pair? rest) (rec rest (cons (take source n) acc)) (reverse! (cons source acc)))))))) (define (window l n &key [inc 1]) "Like group, except that the groups overlap, moving by inc. Probably a more efficient definition for lists exists. (window l n :inc n) = (group l n)" (list-of (subseq l i (+ i n)) (i <- 0 inc .. (- (len l) n)))) (define (cross . ls) (if (null? ls) '(()) (forn x (car ls) (for y (apply cross (cdr ls)) (cons x y))))) (define (binary->n-ary binary-test l) (every (uncurry binary-test) (window l 2))) (define same? (cur binary->n-ary equal?)) (defgeneric (concat~ ls)) ; NB: string and vector are borken because I need (defmethod (concat~ (ls )) (concatenate ls)) ; to dispatch on a (defmethod (concat~ (ss )) (string-concatenate ss)) ; complex type ; (defmethod (concat~ (vs )) (vector-concatenate vs)) ; <-- low demand (define (flatten l) "This implementation is a little stupid" (concat (map (lambda (x) (if (list? x) (flatten x) (list x))) l))) )