grid.lisp 8.72 KB
Newer Older
1
;; Grid methods for physical dimension quantities
2
;; Liam Healy 2011-01-17 18:36:54EST grid.lisp
3
;; Time-stamp: <2013-11-23 09:50:59EST grid.lisp>
4

5
;; Copyright 2011, 2012, 2013 Liam M. Healy
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

21
22
;;; Physical dimension quantities with a magnitude that is a scalar
;;; (not a grid).
23
24
25
26
27
28
29

(in-package :antik)

;;;;****************************************************************************
;;;; make-pq-grid
;;;;****************************************************************************

30
31
32
33
(defun make-pq-grid-NEW
    (unit-expressions same-units &key (initial-element nil initial-element-p)
     (initial-contents nil initial-contents-p)
     specification)
34
35
  "Construct a pdq grid given one of:
   1) initial-contents of pdqs and specification
36
37
   2) initial-contents of magnitudes, unit-expressions,
       and optionally specification (else same as magnitudes')
38
   3) initial-element being a pdq, and specification
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
   4) specification and optionally same-units."
  (let ((spec (or specification (rest (grid:specification initial-contents)))))
    (make-pq-object
     (apply #'grid::make-grid		; the magnitude
	    spec
	    (cond (initial-element-p
		   (list :initial-element (pq-magnitude initial-element)))
		  (initial-contents-p
		   (list :initial-contents (map-pq #'pq-magnitude initial-contents)))
		  (t nil)))
     (or same-units			; the units
	 (apply
	  #'make-array
	  (grid::specification-dimensions spec)
	  :element-type t
	  (cond 
	    (initial-contents-p
	     (list :initial-contents (map-pq #'pq-dimension initial-contents)))
	    (unit-expressions (list :initial-contents unit-expressions))
	    (t (list :initial-element nil)))))
     (not (not same-units)))))

61
(defun make-pq-grid (magnitude unit-expressions)
62
63
64
  "Make a physical dimension quantity out of a grid where the elements may have different units.  This may modify the contents of the magnitude grid."
  ;; We make a scalar pdq out of each element in order to compute the
  ;; SI value of the magnitude before making the pdq object.
65
  (loop with unit-array = (make-array (grid:dimensions magnitude))
66
67
68
69
70
71
	and ue = (if (grid:gridp unit-expressions)
		     unit-expressions
		     (make-array
		      (grid:dimensions unit-expressions)
		      :element-type t
		      :initial-contents unit-expressions))
72
	for i below (grid:total-size magnitude)
73
	for pq-elt = (make-pq-ue (grid:aref* magnitude i) (grid:aref* ue i))
74
	do
Liam M. Healy's avatar
Liam M. Healy committed
75
76
     (setf (grid:aref* magnitude i) (pq-magnitude pq-elt)
	   (grid:aref* unit-array i) (pq-dimension pq-elt))
77
78
	finally (return (make-pq-object magnitude unit-array nil))))

79
(defun pq-gridp (object)
80
  (and (physical-quantity-p object)
81
       (grid:gridp (antik::pq-magnitude object))
82
       (list 'physical-quantity (grid:gridp (antik::pq-magnitude object)))))
83

Liam M. Healy's avatar
Liam M. Healy committed
84
85
(setf grid::*additional-gridp-test* #'pq-gridp)

86
87
88
89
;;;;****************************************************************************
;;;; Grid methods
;;;;****************************************************************************

90
(defun map-pq (function object &optional flatten)
91
  "Map the function of a pdq onto the nested lists of pdqs, optionally flattening."
92
  (etypecase object
93
    ((or number physical-quantity) (funcall function object))
94
95
96
97
98
99
    (list (funcall
	   (if (and flatten (listp (first object)))
	       #'alexandria:mappend
	       #'mapcar)
	   (lambda (ob) (map-pq function ob flatten)) object))))

100
(defmethod grid::make-grid-data
101
102
103
104
  ((type (eql 'physical-quantity)) dimensions rest-spec
   &key
   (initial-element nil initial-element-p)
   (initial-contents nil initial-contents-p))
105
106
107
108
  (declare (ignore dimensions))
  (let ((same-units
	 (cond
	   (initial-element-p (pq-dimension initial-element))
109
	   (initial-contents-p (equal-dimensions initial-contents)))))
110
111
112
113
114
115
116
117
118
    (make-pq-object
     (apply #'grid::make-grid
	    rest-spec
	    (cond (initial-element-p
		   (list :initial-element (pq-magnitude initial-element)))
		  (initial-contents-p
		   (list :initial-contents (map-pq #'pq-magnitude initial-contents)))
		  (t nil)))
     (or same-units
119
120
	 (apply
	  #'make-array
121
122
	  (grid::specification-dimensions rest-spec)
	  :element-type t
123
124
125
126
127
	  (if initial-contents-p
	      (list
	       :initial-contents
	       (map-pq #'pq-dimension initial-contents))
	      (list :initial-element nil))))
128
     (not (not same-units)))))
129

130
(defmethod grid::make-grid-data :around
131
    (type dimensions rest-spec &rest keys &key initial-element initial-contents)
132
  ;; Check if a grid is being made with pdq initializing but not speced as pdq
133
134
135
  (if (eq type 'physical-quantity)
      (call-next-method)
      (if (or (and initial-contents
136
		   (some (lambda (x) (physical-quantity-p x))
137
			 (alexandria:flatten initial-contents)))
138
	      (physical-quantity-p initial-element))
139
140
141
142
143
144
	  (apply #'grid::make-grid-data
		 'physical-quantity
		 nil
		 (apply 'grid::make-specification type dimensions rest-spec)
		 keys)
	  (call-next-method))))
145

146
147
148
149
(defmethod grid::affi ((grid physical-quantity))
  (when (grid:gridp grid)
    (grid::affi (pq-magnitude grid))))

Liam M. Healy's avatar
Liam M. Healy committed
150
(defmethod grid:aref ((object physical-quantity) &rest indices)
151
152
  (assert (grid:gridp (pq-magnitude object)) (object))
  (make-pq-object
Liam M. Healy's avatar
Liam M. Healy committed
153
   (apply #'grid:aref (pq-magnitude object) indices)
154
155
   (if (scalar-dimension object)
       (pq-dimension object)
Liam M. Healy's avatar
Liam M. Healy committed
156
       (apply #'grid:aref (pq-dimension object) indices))
157
158
   t))

Liam M. Healy's avatar
Liam M. Healy committed
159
(defmethod grid:aref* ((object physical-quantity) index)
160
  (assert (grid:gridp (pq-magnitude object)) (object))
161
  (make-pq-object
Liam M. Healy's avatar
Liam M. Healy committed
162
   (grid:aref* (pq-magnitude object) index)
163
164
   (if (scalar-dimension object)
       (pq-dimension object)
Liam M. Healy's avatar
Liam M. Healy committed
165
       (grid:aref* (pq-dimension object) index))
166
   t))
167

Liam M. Healy's avatar
Liam M. Healy committed
168
(defmethod (setf grid:aref) (value (object physical-quantity) &rest indices)
169
  (assert (grid:gridp (pq-magnitude object)) (object))
170
  (assert (or (and (scalar-dimension object) (equal-dimension value object nil))
171
	      (physical-quantity-p value)))
172
173
  ;; Value should be a scalar; it can be a pdq or not.  If it is not a
  ;; pdq, then object should have scalar-units = t so that the
174
175
  ;; appropriate units may be adopted.
  (if (and (scalar-dimension object) (equal-dimension value object nil))
176
      (apply #'(setf grid:aref) (pq-magnitude value) (pq-magnitude object) indices)
177
      (progn
Liam M. Healy's avatar
Liam M. Healy committed
178
179
	(apply #'(setf grid:aref) (pq-magnitude value) (pq-magnitude object) indices)
	(apply #'(setf grid:aref) (pq-dimension value) (pq-dimension object) indices)))
180
181
  value)

Liam M. Healy's avatar
Liam M. Healy committed
182
(defmethod (setf grid:aref*) (value (object physical-quantity) index)
183
184
  (assert (grid:gridp (pq-magnitude object)) (object))
  (assert (or (and (scalar-dimension object) (equal-dimension value object nil))
185
	      (and (zerop value) antik::*zero-is-dimensionless*)
186
	      (physical-quantity-p value))
187
188
	  (value)
	  "The element cannot be set to ~a because it ~
189
           is not a physical dimension quantity and the array does not have ~
190
           scalar units." value)
191
192
  ;; Value should be a scalar; it can be a pdq or not.  If it is not a
  ;; pdq, then object should have scalar-units = t so that the
193
  ;; appropriate units may be adopted.
194
  (if (and (scalar-dimension object) (equal-dimension value object nil))
Liam M. Healy's avatar
Liam M. Healy committed
195
      (setf (grid:aref* (pq-magnitude object) index) value)
196
      (progn
Liam M. Healy's avatar
Liam M. Healy committed
197
198
	(setf (grid:aref* (pq-magnitude object) index) (pq-magnitude value))
	(setf (grid:aref* (pq-dimension object) index) (pq-dimension value))))
199
  value)
200
201
202
203

(defmethod grid:dimensions ((object physical-quantity))
	   (grid:dimensions (pq-magnitude object)))

204
205
(defmethod grid:rank ((object physical-quantity))
	   (grid:rank (pq-magnitude object)))
206
207
208
209
210
211
212

(defmethod grid:total-size ((object physical-quantity))
	   (grid:total-size (pq-magnitude object)))

(defmethod grid:element-type ((object physical-quantity))
	   (grid:element-type (pq-magnitude object)))

213
214
215
216
(defun grid::pdq-grid-specification (specification)
  "Make a specification for a PDQ grid from the specification of its magnitude."
  (cons 'physical-quantity specification))

217
(defmethod grid:specification ((object physical-quantity))
218
	   (grid::pdq-grid-specification
219
		 (grid:specification (pq-magnitude object))))
Liam M. Healy's avatar
Liam M. Healy committed
220
221
222
223
224
225
226

(defmethod grid::print-grid-readably
    ((object physical-quantity) contents-writer stream)
  (grid::print-grid-readably
   (pq-magnitude object)
   contents-writer
   stream))