Update of /project/cells/cvsroot/cells/utils-kt In directory clnet:/tmp/cvs-serv21379/utils-kt

Added Files: split-sequence.lisp Log Message:

--- /project/cells/cvsroot/cells/utils-kt/split-sequence.lisp 2007/11/30 21:58:40 NONE +++ /project/cells/cvsroot/cells/utils-kt/split-sequence.lisp 2007/11/30 21:58:40 1.1 ;;;; SPLIT-SEQUENCE ;;; ;;; This code was based on Arthur Lemmens' in ;;; URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl; ;;; ;;; changes include: ;;; ;;; * altering the behaviour of the :from-end keyword argument to ;;; return the subsequences in original order, for consistency with ;;; CL:REMOVE, CL:SUBSTITUTE et al. (:from-end being non-NIL only ;;; affects the answer if :count is less than the number of ;;; subsequences, by analogy with the above-referenced functions). ;;; ;;; * changing the :maximum keyword argument to :count, by analogy ;;; with CL:REMOVE, CL:SUBSTITUTE, and so on. ;;; ;;; * naming the function SPLIT-SEQUENCE rather than PARTITION rather ;;; than SPLIT. ;;; ;;; * adding SPLIT-SEQUENCE-IF and SPLIT-SEQUENCE-IF-NOT. ;;; ;;; * The second return value is now an index rather than a copy of a ;;; portion of the sequence; this index is the `right' one to feed to ;;; CL:SUBSEQ for continued processing.

;;; There's a certain amount of code duplication here, which is kept ;;; to illustrate the relationship between the SPLIT-SEQUENCE ;;; functions and the CL:POSITION functions.

;;; Examples: ;;; ;;; * (split-sequence #; "a;;b;c") ;;; -> ("a" "" "b" "c"), 6 ;;; ;;; * (split-sequence #; "a;;b;c" :from-end t) ;;; -> ("a" "" "b" "c"), 0 ;;; ;;; * (split-sequence #; "a;;b;c" :from-end t :count 1) ;;; -> ("c"), 4 ;;; ;;; * (split-sequence #; "a;;b;c" :remove-empty-subseqs t) ;;; -> ("a" "b" "c"), 6 ;;; ;;; * (split-sequence-if (lambda (x) (member x '(#\a #\b))) "abracadabra") ;;; -> ("" "" "r" "c" "d" "" "r" ""), 11 ;;; ;;; * (split-sequence-if-not (lambda (x) (member x '(#\a #\b))) "abracadabra") ;;; -> ("ab" "a" "a" "ab" "a"), 11 ;;; ;;; * (split-sequence #; ";oo;bar;ba;" :start 1 :end 9) ;;; -> ("oo" "bar" "b"), 9

;; cl-utilities note: the license of this file is unclear, and I don't ;; even know whom to contact to clarify it. If anybody objects to my ;; assumption that it is public domain, please contact me so I can do ;; something about it. Previously I required the split-sequence ; package as a dependency, but that was so unwieldy that it was *the* ;; sore spot sticking out in the design of cl-utilities. -Peter Scott

(in-package :utils-kt)

(export! split-sequence)

(defun split-sequence (delimiter seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (test nil test-supplied) (test-not nil test-not-supplied) (key nil key-supplied)) "Return a list of subsequences in seq delimited by delimiter.

If :remove-empty-subseqs is NIL, empty subsequences will be included in the result; otherwise they will be discarded. All other keywords work analogously to those for CL:SUBSTITUTE. In particular, the behaviour of :from-end is possibly different from other versions of this function; :from-end values of NIL and T are equivalent unless :count is supplied. The second return value is an index suitable as an argument to CL:SUBSEQ into the sequence indicating where processing stopped." (let ((len (length seq)) (other-keys (nconc (when test-supplied (list :test test)) (when test-not-supplied (list :test-not test-not)) (when key-supplied (list :key key))))) (unless end (setq end len)) (if from-end (loop for right = end then left for left = (max (or (apply #'position delimiter seq :end right :from-end t other-keys) -1) (1- start)) unless (and (= right (1+ left)) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values (nreverse subseqs) right) else collect (subseq seq (1+ left) right) into subseqs and sum 1 into nr-elts until (< left start) finally (return (values (nreverse subseqs) (1+ left)))) (loop for left = start then (+ right 1) for right = (min (or (apply #'position delimiter seq :start left other-keys) len) end) unless (and (= right left) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values subseqs left) else collect (subseq seq left right) into subseqs and sum 1 into nr-elts until (>= right end) finally (return (values subseqs right))))))

(defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) "Return a list of subsequences in seq delimited by items satisfying predicate.

If :remove-empty-subseqs is NIL, empty subsequences will be included in the result; otherwise they will be discarded. All other keywords work analogously to those for CL:SUBSTITUTE-IF. In particular, the behaviour of :from-end is possibly different from other versions of this function; :from-end values of NIL and T are equivalent unless :count is supplied. The second return value is an index suitable as an argument to CL:SUBSEQ into the sequence indicating where processing stopped." (let ((len (length seq)) (other-keys (when key-supplied (list :key key)))) (unless end (setq end len)) (if from-end (loop for right = end then left for left = (max (or (apply #'position-if predicate seq :end right :from-end t other-keys) -1) (1- start)) unless (and (= right (1+ left)) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values (nreverse subseqs) right) else collect (subseq seq (1+ left) right) into subseqs and sum 1 into nr-elts until (< left start) finally (return (values (nreverse subseqs) (1+ left)))) (loop for left = start then (+ right 1) for right = (min (or (apply #'position-if predicate seq :start left other-keys) len) end) unless (and (= right left) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values subseqs left) else collect (subseq seq left right) into subseqs and sum 1 into nr-elts until (>= right end) finally (return (values subseqs right))))))

(defun split-sequence-if-not (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) "Return a list of subsequences in seq delimited by items satisfying (CL:COMPLEMENT predicate).

If :remove-empty-subseqs is NIL, empty subsequences will be included in the result; otherwise they will be discarded. All other keywords work analogously to those for CL:SUBSTITUTE-IF-NOT. In particular, the behaviour of :from-end is possibly different from other versions of this function; :from-end values of NIL and T are equivalent unless :count is supplied. The second return value is an index suitable as an argument to CL:SUBSEQ into the sequence indicating where processing stopped." ; Emacs syntax highlighting is broken, and this helps: " (let ((len (length seq)) (other-keys (when key-supplied (list :key key)))) (unless end (setq end len)) (if from-end (loop for right = end then left for left = (max (or (apply #'position-if-not predicate seq :end right :from-end t other-keys) -1) (1- start)) unless (and (= right (1+ left)) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values (nreverse subseqs) right) else collect (subseq seq (1+ left) right) into subseqs and sum 1 into nr-elts until (< left start) finally (return (values (nreverse subseqs) (1+ left)))) (loop for left = start then (+ right 1) for right = (min (or (apply #'position-if-not predicate seq :start left other-keys) len) end) unless (and (= right left) remove-empty-subseqs) ; empty subseq we don't want if (and count (>= nr-elts count)) ;; We can't take any more. Return now. return (values subseqs left) else collect (subseq seq left right) into subseqs and sum 1 into nr-elts until (>= right end) finally (return (values subseqs right))))))

(pushnew :split-sequence *features*)