Commit 208c5b18 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Dyadic functions +, -, *, / with single or sequence arguments

+ All single-argument behavior should be defined in the ordinary functions.
+ All methods with sequence as one or both arguments moved to grid (because of the need to check for grids), defined by defmethods-dyadic-sequences
+ If one argument is a sequence, scalar argument is mapped to each element
+ If both arguments are sequences, elementwise map on each, so sequences have to be the same length.
+ Warning from ordinary functions if an argument is nil.
+ Tests for 1, 2, 3 arguments added/organized in [[file:~/mathematics/antik/tests/numbers.lisp::(lisp-unit:define-test%20numbers][numbers.lisp]].
+ Add test cases in antik/grid/tests/sequence.lisp for one or both argunments a sequence
+ All tests pass with antik-base only and grid systems loaded.
     #+BEGIN_SRC lisp
     (ql:quickload :lisp-unit)
     (ql:quickload :grid)
     :pa antik
     (lisp-unit:run-tests)
     NUMBERS: 40 assertions passed, 0 failed.
     SEQUENCES: 12 assertions passed, 0 failed.
     TOTAL: 52 assertions passed, 0 failed, 0 execution errors.
     #+END_SRC
parent 976244eb
;; Antik system definition ;; Antik system definition
;; Liam Healy 2010-12-24 09:43:28EST antik.asd ;; Liam Healy 2010-12-24 09:43:28EST antik.asd
;; Time-stamp: <2013-12-25 16:00:14EST grid.asd> ;; Time-stamp: <2014-01-05 14:33:13EST grid.asd>
;; Copyright 2011, 2012, 2013 Liam M. Healy ;; Copyright 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -59,6 +59,7 @@ ...@@ -59,6 +59,7 @@
((:module tests ((:module tests
:components :components
((:file "augment") ((:file "augment")
(:file "sequence")
(:file "compose") (:file "compose")
(:file "map") (:file "map")
(:file "slice") (:file "slice")
......
;; Functions on grids ;; Functions on grids
;; Liam Healy 2010-06-19 22:25:17EDT functions.lisp ;; Liam Healy 2010-06-19 22:25:17EDT functions.lisp
;; Time-stamp: <2013-11-23 09:44:34EST functions.lisp> ;; Time-stamp: <2014-01-05 14:40:50EST functions.lisp>
;; Copyright 2010, 2011, 2012, 2013 Liam M. Healy ;; Copyright 2010, 2011, 2012, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -228,51 +228,35 @@ ...@@ -228,51 +228,35 @@
(loop for ind from 0 below (total-size grid) (loop for ind from 0 below (total-size grid)
always (antik:zerop (aref* grid ind)))) always (antik:zerop (aref* grid ind))))
(defmethod antik::+i ((a sequence) b) ; b is a scalar (defmacro sequence-map (operator scalar sequence sequence-first)
(if (gridp b) "Apply the dyadic operator on a scalar and a sequence, applying making a similar sequence with each element to operator acting on the input element and the scalar."
(call-next-method) `(map (type-of ,sequence)
(map (type-of a) (lambda (x) (antik::+i x b)) a))) (,(if sequence-first 'alexandria:rcurry 'alexandria:curry)
(function ,operator)
(defmethod antik::+i (a (b sequence)) ; a is a scalar ,scalar)
(if (gridp a) ,sequence))
(call-next-method)
(map (type-of b) (lambda (x) (antik::+i a x)) b))) (defmacro defmethods-dyadic-sequences (operator)
"Define defmethods for dyadic operators having at least one argument a sequence."
(defmethod antik::-i ((a sequence) b) ; b is a scalar `(progn
(if (gridp b) (defmethod ,operator ((a sequence) b) ; b is a scalar
(call-next-method) (if (gridp b)
(map (type-of a) (lambda (x) (antik::-i x b)) a))) (call-next-method)
(sequence-map ,operator b a t)))
(defmethod antik::-i (a (b sequence)) ; a is a scalar (defmethod ,operator (a (b sequence)) ; a is a scalar
(if (null b) (if (gridp a)
(antik::*i -1 a) (call-next-method)
(if (gridp a) (sequence-map ,operator a b nil)))
(call-next-method) (defmethod ,operator ((a sequence) (b sequence)) ; both sequences
(map (type-of b) (lambda (x) (antik::-i a x)) b)))) (assert (eq (length a) (length b)) (a b)
"Sequence arguments are not of the same length.")
;; Scalar multiplication of sequences ;; apply elementwise
(defmethod antik::*i ((a sequence) b) ; b is a scalar (map (type-of a) (function ,operator) a b))))
(if (gridp b)
(call-next-method) (defmethods-dyadic-sequences antik::+i)
(map (type-of a) (lambda (x) (antik::*i x b)) a))) (defmethods-dyadic-sequences antik::-i)
(defmethods-dyadic-sequences antik::*i)
(defmethod antik::*i (a (b sequence)) ; a is a scalar (defmethods-dyadic-sequences antik::/i)
(if (null b)
a ; null second arg - return first
(if (gridp a)
(call-next-method)
(map (type-of b) (lambda (x) (antik::*i a x)) b))))
;; Scalar division of sequences
(defmethod antik::/i ((a sequence) b)
(if (gridp b)
(call-next-method)
(map (type-of a) (lambda (x) (antik::/i x b)) a)))
(defmethod antik::/i (a (b sequence))
(if (gridp a)
(call-next-method)
(map (type-of b) (lambda (x) (antik::/i a x)) b)))
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Element reference ;;;; Element reference
......
;; Tests on sequences
;; Liam Healy 2014-01-05 14:20:02EST sequence.lisp
;; Time-stamp: <2014-01-05 14:32:47EST sequence.lisp>
;; Copyright 2014 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)
(lisp-unit:define-test sequences
(lisp-unit::assert-numerical-equal
'(5.0d0 6.0d0 7.0d0)
(+ 2.0d0 '(3.0d0 4.0d0 5.0d0)))
(lisp-unit::assert-numerical-equal
'(6.0d0 8.0d0 10.0d0)
(+ '(4.0d0 6.0d0 8.0d0) 2.0d0))
(lisp-unit::assert-numerical-equal
'(-1.0d0 -2.0d0 -3.0d0)
(- 2.0d0 '(3.0d0 4.0d0 5.0d0)))
(lisp-unit::assert-numerical-equal
'(2.0d0 4.0d0 6.0d0)
(- '(4.0d0 6.0d0 8.0d0) 2.0d0))
(lisp-unit::assert-numerical-equal
(* 2.0d0 '(3.0d0 4.0d0 5.0d0))
'(6.0d0 8.0d0 10.0d0))
(lisp-unit::assert-numerical-equal
'(8.0d0 12.0d0 16.0d0)
(* '(4.0d0 6.0d0 8.0d0) 2.0d0))
(lisp-unit::assert-numerical-equal
(list (cl:coerce 2/3 'double-float) 0.5d0 0.4d0)
(/ 2.0d0 '(3.0d0 4.0d0 5.0d0)))
(lisp-unit::assert-numerical-equal
'(2.0d0 3.0d0 4.0d0)
(/ '(4.0d0 6.0d0 8.0d0) 2.0d0))
(lisp-unit::assert-numerical-equal
'(8.0d0 8.0d0 9.0d0)
(+ '(4.0d0 6.0d0 8.0d0) '(4.0d0 2.0d0 1.0d0)))
(lisp-unit::assert-numerical-equal
'(16.0d0 12.0d0 8.0d0)
(* '(4.0d0 6.0d0 8.0d0) '(4.0d0 2.0d0 1.0d0)))
(lisp-unit::assert-numerical-equal
'(0.0d0 4.0d0 7.0d0)
(- '(4.0d0 6.0d0 8.0d0) '(4.0d0 2.0d0 1.0d0)))
(lisp-unit::assert-numerical-equal
'(1.0d0 3.0d0 8.0d0)
(/ '(4.0d0 6.0d0 8.0d0) '(4.0d0 2.0d0 1.0d0))))
;; Conditions and handlers for arithmetic. ;; Conditions and handlers for arithmetic.
;; Liam Healy Tue May 17 2005 - 16:29 ;; Liam Healy Tue May 17 2005 - 16:29
;; Time-stamp: <2011-05-30 22:18:38EDT conditions.lisp> ;; Time-stamp: <2014-01-05 14:05:35EST conditions.lisp>
;; Copyright 2011 Liam M. Healy ;; Copyright 2011, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -42,7 +42,14 @@ ...@@ -42,7 +42,14 @@
((object :initarg :object :reader coerce-object)) ((object :initarg :object :reader coerce-object))
(:report (lambda (condition stream) (:report (lambda (condition stream)
(format stream "Cannot coerce ~a to NIL." (coerce-object condition)))) (format stream "Cannot coerce ~a to NIL." (coerce-object condition))))
(:documentation "Signalled when gcoercing something to nil.")) (:documentation "Signalled when coercing something to nil."))
(define-condition null-argument (warning)
()
(:report (lambda (condition stream)
(declare (ignore condition))
(format stream "NIL passed as argument to arithmetic function.")))
(:documentation "Warned when nil passed as argument to arithmetic function."))
(define-condition making-complex-number (arithmetic-error) (define-condition making-complex-number (arithmetic-error)
((operation :initarg :operation :reader mcn-operation) ((operation :initarg :operation :reader mcn-operation)
......
;; Generic functions for generalized numbers ;; Generic functions arithmetic functions on generalized numbers
;; Liam Healy Tue Feb 9 1999 - 21:38 ;; Liam Healy Tue Feb 9 1999 - 21:38
;; Time-stamp: <2013-12-16 17:25:39EST generic.lisp> ;; Time-stamp: <2014-01-05 14:14:06EST generic.lisp>
;; Copyright 2011, 2013 Liam M. Healy ;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -20,12 +20,6 @@ ...@@ -20,12 +20,6 @@
(in-package :antik) (in-package :antik)
;;; Generic functions and methods for arithmetic methods on
;;; generalized numbers.
;;; This needs some work -
;;; * handle both sequences and scalars without commenting out stuff?
;;; (see /i; check type then call-next-method?)
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Convert numeric types ;;;; Convert numeric types
;;;;**************************************************************************** ;;;;****************************************************************************
...@@ -72,70 +66,47 @@ ...@@ -72,70 +66,47 @@
;;; and the function will recurse infinitely. ;;; and the function will recurse infinitely.
(defgeneric +i (a b) (defgeneric +i (a b)
(:documentation "Addition of generalized or regular numbers.") (:documentation "Addition of generalized or regular numbers.")
(:method ((a number) (b number)) (:method ((a number) (b number)) (cl:+ a b)))
(cl:+ a b))
(:method ((a sequence) (b sequence))
(map (type-of a) #'+i a b)))
(defun + (&rest args) (defun + (&rest args)
"Addition of generalized or regular numbers with an "Addition of generalized or regular numbers with an
arbitrary number of arguments." arbitrary number of arguments."
(reduce #'+i args)) (when (member nil args) (warn 'null-argument))
(if (single args) (first args) (reduce #'+i args)))
(defgeneric -i (a b) (defgeneric -i (a b)
(:documentation (:documentation
"Subtraction/negation of generalized or regular numbers, internal. "Subtraction/negation of generalized or regular numbers, internal.
Users call -.") Users call -.")
(:method ((a number) (b number)) (:method ((a number) (b number)) (cl:- a b)))
(cl:- a b))
(:method ((a sequence) (b sequence))
(if (null b)
(*i -1 a)
(map (type-of a) #'-i a b))))
(defun - (&rest args) (defun - (&rest args)
"Subtraction of generalized or regular numbers." "Subtraction of generalized or regular numbers."
(if (single args) (-i (first args) nil) (reduce #'-i args))) (when (member nil args) (warn 'null-argument))
(if (single args) (-i 0 (first args)) (reduce #'-i args)))
(defgeneric *i (a b) (defgeneric *i (a b)
(:documentation "Multiplication of generalized or regular numbers.") (:documentation "Multiplication of generalized or regular numbers.")
;; Ordinary number multiplication (:method ((a number) (b number)) (cl:* a b)))
(:method ((a number) (b number))
(cl:* a b))
;; Two sequences
(:method ((a sequence) (b sequence))
(if (null b)
a ; null second arg - return first
(progn
(assert (eq (length a) (length b)) (a b)
"Sequence arguments are not of the same length.")
(map (type-of a) #'*i a b)))))
(defun * (&rest args) (defun * (&rest args)
"Multiplication of generalized or regular numbers with an "Multiplication of generalized or regular numbers with an
arbitrary number of arguments." arbitrary number of arguments."
(when (member nil args) (warn 'null-argument))
(if (single args) (first args) (reduce #'*i args))) (if (single args) (first args) (reduce #'*i args)))
(defgeneric /i (a b) (defgeneric /i (a b)
(:documentation "Division of generalized or regular numbers, internal. (:documentation "Division of generalized or regular numbers, internal.
Users call /.") Users call /.")
(:method ((a number) (b number)) (:method ((a number) (b number)) (cl:/ a b)))
(cl:/ a b))
;; 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.
;; see below for reciprocal (:method (a (b null)) (/i 1 a))
;; Two sequences
(:method ((a sequence) (b sequence))
(progn
(assert (eq (length a) (length b)) (a b)
"Sequence arguments are not of the same length.")
(map (type-of a) #'/i a b))))
(defun / (&rest args) (defun / (&rest args)
"Division of generalized or regular numbers for an "Division of generalized or regular numbers for an
arbitrary number of arguments." arbitrary number of arguments."
(if (single args) (/i 1 (first args)) (reduce #'/i args))) (when (member nil args) (warn 'null-argument))
(if (single args)
(/ 1 (first args))
(reduce #'/i args)))
;;; Put these into with-generalized numbers? ;;; Put these into with-generalized numbers?
(defmacro incf (ref &optional (delta 1)) (defmacro incf (ref &optional (delta 1))
......
;; Test math functions on numbers ;; Test math functions on numbers
;; Liam Healy 2010-12-24 13:54:53EST numbers.lisp ;; Liam Healy 2010-12-24 13:54:53EST numbers.lisp
;; Time-stamp: <2013-11-23 11:17:44EST numbers.lisp> ;; Time-stamp: <2014-01-05 12:15:20EST numbers.lisp>
;; Copyright 2011 Liam M. Healy ;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -24,36 +24,42 @@ ...@@ -24,36 +24,42 @@
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal
2.0d0 2.0d0
(+ 1.0d0 1.0d0)) (+ 1.0d0 1.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; addition 1 argument
1.0d0 1.0d0
(+ 1.0d0)) (+ 1.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; addition 2 arguments
-1.0d0
(+ 1.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal
0.0d0 0.0d0
(- 1.0d0 1.0d0)) (- 1.0d0 1.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; addition 3 arguments
-1.0d0
(+ 1.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal ; subtraction 1 argument
-1.0d0 -1.0d0
(- 1.0d0)) (- 1.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; subtraction 2 argument
2.0d0
(- 4.0d0 2.0d0))
(lisp-unit::assert-numerical-equal ; subtraction 3 arguments
3.0d0 3.0d0
(- 1.0d0 3.0d0 -5.0d0)) (- 1.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; multiplication 1 argument
2.0d0
(* 2.0d0))
(lisp-unit::assert-numerical-equal ; multiplication 2 arguments
-15.0d0 -15.0d0
(* 3.0d0 -5.0d0)) (* 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; multiplication 3 arguments
-30.0d0 -30.0d0
(* 2.0d0 3.0d0 -5.0d0)) (* 2.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal ; division 1 argument
2.0d0
(* 2.0d0))
(lisp-unit::assert-numerical-equal
0.5d0
(/ 1.0d0 2.0d0))
(lisp-unit::assert-numerical-equal
0.5d0 0.5d0
(/ 2.0d0)) (/ 2.0d0))
(lisp-unit::assert-numerical-equal ; division 2 arguments
0.5d0
(/ 1.0d0 2.0d0))
(lisp-unit::assert-numerical-equal ; division 3 arguments
0.1d0
(/ 2.0d0 4.0d0 5.0d0))
(lisp-unit::assert-numerical-equal (lisp-unit::assert-numerical-equal
2.0d0 2.0d0
(sqrt 4.0d0)) (sqrt 4.0d0))
......
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