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...
parent 976244eb
;; Antik system definition
;; 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
;; Distributed under the terms of the GNU General Public License
......@@ -59,6 +59,7 @@
((:module tests
:components
((:file "augment")
(:file "sequence")
(:file "compose")
(:file "map")
(:file "slice")
......
;; Functions on grids
;; 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
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -228,51 +228,35 @@
(loop for ind from 0 below (total-size grid)
always (antik:zerop (aref* grid ind))))
(defmethod antik::+i ((a sequence) b) ; b is a scalar
(if (gridp b)
(call-next-method)
(map (type-of a) (lambda (x) (antik::+i x b)) a)))
(defmethod antik::+i (a (b sequence)) ; a is a scalar
(if (gridp a)
(call-next-method)
(map (type-of b) (lambda (x) (antik::+i a x)) b)))
(defmethod antik::-i ((a sequence) b) ; b is a scalar
(if (gridp b)
(call-next-method)
(map (type-of a) (lambda (x) (antik::-i x b)) a)))
(defmethod antik::-i (a (b sequence)) ; a is a scalar
(if (null b)
(antik::*i -1 a)
(if (gridp a)
(call-next-method)
(map (type-of b) (lambda (x) (antik::-i a x)) b))))
;; Scalar multiplication of sequences
(defmethod antik::*i ((a sequence) b) ; b is a scalar
(if (gridp b)
(call-next-method)
(map (type-of a) (lambda (x) (antik::*i x b)) a)))
(defmethod antik::*i (a (b sequence)) ; a is a scalar
(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)))
(defmacro sequence-map (operator scalar sequence sequence-first)
"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."
`(map (type-of ,sequence)
(,(if sequence-first 'alexandria:rcurry 'alexandria:curry)
(function ,operator)
,scalar)
,sequence))
(defmacro defmethods-dyadic-sequences (operator)
"Define defmethods for dyadic operators having at least one argument a sequence."
`(progn
(defmethod ,operator ((a sequence) b) ; b is a scalar
(if (gridp b)
(call-next-method)
(sequence-map ,operator b a t)))
(defmethod ,operator (a (b sequence)) ; a is a scalar
(if (gridp a)
(call-next-method)
(sequence-map ,operator a b nil)))
(defmethod ,operator ((a sequence) (b sequence)) ; both sequences
(assert (eq (length a) (length b)) (a b)
"Sequence arguments are not of the same length.")
;; apply elementwise
(map (type-of a) (function ,operator) a b))))
(defmethods-dyadic-sequences antik::+i)
(defmethods-dyadic-sequences antik::-i)
(defmethods-dyadic-sequences antik::*i)
(defmethods-dyadic-sequences antik::/i)
;;;;****************************************************************************
;;;; 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.
;; 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
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -42,7 +42,14 @@
((object :initarg :object :reader coerce-object))
(:report (lambda (condition stream)
(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)
((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
;; 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
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -20,12 +20,6 @@
(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
;;;;****************************************************************************
......@@ -72,70 +66,47 @@
;;; and the function will recurse infinitely.
(defgeneric +i (a b)
(:documentation "Addition of generalized or regular numbers.")
(:method ((a number) (b number))
(cl:+ a b))
(:method ((a sequence) (b sequence))
(map (type-of a) #'+i a b)))
(:method ((a number) (b number)) (cl:+ a b)))
(defun + (&rest args)
"Addition of generalized or regular numbers with an
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)
(:documentation
"Subtraction/negation of generalized or regular numbers, internal.
Users call -.")
(:method ((a number) (b number))
(cl:- a b))
(:method ((a sequence) (b sequence))
(if (null b)
(*i -1 a)
(map (type-of a) #'-i a b))))
(:method ((a number) (b number)) (cl:- a b)))
(defun - (&rest args)
"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)
(:documentation "Multiplication of generalized or regular numbers.")
;; Ordinary number multiplication
(: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)))))
(:method ((a number) (b number)) (cl:* a b)))
(defun * (&rest args)
"Multiplication of generalized or regular numbers with an
arbitrary number of arguments."
(when (member nil args) (warn 'null-argument))
(if (single args) (first args) (reduce #'*i args)))
(defgeneric /i (a b)
(:documentation "Division of generalized or regular numbers, internal.
Users call /.")
(:method ((a number) (b number))
(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))))
(:method ((a number) (b number)) (cl:/ a b)))
(defun / (&rest args)
"Division of generalized or regular numbers for an
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?
(defmacro incf (ref &optional (delta 1))
......
;; Test math functions on numbers
;; 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
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -24,36 +24,42 @@
(lisp-unit::assert-numerical-equal
2.0d0
(+ 1.0d0 1.0d0))
(lisp-unit::assert-numerical-equal
(lisp-unit::assert-numerical-equal ; addition 1 argument
1.0d0
(+ 1.0d0))
(lisp-unit::assert-numerical-equal
-1.0d0
(+ 1.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal
(lisp-unit::assert-numerical-equal ; addition 2 arguments
0.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))
(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
(- 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
(* 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal
(lisp-unit::assert-numerical-equal ; multiplication 3 arguments
-30.0d0
(* 2.0d0 3.0d0 -5.0d0))
(lisp-unit::assert-numerical-equal
2.0d0
(* 2.0d0))
(lisp-unit::assert-numerical-equal
0.5d0
(/ 1.0d0 2.0d0))
(lisp-unit::assert-numerical-equal
(lisp-unit::assert-numerical-equal ; division 1 argument
0.5d0
(/ 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
2.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