2 ;;; Copyright (c) 2005--2007, by A.J. Rossini <blindglobe@gmail.com>
3 ;;; See COPYRIGHT file for any additional restrictions (BSD license).
4 ;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp.
6 ;;;; Copyright (c) 1991, by Luke Tierney. Permission is granted for
7 ;;;; unrestricted use. (though Luke never had this file).
13 (defpackage :lisp-stat-sequence
15 :lisp-stat-compound-data
)
16 (:export check-sequence compound-data-seq get-next-element
17 make-next-element sequencep iseq
))
19 (in-package #:lisp-stat-sequence
)
21 ;;; Sequences are part of ANSI CL, being a supertype of vector and
22 ;;; list (ordered set of things).
24 ;;; Type Checking Functions
26 (defun check-sequence (a)
27 (if (not (or (vectorp a
) (consp a
))) (error "not a sequence - ~s" a
)))
32 ;;; Sequence Element Access
34 (defun get-next-element (x i
)
35 "Get element i from seq x. FIXME: not really??"
36 (let ((myseq (first x
)))
38 (let ((elem (first myseq
)))
39 (setf (first x
) (rest myseq
))
43 (defun set-next-element (x i v
)
44 (let ((seq (first x
)))
47 (setf (first x
) (rest seq
)))
48 (t (setf (aref seq i
) v
)))))
50 (defun make-next-element (x) (list x
))
53 ;;; Sequence Functions
58 Returns NIL unless X is a list or vector."
59 (or (listp x
) (vectorp x
)))
62 (defun iseq (a &optional b
)
63 "Args: (n &optional m)
64 Generate a sequence of consecutive integers from a to b.
65 With one argumant returns a list of consecutive integers from 0 to N - 1.
66 With two returns a list of consecutive integers from N to M.
67 Examples: (iseq 4) returns (0 1 2 3)
68 (iseq 3 7) returns (3 4 5 6 7)
69 (iseq 3 -3) returns (3 2 1 0 -1 -2 -3)"
71 (let ((n (+ 1 (abs (- b a
))))
74 (setq x
(cons (if (< a b
) (- b i
) (+ b i
)) x
))))
77 ((< a
0) (iseq (+ a
1) 0))
78 ((< 0 a
) (iseq 0 (- a
1))))))
80 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82 ;;;; Subset Selection and Mutation Functions
84 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
86 ;;;; is x an ordered sequence of nonnegative positive integers?
87 (defun ordered-nneg-seq(x)
90 (cx (make-next-element x
))
93 (let ((elem (check-nonneg-fixnum (get-next-element cx i
))))
94 (if (> m elem
) (return nil
) (setf m elem
)))))))
96 ;;;; select or set the subsequence corresponding to the specified indices
97 (defun sequence-select(x indices
&optional
(values nil set-values
))
103 (declare (fixnum rlen dlen vlen
))
105 ;; Check the input data
107 (check-sequence indices
)
108 (if set-values
(check-sequence values
))
110 ;; Find the data sizes
111 (setf data
(if (ordered-nneg-seq indices
) x
(coerce x
'vector
)))
112 (setf dlen
(length data
))
113 (setf rlen
(length indices
))
115 (setf vlen
(length values
))
116 (if (/= vlen rlen
) (error "value and index sequences do not match")))
118 ;; set up the result/value sequence
122 (make-sequence (if (listp x
) 'list
'vector
) rlen
)))
124 ;; get or set the sequence elements
127 (cr (make-next-element result
))
128 (ci (make-next-element indices
))
133 (declare (fixnum i j index
))
134 (setf index
(get-next-element ci i
))
135 (if (<= dlen index
) (error "index out of range - ~a" index
))
136 (let ((elem (get-next-element cr i
)))
143 ((not (and (< j index
) (consp nextx
))))
145 (setf nextx
(rest nextx
)))
146 (setf (first nextx
) elem
))
147 (t (setf (aref x index
) elem
)))))
149 (cr (make-next-element result
))
150 (ci (make-next-element indices
))
156 (declare (fixnum i j index
))
157 (setf index
(get-next-element ci i
))
158 (if (<= dlen index
) (error "index out of range - ~a" index
))
160 ((listp data
) ;; indices must be ordered
162 ((not (and (< j index
) (consp nextx
))))
164 (setf nextx
(rest nextx
)))
165 (setf elem
(first nextx
)))
166 (t (setf elem
(aref data index
))))
167 (set-next-element cr i elem
)))
175 (defun select (x &rest args
)
176 "Args: (a &rest indices)
177 A can be a list or an array. If A is a list and INDICES is a single number
178 then the appropriate element of A is returned. If is a list and INDICES is
179 a list of numbers then the sublist of the corresponding elements is returned.
180 If A in an array then the number of INDICES must match the ARRAY-RANK of A.
181 If each index is a number then the appropriate array element is returned.
182 Otherwise the INDICES must all be lists of numbers and the corresponding
183 submatrix of A is returned. SELECT can be used in setf."
185 ((every #'fixnump args
)
186 (if (listp x
) (nth (first args
) x
) (apply #'aref x args
)))
187 ((sequencep x
) (sequence-select x
(first args
)))
188 (t (subarray-select x args
))))
191 ;; Built in SET-SELECT (SETF method for SELECT)
192 (defun set-select (x &rest args
)
193 (let ((indices (butlast args
))
194 (values (first (last args
))))
197 (if (not (consp indices
)) (error "bad indices - ~a" indices
))
198 (let* ((indices (first indices
))
199 (i-list (if (fixnump indices
) (list indices
) indices
))
200 (v-list (if (fixnump indices
) (list values
) values
)))
201 (sequence-select x i-list v-list
)))
203 (subarray-select x indices values
))
204 (t (error "bad argument type - ~a" x
)))
207 (defsetf select set-select
)
211 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
213 ;;;; Sorting Functions
215 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
219 Returns a sequence with the numbers or strings in the sequence X in order."
220 (flet ((less (x y
) (if (numberp x
) (< x y
) (string-lessp x y
))))
221 (stable-sort (copy-seq (compound-data-seq x
)) #'less
)))
225 Returns a sequence of the indices of elements in the sequence of numbers
226 or strings X in order."
227 (let* ((seq (compound-data-seq x
))
228 (type (if (consp seq
) 'list
'vector
))
230 (flet ((entry (x) (setf i
(+ i
1)) (list x i
))
234 (if (numberp x
) (< x y
) (string-lessp x y
)))))
235 (let ((sorted-seq (stable-sort (map type
#'entry seq
) #'less
)))
236 (map type
#'second sorted-seq
)))))
238 ;; this isn't destructive -- do we document destructive only, or any
242 Returns a sequence with the elements of the list or array of numbers or
243 strings X replaced by their ranks."
244 (let ((ranked-seq (order (order x
))))
245 (make-compound-data (compound-data-shape x
) ranked-seq
)))