3 ;;;; A quick and dirty way of loading numerical data from an ASCII
4 ;;;; (text) file into a CL-ARRAY.
6 ;;;; (C) 2012, Sumant S.R. Oemrawsingh
8 (in-package #:ascii-data
)
11 (declaim (optimize (speed 3) (safety 1))))
13 (defvar *comment-characters
* '(#\
# #\' #\
;)
14 "LIST of characters that sigal a comment in the data.")
16 ;;;; Utility functions and macros
20 #'(lambda (string start
)
21 (parse-integer string
:start start
:junk-allowed t
))
22 #'(lambda (value &optional formatspec
)
23 (format nil
(or formatspec
"~D") value
)))
25 #'(lambda (string start
)
26 (parse-float:parse-float string
:start start
:type
'double-float
:junk-allowed t
))
27 #'(lambda (value &optional formatspec
)
28 (format nil
(or formatspec
"~,18,2,,,,'eE") value
)))
30 #'(lambda (string start
)
31 (parse-float:parse-float string
:start start
:type
'single-float
:junk-allowed t
))
32 #'(lambda (value &optional formatspec
)
33 (format nil
(or formatspec
"~,18,2,,,,'eE") value
))))))
35 (defun get-closest-type-function (type)
36 (car (member type type-functions
:key
#'car
:test
#'subtypep
)))
38 (defun type-reader (type)
39 (or (cadr (get-closest-type-function type
))
40 (cadr (get-closest-type-function 'double-float
))))
42 (defun type-writer (type)
43 (or (caddr (get-closest-type-function type
))
44 (caddr (get-closest-type-function 'double-float
)))))
46 (defmacro loop-at-most
((n) &body body
)
47 "Modified loop macro that repeats at most N times, if N is a
48 positive integer. Else, the behaviour is the same as LOOP."
49 (let ((total (gensym)))
56 ;;; At the moment, the data is read by creating a list of values. This
57 ;;; list constitutes a row. These rows are then collected into a list,
58 ;;; thus creating a nested list, suitable for providing to
59 ;;; :initial-contents of make-array.
61 ;;; Another strategy would be to create an adjustable vector with a
62 ;;; fill pointer. Then, vector-push-extend all values into this vector
63 ;;; and finally, having determined the shape of the array, return an
64 ;;; array displaced to that vector (is this even
65 ;;; possible?). Theoretically, this means we could return two values:
66 ;;; the displaced array, and the target vector. A user would then be
67 ;;; free to modify the original vector any way he/she wants
68 ;;; (e.g. adding extra values) and make a new array displaced to the
71 ;;; I'm not sure which approach is "better". Does "better" mean
72 ;;; "faster", or "more flexible"?
73 (defun read-row* (stream reader
&optional number-of-columns
)
74 "Read a row from STREAM and convert the values using READER. if
75 NUMBER-OF-COLUMNS is given, read at most that many values. The values
76 are returned in a LIST."
77 (let ((row (loop for line
= (read-line stream nil nil
)
78 while
(and line
(or (zerop (length line
)) (member (char line
0) *comment-characters
* :test
#'char
=)))
79 finally
(return line
))))
81 (loop-at-most (number-of-columns)
85 do
(multiple-value-bind (val pos
)
86 (funcall reader row start
)
94 (defun read-ascii-list* (stream &key
(element-type 'single-float
)
97 "Read data from STREAM into a LIST. The elements will have the
98 given ELEMENT-TYPE. Optionally, you can limit the NUMBER-OF-ROWS and
99 NUMBER-OF-COLUMNS that are read, thus truncating the data. If these
100 are not positive integers (e.g. NIL), just read everything."
101 (let ((reader (type-reader element-type
)))
102 (loop-at-most (number-of-rows)
103 for row
= (read-row* stream reader number-of-columns
)
108 unless number-of-columns
109 do
(setf number-of-columns
(length row
))
113 (defun read-ascii-array* (stream &key
(element-type 'single-float
)
116 "Read data from STREAM into a CL-ARRAY. The array will have the
117 given ELEMENT-TYPE. STREAM must contain a rectangular grid of values,
118 i.e. each row must contain the same number of values.
120 NUMBER-OF-ROWS can be used to limit the number of rows that are
121 read. The default is NIL, which will result in all rows being read.
123 NUMBER-OF-COLUMNS works as NUMBER-OF-ROWS, but for columns."
124 (let ((values (read-ascii-list* stream
:element-type element-type
125 :number-of-rows number-of-rows
126 :number-of-columns number-of-columns
)))
127 (make-array (list (length values
) (length (car values
)))
128 :element-type element-type
129 :initial-contents values
)))
131 (defun read-ascii-array (file &key
(element-type 'single-float
)
134 "Read data from FILE into an ARRAY. It opens FILE and calls
135 READ-ASCII-ARRAY* on the resulting stream."
136 (with-open-file (s file
:direction
:input
:element-type
'base-char
)
137 (read-ascii-array* s
:element-type element-type
138 :number-of-rows number-of-rows
139 :number-of-columns number-of-columns
)))
141 (defun read-ascii-vector-or-array* (stream &key
(element-type 'single-float
)
144 "Read data from STREAM into an ARRAY or a VECTOR. The array will
145 have the given ELEMENT-TYPE. STREAM must contain a rectangular grid of
146 values, i.e. each row must contain the same number of values.
148 NUMBER-OF-ROWS can be used to limit the number of rows that are
149 read. The default is NIL, which will result in all rows being read.
151 NUMBER-OF-COLUMNS works as NUMBER-OF-ROWS, but for columns.
153 This function uses READ-ASCII-ARRAY*. If the returned ARRAY has only a
154 single row or a single column, the return rank-1 array, a VECTOR, is
155 displaced to that ARRAY. Else the original ARRAY is returned."
156 (let ((read-array (read-ascii-array* stream
:element-type element-type
157 :number-of-rows number-of-rows
158 :number-of-columns number-of-columns
)))
159 (if (or (= (array-dimension read-array
0) 1)
160 (= (array-dimension read-array
1) 1))
161 (make-array (apply #'* (array-dimensions read-array
))
162 :element-type element-type
163 :displaced-to read-array
164 :displaced-index-offset
0)
169 #+nil
; Written before I knew about and understood displaced arrays.
170 (defun read-ascii-vector-or-array* (stream &key
(element-type 'single-float
)
173 (let* ((values (read-ascii-list* stream
:element-type element-type
174 :number-of-rows number-of-rows
175 :number-of-columns number-of-columns
))
176 (num-rows (length values
))
177 (num-cols (length (car values
)))
180 (cond ((= num-rows
1)
182 values
(car values
)))
185 values
(alexandria:flatten values
)))
186 (t (setf len
(list num-rows num-cols
))))
188 :element-type element-type
189 :initial-contents values
)))
191 (defun read-ascii-vector-or-array (file &key
(element-type 'single-float
)
194 "Read data from FILE into an ARRAY or a VECTOR. It opens FILE and
195 calls READ-ASCII-VECTOR-OR-ARRAY* on the resulting stream."
196 (with-open-file (s file
)
197 (read-ascii-vector-or-array* s
:element-type element-type
198 :number-of-rows number-of-rows
199 :number-of-columns number-of-columns
)))
201 (defun write-ascii-array%
(array stream formatspec number-of-rows number-of-columns
)
202 (let ((writer (type-writer (array-element-type array
))))
203 (loop for row below number-of-rows
204 for start-column
= (* row number-of-columns
)
205 for stop-column
= (+ start-column number-of-columns
)
207 (loop for column from start-column below stop-column
208 do
(princ (funcall writer
(aref array column
) formatspec
) stream
)
209 unless
(= column
(- stop-column
1))
210 do
(princ " " stream
))
213 (defun write-ascii-array* (array stream
&key formatspec
)
214 "Write the values in ARRAY to the given STREAM, optionally making
215 use of FORMATSPEC, which is a control string for FORMAT to write out a
216 single numerical value."
217 (assert (= (array-rank array
) 2))
218 (destructuring-bind (rows columns
)
219 (array-dimensions array
)
221 (make-array (* rows columns
)
222 :element-type
(array-element-type array
)
224 :displaced-index-offset
0)
230 (defun write-ascii-array (array file
&key formatspec
231 (if-exists :supersede
)
232 (if-does-not-exist :create
))
233 "Write the values in ARRAY to the given FILE. It opens the FILE and
234 writes the data to the restulting stream using WRITE-ASCII-ARRAY*."
235 (with-open-file (s file
:direction
:output
:if-exists if-exists
:if-does-not-exist if-does-not-exist
)
236 (write-ascii-array* array s
:formatspec formatspec
)))
238 (defun write-ascii-vector-or-array* (vector-or-array stream
&key formatspec
)
239 "Write the values in VECTOR-OR-ARRAY to the given STREAM, optionally
240 making use of FORMATSPEC, which is a control string for FORMAT to
241 write out a single numerical value."
242 (assert (< (array-rank vector-or-array
) 3))
243 (if (= (array-rank vector-or-array
) 1)
244 (write-ascii-array% vector-or-array stream formatspec
(array-dimension vector-or-array
0) 1)
245 (write-ascii-array* vector-or-array stream
:formatspec formatspec
)))
247 (defun write-ascii-vector-or-array (vector-or-array file
&key formatspec
248 (if-exists :supersede
)
249 (if-does-not-exist :create
))
250 "Write the values in VECTOR-OR-ARRAY to the given FILE. It opens the FILE and
251 writes the data to the restulting stream using WRITE-ASCII-VECTOR-OR-ARRAY*."
252 (with-open-file (s file
:direction
:output
:if-exists if-exists
:if-does-not-exist if-does-not-exist
)
253 (write-ascii-vector-or-array* vector-or-array s
:formatspec formatspec
)))