3rdparties/software/split-sequence-v2.0.0/original-message.txt (4492 bytes)
1 From ... 2 Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!news.tele.dk!193.190.198.17!newsfeeds.belnet.be! 3 news.belnet.be!skynet.be!newsfeed2.news.nl.uu.net!sun4nl!not-for-mail 4 From: Arthur Lemmens <lemmens@simplex.nl> 5 Newsgroups: comp.lang.lisp 6 Subject: Re: Q: on hashes and counting 7 Date: Mon, 23 Oct 2000 00:50:02 +0200 8 Organization: Kikashi Software 9 Lines: 129 10 Message-ID: <39F36F1A.B8F19D20@simplex.nl> 11 References: <8sl58e$ivq$1@nnrp1.deja.com> <878zrlp1cr.fsf@orion.bln.pmsf.de> 12 Mime-Version: 1.0 13 Content-Type: text/plain; charset=us-ascii 14 Content-Transfer-Encoding: 7bit 15 X-Trace: porthos.nl.uu.net 972255051 2606 193.78.46.221 (22 Oct 2000 22:50:51 GMT) 16 X-Complaints-To: abuse@nl.uu.net 17 NNTP-Posting-Date: 22 Oct 2000 22:50:51 GMT 18 X-Mailer: Mozilla 4.5 [en] (Win98; I) 19 X-Accept-Language: en 20 Xref: supernews.google.com comp.lang.lisp:2515 21 22 23 Pierre R. Mai wrote: 24 25 > ;;; The following functions are based on the versions by Arthur 26 > ;;; Lemmens of the original code by Bernard Pfahringer posted to 27 > ;;; comp.lang.lisp. I only renamed and diddled them a bit. 28 > 29 > (defun partition 30 31 [snip] 32 33 > ;; DO: Find a more efficient way to take care of :from-end T. 34 > (when from-end 35 > (setf seq (reverse seq)) 36 > (psetf start (- len end) 37 > end (- len start))) 38 39 I've written a different version now for dealing with :FROM-END T. 40 It doesn't call REVERSE anymore, which makes it more efficient. 41 Also, I prefer the new semantics. Stuff like 42 (split #\space "one two three " :from-end t) 43 now returns 44 ("three" "two" "one") 45 which I find a lot more useful than 46 ("eerht" "owt" "eno") 47 If you prefer the latter, it's easy enough to use 48 (split #\space (reverse "one two three ")) 49 50 51 Here it is (feel free to use this code any way you like): 52 53 (defun SPLIT (delimiter seq 54 &key (maximum nil) 55 (keep-empty-subseqs nil) 56 (from-end nil) 57 (start 0) 58 (end nil) 59 (test nil test-supplied) 60 (test-not nil test-not-supplied) 61 (key nil key-supplied)) 62 63 "Return a list of subsequences in <seq> delimited by <delimiter>. 64 If :keep-empty-subseqs is true, empty subsequences will be included 65 in the result; otherwise they will be discarded. 66 If :maximum is supplied, the result will contain no more than :maximum 67 (possibly empty) subsequences. The second result value contains the 68 unsplit rest of the sequence. 69 All other keywords work analogously to those for CL:POSITION." 70 71 ;; DO: Make ":keep-delimiters t" include the delimiters in the result (?). 72 73 (let ((len (length seq)) 74 (other-keys (nconc (when test-supplied 75 (list :test test)) 76 (when test-not-supplied 77 (list :test-not test-not)) 78 (when key-supplied 79 (list :key key))))) 80 81 (unless end (setq end len)) 82 (if from-end 83 (loop for right = end then left 84 for left = (max (or (apply #'position delimiter seq 85 :end right 86 :from-end t 87 other-keys) 88 -1) 89 (1- start)) 90 unless (and (= right (1+ left) ) 91 (not keep-empty-subseqs)) ; empty subseq we don't want 92 if (and maximum (>= nr-elts maximum)) 93 ;; We can't take any more. Return now. 94 return (values subseqs (subseq seq start right)) 95 else 96 collect (subseq seq (1+ left) right) into subseqs 97 and sum 1 into nr-elts 98 until (<= left start) 99 finally return (values subseqs (subseq seq start (1+ left)))) 100 (loop for left = start then (+ right 1) 101 for right = (min (or (apply #'position delimiter seq 102 :start left 103 other-keys) 104 len) 105 end) 106 unless (and (= right left) 107 (not keep-empty-subseqs)) ; empty subseq we don't want 108 if (and maximum (>= nr-elts maximum)) 109 ;; We can't take any more. Return now. 110 return (values subseqs (subseq seq left end)) 111 else 112 collect (subseq seq left right) into subseqs 113 and sum 1 into nr-elts 114 until (= right end) 115 finally return (values subseqs (subseq seq right end)))))) 116 117 118 119 Here are some examples of how you can use this: 120 121 122 CL-USER 2 > (split #\space "word1 word2 word3") 123 ("word1" "word2" "word3") 124 "" 125 126 CL-USER 3 > (split #\space "word1 word2 word3" :from-end t) 127 ("word3" "word2" "word1") 128 "" 129 130 CL-USER 4 > (split nil '(a b nil c d e nil nil nil nil f) :maximum 2) 131 ((A B) (C D E)) 132 (F) 133 134 CL-USER 5 > (split #\space "Nospaceshere.") 135 ("Nospaceshere.") 136 "" 137 138 CL-USER 6 > (split #\; "12;13;;14" :keep-empty-subseqs t) 139 140 ("12" "13" "" "14") 141 "" 142 143 CL-USER 7 > (split #\; "12;13;;14" :keep-empty-subseqs t :from-end t) 144 145 ("14" "" "13" "12") 146 "" 147 148 CL-USER 8 > (split #\space "Nospaceshere. ") 149 ("Nospaceshere.") 150 ""