[Maxima-commits] Maxima, A Computer Algebra System branch, master, updated. 743e880dfabdb7d146a7cee9b7946e78da27e2d3

[Barton W. <wil...@us...>]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Maxima, A Computer Algebra System".

The branch, master has been updated
       via  743e880dfabdb7d146a7cee9b7946e78da27e2d3 (commit)
      from  b9177b71f0f74be77279ff1ef6a15c9c459f10d7 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 743e880dfabdb7d146a7cee9b7946e78da27e2d3
Author: Barton Willis <wi...@un...>
Date:   Wed Jul 6 12:25:34 2011 -0500

    o new n-ary kron_delta function
    o new tex function for kron_delta expressions
    o new user documentation for kron_delta
    o additional tests for kron_delta (rtestnset.mac)

diff --git a/doc/info/nset.texi b/doc/info/nset.texi
index 93a8235..b43d8e5 100644
--- a/doc/info/nset.texi
+++ b/doc/info/nset.texi
@@ -1234,162 +1234,38 @@ Examples:
 
 @end deffn
 
-@deffn {Function} kron_delta (@var{x}, @var{y})
+@deffn {Function} kron_delta (@var{x1}, @var{x2}, ..., @var{xp})
 
 Represents the Kronecker delta function.
 
-@code{kron_delta} simplifies to 1 when @var{x} and @var{y} are identical or demonstrably equivalent,
-and it simplifies to 0 when @var{x} and @var{y} are demonstrably not equivalent.
-Otherwise,
-it is not certain whether @var{x} and @var{y} are equivalent,
-and @code{kron_delta} simplifies to a noun expression.
-@code{kron_delta} implements a cautious policy with respect to floating point expressions:
-if the difference @code{@var{x} - @var{y}} is a floating point number,
-@code{kron_delta} simplifies to a noun expression when @var{x} is apparently equivalent to @var{y}.
-
-Specifically,
-@code{kron_delta(@var{x}, @var{y})} simplifies to 1
-when @code{is(x = y)} is @code{true}.
-@code{kron_delta} also simplifies to 1
-when @code{sign(abs(@var{x} - @var{y}))} is @code{zero}
-and @code{@var{x} - @var{y}} is not a floating point number
-(neither an ordinary float nor a bigfloat).
-@code{kron_delta} simplifies to 0
-when @code{sign(abs(@var{x} - @var{y}))} is @code{pos}.
-
-Otherwise, @code{sign(abs(@var{x} - @var{y}))} is
-something other than @code{pos} or @code{zero},
-or it is @code{zero} and @code{@var{x} - @var{y}}
-is a floating point number.
-In these cases, @code{kron_delta} returns a noun expression.
-
-@code{kron_delta} is declared to be symmetric.
-That is,
-@code{kron_delta(@var{x}, @var{y})} is equal to @code{kron_delta(@var{y}, @var{x})}.
+@code{kron_delta} simplifies to 1 when @var{xi} and @var{yj} are equal
+for all pairs of arguements, and it simplifies to 0 when @var{xi} and
+@var{yj} are not equal for some pair of arguments. Equality is
+determined using @code{is(equal(xi,xj))} and inequality by
+@code{is(notequal(xi,xj))}.
 
 Examples:
 
-The arguments of @code{kron_delta} are identical.
-@code{kron_delta} simplifies to 1.
-
-@c ===beg===
-@c kron_delta (a, a);
-@c kron_delta (x^2 - y^2, x^2 - y^2);
-@c float (kron_delta (1/10, 0.1));
-@c ===end===
-@example
-(%i1) kron_delta (a, a);
-(%o1)                           1
-(%i2) kron_delta (x^2 - y^2, x^2 - y^2);
-(%o2)                           1
-(%i3) float (kron_delta (1/10, 0.1));
-(%o3)                           1
-@end example
-
-The arguments of @code{kron_delta} are equivalent,
-and their difference is not a floating point number.
-@code{kron_delta} simplifies to 1.
-
-@c ===beg===
-@c assume (equal (x, y));
-@c kron_delta (x, y);
-@c ===end===
-@example
-(%i1) assume (equal (x, y));
-(%o1)                     [equal(x, y)]
-(%i2) kron_delta (x, y);
-(%o2)                           1
-@end example
-
-The arguments of @code{kron_delta} are not equivalent.
-@code{kron_delta} simplifies to 0.
-
-@c ===beg===
-@c kron_delta (a + 1, a);
-@c assume (a > b)$
-@c kron_delta (a, b);
-@c kron_delta (1/5, 0.7);
-@c ===end===
-@example
-(%i1) kron_delta (a + 1, a);
-(%o1)                           0
-(%i2) assume (a > b)$
-(%i3) kron_delta (a, b);
-(%o3)                           0
-(%i4) kron_delta (1/5, 0.7);
-(%o4)                           0
-@end example
-
-The arguments of @code{kron_delta} might or might not be equivalent.
-@code{kron_delta} simplifies to a noun expression.
-
-@c ===beg===
-@c kron_delta (a, b);
-@c assume(x >= y)$
-@c kron_delta (x, y);
-@c ===end===
-@example
-(%i1) kron_delta (a, b);
-(%o1)                   kron_delta(a, b)
-(%i2) assume(x >= y)$
-(%i3) kron_delta (x, y);
-(%o3)                   kron_delta(x, y)
-@end example
-
-The arguments of @code{kron_delta} are equivalent,
-but their difference is a floating point number.
-@code{kron_delta} simplifies to a noun expression.
-
 @c ===beg===
-@c 1/4 - 0.25;
-@c 1/10 - 0.1;
-@c 0.25 - 0.25b0;
-@c kron_delta (1/4, 0.25);
-@c kron_delta (1/10, 0.1);
-@c kron_delta (0.25, 0.25b0);
+@c kron_delta(a,a);
+@c kron_delta(a,b,a,b);
+@c kron_delta(a,a,b,a+1);
+@c assume(equal(x,y));
+@c kron_delta(x,y);
 @c ===end===
 @example
-(%i1) 1/4 - 0.25;
-(%o1)                          0.0
-(%i2) 1/10 - 0.1;
-(%o2)                          0.0
-(%i3) 0.25 - 0.25b0;
-Warning:  Float to bigfloat conversion of 0.25
-(%o3)                         0.0b0
-(%i4) kron_delta (1/4, 0.25);
-                                  1
-(%o4)                  kron_delta(-, 0.25)
-                                  4
-(%i5) kron_delta (1/10, 0.1);
-                                  1
-(%o5)                  kron_delta(--, 0.1)
-                                  10
-(%i6) kron_delta (0.25, 0.25b0);
-Warning:  Float to bigfloat conversion of 0.25
-(%o6)               kron_delta(0.25, 2.5b-1)
+(%i1) kron_delta(a,a);
+(%o1)                                  1
+(%i2) kron_delta(a,b,a,b);
+(%o2)                          kron_delta(a, b)
+(%i3) kron_delta(a,a,b,a+1);
+(%o3)                                  0
+(%i4) assume(equal(x,y));
+(%o4)                            [equal(x, y)]
+(%i5) kron_delta(x,y);
+(%o5)                                  1
 @end example
 
-@code{kron_delta} is symmetric.
-
-@c ===beg===
-@c kron_delta (x, y);
-@c kron_delta (y, x);
-@c kron_delta (x, y) - kron_delta (y, x);
-@c is (equal (kron_delta (x, y), kron_delta (y, x)));
-@c is (kron_delta (x, y) = kron_delta (y, x));
-@c ===end===
-@example
-(%i1) kron_delta (x, y);
-(%o1)                   kron_delta(x, y)
-(%i2) kron_delta (y, x);
-(%o2)                   kron_delta(x, y)
-(%i3) kron_delta (x, y) - kron_delta (y, x);
-(%o3)                           0
-(%i4) is (equal (kron_delta (x, y), kron_delta (y, x)));
-(%o4)                         true
-(%i5) is (kron_delta (x, y) = kron_delta (y, x));
-(%o5)                         true
-@end example
 
 @end deffn
 
diff --git a/src/nset.lisp b/src/nset.lisp
index 671fb02..64fb6bc 100644
--- a/src/nset.lisp
+++ b/src/nset.lisp
@@ -849,43 +849,56 @@
 	(t (if lst `(($num_distinct_partitions simp) ,n ,lst) 
 	     `(($num_distinct_partitions simp) ,n)))))
 
-;; A Kronecker delta function.  kron_delta(p,q) evaluates to 1 if
-;; (like p q); when csign(|p-q|) is pos, return 0; when csign(|p-q|) 
-;; is zero and p and q aren't floats or bigfloats, return 1. 
-;; 0; otherwise, return the noun form. 
-
-(defprop $kron_delta simp-kron-delta operators)
-
-(eval-when
-    #+gcl (load eval)
-    #-gcl (:load-toplevel :execute)
-    ;; (kind '$kron_delta '$symmetric)) <-- This doesn't work. Why?
-    ;; Put new fact in global context; 
-    ;; otherwise it goes in initial context, which is meant for the user.
-    (let (($context '$global) (context '$global))
-      (meval* '(($declare) $kron_delta $symmetric))))
-		 	
-(defun simp-kron-delta (x y z)
-  (twoargcheck x)
-  (setq y (mapcar #'(lambda (s) (simplifya s z)) (margs x)))
-  (let ((p (nth 0 y))
-	(q (nth 1 y)))
-    (let ((sgn (meqp p q)))
-      (cond ((eq sgn t) 1)
-	    ((eq sgn nil) 0)
-	    (t `(($kron_delta simp) ,p ,q))))))
+;; A n-ary Kronecker delta function: kron_delta(n0,n1, ..., nk) simplifies to 1 if
+;; (meqp ni nj) is true for *all* pairs ni, nj in (n0,n1, ..., nk); it simplifies to 0 if
+;; (mnqp ni nj) is true for *some* pair ni, nj in (n0,n1, ..., nk). Further kron_delta() --> 1
+;; and kron_delta(xxx) --> wrong number of arguments error. Thus
+;;
+;;    kron_delta(x0,...,xn) * kron_delta(y0,..., ym) = kron_delta(x0, ..., xn, y0, ..., ym)
+;;
+;; is an identity.
+
+(defprop %kron_delta simp-kron-delta operators)
+(setf (get '$kron_delta 'noun) '%kron_delta)
+(setf (get '%kron_delta 'verb) '$kron_delta)
+(setf (get '$kron_delta 'alias) '%kron_delta)
+(setf (get '%kron_delta 'reversealias) '$kron_delta)
+(defun $kron_delta (x) (take '($kron_delta) x))
+(setf (get '%kron_delta 'real-valued) t) ;; conjugate(kron_delta(xxx)) --> kron_delta(xxx)
+(setf (get '%kron_delta 'integer-valued) t) ;; featurep(kron_delta(xxx), integer) --> true
+
+(putprop '%kron_delta #'(lambda (s) (setq sign '$pz)) 'sign-function)
+
+(defun simp-kron-delta (l y z)
+  (declare (ignore y))
+
+  (setq l (cdr l)) ;; remove (($kron_delta simp)
+  (if (and l (null (cdr l))) (wna-err '$knon_delta)) ;; wrong number of arguments error for exactly one argument
+
+  ;; Checking both mnqp and meqp is convenient, but unnecessary. This code misses simplifications that
+  ;; involve three or more arguments. Example: kron_delta(a,b,a+b+1,a-b+5) could (but doesn't) simplify 
+  ;; to 0 (the solution set (a = b, a = a+b+1, a=a-b+5) is empty.
+
+  (let ((acc nil) (return-zero nil))
+    (setq return-zero (catch 'done
+			(dolist (lk l) 
+			  (setq lk (simpcheck lk z))
+			  (cond ((some #'(lambda (s) (eq t (mnqp s lk))) acc) ;; lk # some member of acc, return zero.
+				 (throw 'done t))
+				((some #'(lambda (s) (eq t (meqp s lk))) acc)) ;; lk = some member of acc, do nothing
+				(t (push lk acc))));; push lk onto acc
+			nil)) ;; set return-zero to nil
+    (cond (return-zero 0)
+	  ((or (null acc) (null (cdr acc))) 1)
+	  (t  ;; reflection: kron_delta(-a,-b,...) == kron_delta(a,b,...).
+	   (let ((neg-acc (sort (mapcar #'neg acc) '$orderlessp)))
+	     (setq acc (sort acc '$orderlessp))
+	     `((%kron_delta simp) ,@(if (great (cons '(mlist) neg-acc) (cons '(mlist) acc)) neg-acc acc)))))))
 			
-(defprop $kron_delta tex-kron-delta tex)
+(defprop %kron_delta tex-kron-delta tex)
 
 (defun tex-kron-delta (x l r)
-  (setq x (mapcar #'(lambda (s) (tex s nil nil nil nil)) (cdr x)))
-  (append l 
-	  `("\\delta_{")
-	  (nth 0 x)
-	  `(",")
-	  (nth 1 x)
-	  `("}")
-	  r))
+  (append l `("\\delta_{" ,@(tex-list (cdr x) nil (list "} ") ", ")) r))
 
 ;; Stirling numbers of the first kind.
 
diff --git a/tests/rtestnset.mac b/tests/rtestnset.mac
index 089f8cb..caf0145 100644
--- a/tests/rtestnset.mac
+++ b/tests/rtestnset.mac
@@ -1236,6 +1236,55 @@ kron_delta(3 + %i/7,1 + %i/7);
 kron_delta(1 + %i/5,1 + %i/7);
 0$
 
+/* new kronecker delta tests for multivariable version */
+
+(map('forget, facts()),0);
+0$
+
+errcatch(kron_delta(x));
+[]$
+
+kron_delta();
+1$
+
+kron_delta(sqrt(2), 1/sqrt(2), %pi);
+0$
+
+kron_delta(a,b,a);
+kron_delta(a,b)$
+
+subst(a=c, kron_delta(a,b,rat(c)));
+kron_delta(c,b)$
+
+kron_delta(a,b)-kron_delta(-a,-b);
+0$
+
+kron_delta(a,-b)-kron_delta(-a,b);
+0$
+
+kron_delta(a,b,-c)-kron_delta(-a,-b,c);
+0$
+
+kron_delta(-a,b,-c)-kron_delta(a,-b,c);
+0$
+
+conjugate(kron_delta(a+%i,b,c));
+kron_delta(a+%i,b,c)$
+
+cabs(kron_delta(a,b,23 +%i));
+kron_delta(a,b,23 + %i)$
+
+abs(kron_delta(l,s,s));
+kron_delta(l,s)$
+
+sign(kron_delta(u,n,k,1));
+pz$
+
+featurep(kron_delta(a+%i, cos(x - %i), 42/19),'integer);
+true$
+
+/* end new kronecker delta tests */
+
 every(f,[]);
 true$
 

-----------------------------------------------------------------------

Summary of changes:
 doc/info/nset.texi  |  166 +++++++--------------------------------------------
 src/nset.lisp       |   81 ++++++++++++++-----------
 tests/rtestnset.mac |   49 +++++++++++++++
 3 files changed, 117 insertions(+), 179 deletions(-)


hooks/post-receive
-- 
Maxima, A Computer Algebra System