File: original-message.txt

package info (click to toggle)
acl2 8.6%2Bdfsg-2
  • links: PTS
  • area: main
  • in suites: trixie
  • size: 1,111,420 kB
  • sloc: lisp: 17,818,294; java: 125,359; python: 28,122; javascript: 23,458; cpp: 18,851; ansic: 11,569; perl: 7,678; xml: 5,591; sh: 3,976; makefile: 3,833; ruby: 2,633; yacc: 1,126; ml: 763; awk: 295; csh: 233; lex: 197; php: 178; tcl: 49; asm: 23; haskell: 17
file content (150 lines) | stat: -rw-r--r-- 4,492 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
From ...
Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!news.tele.dk!193.190.198.17!newsfeeds.belnet.be!
news.belnet.be!skynet.be!newsfeed2.news.nl.uu.net!sun4nl!not-for-mail
From: Arthur Lemmens <lemmens@simplex.nl>
Newsgroups: comp.lang.lisp
Subject: Re: Q: on hashes and counting
Date: Mon, 23 Oct 2000 00:50:02 +0200
Organization: Kikashi Software
Lines: 129
Message-ID: <39F36F1A.B8F19D20@simplex.nl>
References: <8sl58e$ivq$1@nnrp1.deja.com> <878zrlp1cr.fsf@orion.bln.pmsf.de>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Trace: porthos.nl.uu.net 972255051 2606 193.78.46.221 (22 Oct 2000 22:50:51 GMT)
X-Complaints-To: abuse@nl.uu.net
NNTP-Posting-Date: 22 Oct 2000 22:50:51 GMT
X-Mailer: Mozilla 4.5 [en] (Win98; I)
X-Accept-Language: en
Xref: supernews.google.com comp.lang.lisp:2515


Pierre R. Mai wrote:

> ;;; The following functions are based on the versions by Arthur
> ;;; Lemmens of the original code by Bernard Pfahringer posted to
> ;;; comp.lang.lisp.  I only renamed and diddled them a bit.
>
> (defun partition

[snip]

>    ;; DO: Find a more efficient way to take care of :from-end T.
>     (when from-end
>       (setf seq (reverse seq))
>       (psetf start (- len end)
>              end   (- len start)))

I've written a different version now for dealing with :FROM-END T.
It doesn't call REVERSE anymore, which makes it more efficient.
Also, I prefer the new semantics. Stuff like
  (split #\space "one   two three  "  :from-end t)
now returns
  ("three" "two" "one")
which I find a lot more useful than
  ("eerht" "owt" "eno")
If you prefer the latter, it's easy enough to use
  (split #\space (reverse "one   two three  "))


Here it is (feel free to use this code any way you like):

(defun SPLIT (delimiter seq
		   &key (maximum nil)
			(keep-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 :keep-empty-subseqs is true, empty subsequences will be included
in the result; otherwise they will be discarded.
If :maximum is supplied, the result will contain no more than :maximum
(possibly empty) subsequences. The second result value contains the
unsplit rest of the sequence.
All other keywords work analogously to those for CL:POSITION."

;; DO: Make ":keep-delimiters t" include the delimiters in the result (?).

  (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) )
		      (not keep-empty-subseqs)) ; empty subseq we don't want
	  if (and maximum (>= nr-elts maximum))
	  ;; We can't take any more. Return now.
	  return (values subseqs (subseq seq start right))
	  else
	  collect (subseq seq (1+ left) right) into subseqs
	  and sum 1 into nr-elts
	  until (<= left start)
	  finally return (values subseqs (subseq seq start (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)
		    (not keep-empty-subseqs)) ; empty subseq we don't want
	if (and maximum (>= nr-elts maximum))
	;; We can't take any more. Return now.
	return (values subseqs (subseq seq left end))
	else
	collect (subseq seq left right) into subseqs
	and sum 1 into nr-elts
	until (= right end)
	finally return (values subseqs (subseq seq right end))))))



Here are some examples of how you can use this:


CL-USER 2 > (split #\space "word1   word2 word3")
("word1" "word2" "word3")
""

CL-USER 3 > (split #\space "word1   word2 word3" :from-end t)
("word3" "word2" "word1")
""

CL-USER 4 > (split nil '(a b nil c d e nil nil nil nil f) :maximum 2)
((A B) (C D E))
(F)

CL-USER 5 > (split #\space "Nospaceshere.")
("Nospaceshere.")
""

CL-USER 6 > (split #\; "12;13;;14" :keep-empty-subseqs t)

("12" "13" "" "14")
""

CL-USER 7 > (split #\; "12;13;;14" :keep-empty-subseqs t :from-end t)

("14" "" "13" "12")
""

CL-USER 8 > (split #\space "Nospaceshere.    ")
("Nospaceshere.")
""