Commit 514bbac1 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Move arithmetic methods that use funcall-dyadic, organize tests

Calls to funcall-dyadic only should happen once that function has been defined, and it is meant to handle grid/pq case anyway, so the arithmetic methods (t t) that called it have been moved to where it is defined, which is in the physical-dimension system. Tests have been reorganized, and all pass.
parent e670f326
;; Generic functions for generalized numbers
;; Liam Healy Tue Feb 9 1999 - 21:38
;; Time-stamp: <2011-12-02 13:16:28EST generic.lisp>
;; Time-stamp: <2013-11-23 12:13:32EST generic.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -74,7 +74,6 @@
(:documentation "Addition of generalized or regular numbers.")
(:method ((a number) (b number))
(cl:+ a b))
(:method (a b) (funcall-dyadic '+i a b 'zerop))
(:method ((a sequence) (b sequence))
(map (type-of a) #'+i a b)))
......@@ -89,9 +88,6 @@
Users call -.")
(:method ((a number) (b number))
(cl:- a b))
(:method (a b)
(funcall-dyadic
'-i a b (lambda (x) (or (null x) (zerop x))) (lambda (x) (* -1 x))))
(:method ((a sequence) (b sequence))
(if (null b)
(*i -1 a)
......@@ -106,7 +102,6 @@
;; Ordinary number multiplication
(:method ((a number) (b number))
(cl:* a b))
(:method (a b) (funcall-dyadic '*i a b))
;; Two sequences
(:method ((a sequence) (b sequence))
(if (null b)
......@@ -126,7 +121,6 @@
Users call /.")
(:method ((a number) (b number))
(cl:/ a b))
(:method (a b) (funcall-dyadic '/i a b 'null (lambda (x) (/ 1 x))))
;; Division can be done as reciprocal and multiplication, or vice versa
;; For each generalized number, one of these must be specified
;; as a specialized method.
......@@ -355,6 +349,7 @@
(:documentation "Numeric equal")
(:method ((a number) (b number))
(if (cl:= a b) a))
#+(or)
(:method (a b) (funcall-dyadic '= (numbcomp a) (numbcomp b))))
(defgeneric plusp (a)
......
;; Physical dimension system definition
;; Liam Healy 2012-02-20 10:14:49EST physical-dimension.asd
;; Time-stamp: <2013-11-23 11:13:00EST physical-dimension.asd>
;; Time-stamp: <2013-11-23 14:47:21EST physical-dimension.asd>
;; Copyright 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -72,6 +72,14 @@
(:file "polar")
(:file "rotation")))))
(asdf:defsystem-connection #:pq-tests
:serial t
:requires (#:physical-dimension #:lisp-unit)
:components
((:module tests
:components
((:file "physical-quantities")))))
(asdf:defsystem-connection #:pq-grid
:serial t
:requires (#:physical-dimension #:grid)
......@@ -86,7 +94,8 @@
:components
((:module tests
:serial t
:components ((:file "format-grid")))))
:components ((:file "physical-quantities-grid")
(:file "format-grid")))))
(asdf:defsystem-connection #:degree-symbol
:serial t
......
;; Generic dyadic calls
;; Liam Healy 2011-02-15 21:30:46EST funcall.lisp
;; Time-stamp: <2011-08-20 22:21:24EDT funcall.lisp>
;; Time-stamp: <2013-11-23 12:15:36EST funcall.lisp>
;;; This must be defined here because grid type must be loaded.
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -70,3 +70,14 @@
;; could be replaced with something more meaningful if
;; necessary. Can't use call-next-method here.
(error "Don't know how to coerce ~a and ~a." a b))))))
(defmethod +i (a b)
(funcall-dyadic '+i a b 'zerop))
(defmethod -i (a b)
(funcall-dyadic
'-i a b (lambda (x) (or (null x) (zerop x))) (lambda (x) (* -1 x))))
(defmethod *i (a b) (funcall-dyadic '*i a b))
(defmethod /i (a b) (funcall-dyadic '/i a b 'null (lambda (x) (/ 1 x))))
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2013-11-23 14:34:27EST physical-quantities-grid.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; 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/>.
(in-package :antik)
;;; These are all scalar units, i.e., the same units apply to each
;;; element of the array.
(lisp-unit:define-test grid-scalar-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_m)))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #m(#_1.0d0_m #_5.0d0_m) #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq
(grid:make-simple-grid
:grid-type 'array
:initial-contents (list #_1.0d0_m #_5.0d0_m))
#(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(1.0d0 5.0d0))
'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq #_#(1.0d0 2.0d0)_m #(1.0d0 2.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq (make-pq #(1.0d0 2.0d0) 'meter) #(1.0d0 2.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #_#m(1.0d0 5.0d0)_m #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq (make-pq #m(1.0d0 5.0d0) 'meter) #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity using make-grid with :initial-element
(check-pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-element #_23.0_m)
(grid:make-foreign-array 'double-float :initial-contents '(23.0d0 23.0d0 23.0d0))
'meter))
(lisp-unit:assert-true
;; A physical-quantity using make-grid with :initial-contents
(let ((pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-contents '(#_1_km #_2_km #_3_km))))
(and (scalar-dimension pq)
(check-pq pq
(grid:make-foreign-array 'double-float :initial-contents '(1.0d3 2.0d3 3.0d3))
'meter)))))
(lisp-unit:define-test grid-array-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_s)))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'second))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_s))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'second))))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #m(#_1.0d0_m #_5.0d0_s) #m(1.0d0 5.0d0) #(meter second)))
;; This should work but it doesn't like #(meter) for units:
;;;(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude, single
;;; (check-pq #m(#_1.0d0_m) #m(1.0d0) #(meter)))
(lisp-unit:assert-true
;; A vector with foreign-array magnitude and :initial-contents
(check-pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-contents '(#_1_km #_2_km #_3_sec))
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(1.0d3 2.0d3 3.0d0))
#(meter meter second)))
(lisp-unit:assert-true
;; A 2D foreign-array magnitude and :initial-contents
(check-pq
(grid:make-grid '((grid:foreign-array 3 2) double-float)
:initial-contents '((#_1_km #_2_km #_3_sec) (#_1_m #_2_m #_88_sec)))
(grid:make-foreign-array
'double-float :dimensions '(2 3)
:initial-contents '((1000.0d0 2000.0d0 3.0d0) (1.0d0 2.0d0 88.0d0)))
#2A((meter meter second) (meter meter second))))
(lisp-unit:assert-true
;; Concatenate grids, array
(check-pq (grid:concatenate-grids #_#(1.0d0 2.0d0)_m #_#(3.0d0 4.0d0)_s)
#(1.0d0 2.0d0 3.0d0 4.0d0)
#(meter meter second second)))
(lisp-unit:assert-true
;; Concatenate grids, foreign-array
;; (grid:concatenate-grids #_#m(1.0d0 2.0d0)_m #_#m(3.0d0 4.0d0)_s)
(check-pq (let ((grid:*default-grid-type* 'grid:foreign-array))
(grid:concatenate-grids
(make-pq
(grid:make-grid '((grid:foreign-array 2) double-float) :initial-contents
'(1.0 2.0))
'meter t)
(make-pq
(grid:make-grid '((grid:foreign-array 2) double-float) :initial-contents
'(3.0 4.0))
'second t)))
(grid:make-foreign-array 'double-float
:dimensions '(4)
:initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0))
#(meter meter second second))))
#|
;;; Things that should be made to work.
;;; Multiplication of dimensionless grid by dimensioned grid
(* #((1.0 0.0) (0.0 1.0)) #(#_1_km #_2_s)) ; works
(* #m((1.0 0.0) (0.0 1.0)) #m(#_1_km #_2_s)) ; does not work
;;; Add dimensioned
(+ #m(#_1_km #_2_s) #m(#_1_km #_2_s))
;;; Multiply dimensioned
(* #_#m((1.0 0.0) (0.0 1.0))_km #m(#_1_km #_2_s))
|#
;; Tests of physical quantities
;; Liam Healy 2011-01-09 17:38:41EST tests.lisp
;; Time-stamp: <2013-06-11 23:03:33EDT physical-quantities.lisp>
;; Time-stamp: <2013-11-23 14:41:51EST physical-quantities.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -20,7 +20,7 @@
(in-package :antik)
(defmethod lisp-unit::numerical-equal
(defmethod lisp-unit:numerical-equal
((result1 physical-quantity) (result2 physical-quantity) &rest keys &key test)
(declare (ignorable test))
(multiple-value-bind (mag2 units2)
......@@ -29,6 +29,19 @@
(apply 'lisp-unit::numerical-equal (pq-magnitude result1) mag2 keys)
(check-dimension result1 units2 nil))))
;;; Radians count as a number
(defmethod lisp-unit:numerical-equal
((result1 physical-quantity) (result2 number) &rest keys &key test)
(declare (ignorable test))
(and (check-dimension result1 'angle nil)
(apply 'lisp-unit::numerical-equal (pq-magnitude result1) result2 keys)))
(defmethod lisp-unit:numerical-equal
((result1 number) (result2 physical-quantity) &rest keys &key test)
(declare (ignorable test))
(and (check-dimension result2 'angle nil)
(apply 'lisp-unit::numerical-equal result1 (pq-magnitude result2) keys)))
(defun check-pq (object value units)
"Check that the object is a physical-quantity and that its magnitude
and units are as given."
......@@ -59,142 +72,3 @@
100000.0d0
(with-system-of-units (cgs)
(pqval #_1_km))))
;;; These are all scalar units, i.e., the same units apply to each
;;; element of the array.
(lisp-unit:define-test grid-scalar-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_m)))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'meter))))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #m(#_1.0d0_m #_5.0d0_m) #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq
(grid:make-simple-grid
:grid-type 'array
:initial-contents (list #_1.0d0_m #_5.0d0_m))
#(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(#_1.0d0_m #_5.0d0_m))
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(1.0d0 5.0d0))
'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq #_#(1.0d0 2.0d0)_m #(1.0d0 2.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with an array as magnitude
(check-pq (make-pq #(1.0d0 2.0d0) 'meter) #(1.0d0 2.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #_#m(1.0d0 5.0d0)_m #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq (make-pq #m(1.0d0 5.0d0) 'meter) #m(1.0d0 5.0d0) 'meter))
(lisp-unit:assert-true
;; A physical-quantity using make-grid with :initial-element
(check-pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-element #_23.0_m)
(grid:make-foreign-array 'double-float :initial-contents '(23.0d0 23.0d0 23.0d0))
'meter))
(lisp-unit:assert-true
;; A physical-quantity using make-grid with :initial-contents
(let ((pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-contents '(#_1_km #_2_km #_3_km))))
(and (scalar-dimension pq)
(check-pq pq
(grid:make-foreign-array 'double-float :initial-contents '(1.0d3 2.0d3 3.0d3))
'meter)))))
(lisp-unit:define-test grid-array-units
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid #(#_1.0d0_m #_5.0d0_s)))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'second))))
(lisp-unit:assert-true
;; An array with pqs as elements
(let ((grid (make-array '(2) :initial-contents '(#_1.0d0_m #_5.0d0_s))))
(and (arrayp grid)
(equal (grid:dimensions grid) '(2))
(check-pq (grid:aref grid 0) 1.0d0 'meter)
(check-pq (grid:aref grid 1) 5.0d0 'second))))
(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude
(check-pq #m(#_1.0d0_m #_5.0d0_s) #m(1.0d0 5.0d0) #(meter second)))
;; This should work but it doesn't like #(meter) for units:
;;;(lisp-unit:assert-true
;; A physical-quantity with a foreign-array as magnitude, single
;;; (check-pq #m(#_1.0d0_m) #m(1.0d0) #(meter)))
(lisp-unit:assert-true
;; A vector with foreign-array magnitude and :initial-contents
(check-pq
(grid:make-grid '((grid:foreign-array 3) double-float)
:initial-contents '(#_1_km #_2_km #_3_sec))
(grid:make-foreign-array
'double-float :dimensions '(2) :initial-contents '(1.0d3 2.0d3 3.0d0))
#(meter meter second)))
(lisp-unit:assert-true
;; A 2D foreign-array magnitude and :initial-contents
(check-pq
(grid:make-grid '((grid:foreign-array 3 2) double-float)
:initial-contents '((#_1_km #_2_km #_3_sec) (#_1_m #_2_m #_88_sec)))
(grid:make-foreign-array
'double-float :dimensions '(2 3)
:initial-contents '((1000.0d0 2000.0d0 3.0d0) (1.0d0 2.0d0 88.0d0)))
#2A((meter meter second) (meter meter second))))
(lisp-unit:assert-true
;; Concatenate grids, array
(check-pq (grid:concatenate-grids #_#(1.0d0 2.0d0)_m #_#(3.0d0 4.0d0)_s)
#(1.0d0 2.0d0 3.0d0 4.0d0)
#(meter meter second second)))
(lisp-unit:assert-true
;; Concatenate grids, foreign-array
;; (grid:concatenate-grids #_#m(1.0d0 2.0d0)_m #_#m(3.0d0 4.0d0)_s)
(check-pq (let ((grid:*default-grid-type* 'grid:foreign-array))
(grid:concatenate-grids
(make-pq
(grid:make-grid '((grid:foreign-array 2) double-float) :initial-contents
'(1.0 2.0))
'meter t)
(make-pq
(grid:make-grid '((grid:foreign-array 2) double-float) :initial-contents
'(3.0 4.0))
'second t)))
(grid:make-foreign-array 'double-float
:dimensions '(4)
:initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0))
#(meter meter second second))))
#|
;;; Things that should be made to work.
;;; Multiplication of dimensionless grid by dimensioned grid
(* #((1.0 0.0) (0.0 1.0)) #(#_1_km #_2_s)) ; works
(* #m((1.0 0.0) (0.0 1.0)) #m(#_1_km #_2_s)) ; does not work
;;; Add dimensioned
(+ #m(#_1_km #_2_s) #m(#_1_km #_2_s))
;;; Multiply dimensioned
(* #_#m((1.0 0.0) (0.0 1.0))_km #m(#_1_km #_2_s))
|#
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment