Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_48-base-325-ga77814ea2
|
From: willisbl <wil...@us...> - 2025-12-12 16:36:15
|
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 CAS".
The branch, master has been updated
via a77814ea29d6693bdf7b704c824dbfb8ebeb4dd2 (commit)
from e6095d9c76d3dda5adfb3ca42aea303ce67892ed (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 a77814ea29d6693bdf7b704c824dbfb8ebeb4dd2
Author: Barton Willis <wi...@un...>
Date: Fri Dec 12 10:35:59 2025 -0600
#4648 autoload problem with hstep
#4646 minor hstep problems and missing features
- Move hstep package from /share to /src and remove autoload code from max_ext.lisp (fixes #4648).
- Add antiderivative support to hstep.lisp.
- Add sign function for hstep.
- Change csign to $csign (fixes part of #4646).
- Convert hstep simplifier to def-simplifier scheme.
- Set `preserve-direction` locally to true in hstep limit code; add cases for zerob and zeroa limits.
- Append hstep.lisp to maxima.system.
- Add regression test rtest_hstep.mac to testsuite.lisp.
Testsuite: No unexpected failures with SBCL 2.4.7 or Clozure CL 1.13.
diff --git a/share/diffequations/hstep.lisp b/share/diffequations/hstep.lisp
deleted file mode 100644
index d7f91cdd0..000000000
--- a/share/diffequations/hstep.lisp
+++ /dev/null
@@ -1,77 +0,0 @@
-;;
-;; Copyright (C) 2010, 2011 Mark H. Weaver <mh...@ne...>
-;;
-;; hstep: Heaviside step function support for Maxima
-;;
-;; 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 2
-;; 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, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-;;
-
-(in-package :maxima)
-
-($put '$hstep 1 '$version)
-
-(defprop $hstep %hstep verb)
-(defprop %hstep $hstep noun)
-
-(defprop $hstep %hstep alias)
-(defprop %hstep $hstep reversealias)
-
-(defprop %hstep simp-hstep operators)
-(setf (get '%hstep 'simplim%function) 'simplim%hstep)
-
-(setf (get '%hstep 'real-valued) t)
-
-;; TODO: other properties which would be nice to declare about hstep:
-;; non-negative
-;; non-decreasing
-
-(defprop %hstep ((x) (($delta) x)) grad)
-(defprop $delta ((x) ((%hstep) x)) integral)
-
-(defun $hstep (z) (take '(%hstep) z))
-
-;;
-;; TODO: should the following rule be included somehow?
-;;
-;; hstep(-x) --> 1 - hstep(x)
-;;
-;; It would also be nice to simplify products
-;; containing more than one hstep.
-;;
-(defun simp-hstep (expr z simpflag)
- (oneargcheck expr)
- (setq z (simpcheck (cadr expr) simpflag))
- (let ((sgn (csign z)))
- (cond ((eq sgn '$neg) 0)
- ((eq sgn '$zero) 1//2)
- ((eq sgn '$pos) 1)
- (t
- ;; positive * x --> x and negative * x --> -1 * x.
- (if (mtimesp z)
- (setq z (muln (mapcar #'(lambda (s)
- (let ((sgn (csign s)))
- (cond ((eq sgn '$neg) -1)
- ((eq sgn '$pos) 1)
- (t s))))
- (margs z))
- t)))
- (eqtest (list '(%hstep) z) expr)))))
-
-(defun simplim%hstep (e x pt)
- (let* ((e (limit (cadr e) x pt 'think))
- (sgn (mnqp e 0)))
- (cond ((eq t sgn) ($hstep e)) ;; limit of arg is not zero
- ((eq nil sgn) '$und) ;; limit of arg is zero
- (t (throw 'limit nil))))) ;; don't know
diff --git a/src/hstep.lisp b/src/hstep.lisp
new file mode 100644
index 000000000..d70c16654
--- /dev/null
+++ b/src/hstep.lisp
@@ -0,0 +1,104 @@
+;;
+;; Copyright (C) 2010, 2011 Mark H. Weaver <mh...@ne...>
+;;
+;; hstep: Heaviside step function support for Maxima
+;;
+;; 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 2
+;; 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, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;;
+
+(in-package :maxima)
+
+($put '$hstep 1 '$version)
+
+(setf (get '%hstep 'simplim%function) 'simplim%hstep)
+
+(setf (get '%hstep 'real-valued) t)
+
+;; TODO: other properties which would be nice to declare about hstep:
+;; non-negative
+;; non-decreasing
+;; But neither of these are established Maxima features. Also, it would also
+;; be nice to simplify products containing more than one hstep, but that is
+;; a simplification on products, not on hstep.
+
+(defprop %hstep ((x) (($delta) x)) grad)
+(defprop $delta ((x) ((%hstep) x)) integral)
+
+;; Unlike `signum`, we do not extend hstep to the complex plane. Maxima defines hstep(0) = 1/2,
+;; but the DLMF (http://dlmf.nist.gov/1.16.iv) defines hstep(0) = 0.
+(def-simplifier hstep (z)
+ "Simplify `hstep(z)`. "
+ (flet ((fn (s)
+ (let ((sgn ($csign s)))
+ (cond ((eq sgn '$neg) -1)
+ ((eq sgn '$pos) 1)
+ (t s)))))
+ ;; When z is a product, replace all negative terms by -1 and all positive terms by 1.
+ ;; We could replace all zero terms by 0, but this could cause some indeterminate products
+ ;; to simplify to zero.
+ (when (mtimesp z)
+ (setq z (fapply 'mtimes (mapcar #'fn (cdr z)))))
+ (let ((sgn ($csign z)))
+ (cond ((eq sgn '$neg) 0) ; hstep(neg) = 0
+ ((eq sgn '$zero) 1//2) ; hstep(zero) = 1/2
+ ((eq sgn '$pos) 1) ; hstep(pos) = 1
+ ((great (neg z) z) ; hstep(-z) = 1 - hstep(z)
+ (sub 1 (ftake '%hstep (neg z))))
+ (t (give-up)))))) ;no simplifications
+
+(defun simplim%hstep (e x pt)
+ "Return limit(e,x,pt), where e = hstep(X)."
+ (let* ((preserve-direction t)
+ (lim (limit (cadr e) x pt 'think))
+ (sgn (mnqp lim 0)))
+ (cond
+ ((eq lim '$zerob) 0) ;hstep(zerob) = 0
+ ((eq lim '$zeroa) 1) ;hstep(zeroa) = 1
+ ((eq t sgn) (ftake '%hstep lim)) ;; limit of arg is not zero, so use direct substitution
+ ((eq nil sgn) '$und) ;; limit of arg is zero; limit doesn't exist
+ (t (throw 'limit nil))))) ;; don't know
+
+;; Give hstep an antiderivative
+(defun hstep-integral (x)
+ "Return an antiderivative of hstep. Specifically: integrate(hstep(x),x) = x*hstep(x)."
+ (mul x (ftake '%hstep x)))
+
+(putprop '%hstep `((x) ,'hstep-integral) 'integral)
+
+;; A sign function for hstep.
+;; When either x < 0 or x > 0, hstep (x) simplifies, so the value of sgn should never be neg or pos.
+(defun hstep-sign (q)
+ (let ((sgn ($csign (cadr q))))
+ (setf sign
+ (cond
+ ;; sign(hstep(zero)) = pos
+ ((eq sgn '$zero) '$pos)
+ ;; sign(hstep(positive or zero)) = positive
+ ((or (eq sgn '$pos) (eq sgn '$pz)) '$pos)
+ ;; sign(hstep(negative)) = zero
+ ((eq sgn '$neg) '$zero)
+ ;; sign(hstep(negative or zero)) = pz
+ ((eq sgn '$nz) '$pz)
+ ;; sign(hstep(pnz)) = pz
+ ((eq sgn '$pnz) '$pz)
+ ;; sign(hstep(pn)) = pz
+ ((eq sgn '$pn) '$pz)
+ ;; Maxima is inconsistent with the sign of something that is undefined. We'll throw a merror.
+ (*complexsign*
+ (merror (intl:gettext "The csign of ~M is undefined ~%") q))
+ (t
+ (merror (intl:gettext "The sign of ~M is undefined ~%") q))))))
+
+(setf (get '%hstep 'sign-function) 'hstep-sign)
\ No newline at end of file
diff --git a/src/max_ext.lisp b/src/max_ext.lisp
index f3437b269..37531b450 100644
--- a/src/max_ext.lisp
+++ b/src/max_ext.lisp
@@ -406,6 +406,5 @@
(setf (get f 'autoload) "tocl"))
(dolist (f
- '($hstep
- $pwilt))
+ '($pwilt))
(setf (get f 'autoload) "pwilt"))
diff --git a/src/maxima.system b/src/maxima.system
index e9e02f817..2225c12db 100644
--- a/src/maxima.system
+++ b/src/maxima.system
@@ -749,6 +749,7 @@
(:file "conjugate")
(:file "expintegral")
(:file "gamma")
+ (:file "hstep")
(:file "mstuff")))
(:module polynomial :source-pathname ""
:depends-on ("defmfun")
diff --git a/src/testsuite.lisp b/src/testsuite.lisp
index 72b4a79c5..e27003b83 100644
--- a/src/testsuite.lisp
+++ b/src/testsuite.lisp
@@ -152,6 +152,7 @@
((mlist simp) "rtest_atan2" ((mlist simp) 65))
"rtest_gcd"
+ ((mlist simp) "rtest_hstep")
;; The tests that failed with abcl 1.5.0
((mlist simp) "rtest_hg"
#+(or gcl abcl) ((mlist simp) 120)
diff --git a/tests/rtest_hstep.mac b/tests/rtest_hstep.mac
new file mode 100644
index 000000000..935f4dd94
--- /dev/null
+++ b/tests/rtest_hstep.mac
@@ -0,0 +1,210 @@
+/* Basic values */
+
+'hstep(0);
+1/2$
+
+'hstep(20252);
+1$
+
+'hstep(-20252);
+0$
+
+hstep(-5);
+0$
+
+hstep(0);
+1/2$
+
+hstep(3);
+1$
+
+hstep(-1e-10);
+0$
+
+hstep(1e-10);
+1$
+
+hstep(2.0^(-1021));
+1$
+
+hstep(exp(x));
+1$
+
+/* Reflection property */
+hstep(-2) + hstep(2);
+1$
+
+hstep(-3);
+0$
+
+hstep(-10);
+0$
+
+/* symbolic reflection */
+hstep(-x);
+1 - hstep(x)$
+
+/* simplifications */
+hstep((1+x^2)*q);
+hstep(q)$
+
+hstep(20252 * b);
+hstep(b)$
+
+hstep(28*(a+b));
+hstep(a+b)$
+
+hstep(-28*(a+b));
+1-hstep(a+b)$
+
+/* compositions with hstep */
+realpart(hstep(x));
+hstep(x)$
+
+imagpart(hstep(x));
+0$
+
+abs(hstep(x));
+hstep(x)$
+
+conjugate(hstep(x));
+hstep(x)$
+
+/* Integrals */
+integrate(hstep(x), x);
+x*hstep(x)$
+
+integrate(hstep(x), x, -1, 1);
+1$
+
+integrate(hstep(x), x, -2, 2);
+2$
+
+integrate(hstep(x), x, -5, 5);
+5$
+
+integrate(hstep(x), x, 0, 3);
+3$
+
+integrate(hstep(x), x, -3, 0);
+0$
+
+integrate(hstep(x), x, -3, -1);
+0$
+
+integrate(hstep(x), x, 1, 4);
+3$
+
+integrate(hstep(x), x, -10, 10);
+10$
+
+integrate(hstep(-x), x, -2, 2);
+2$ /* reflection integral */
+
+integrate(hstep(x-1), x, 0, 3);
+2$
+
+integrate(hstep(2-x), x, 0, 5);
+2$
+
+integrate(hstep(x) + hstep(-x), x, -2, 2);
+4$
+
+/* Limits at zero */
+limit(hstep(x), x, 0, minus);
+0$
+
+limit(hstep(x), x, 0, plus);
+1$
+
+limit(hstep(x), x, 0);
+ind$
+
+/* Limits at infinity */
+limit(hstep(x), x, inf);
+1$
+
+limit(hstep(x), x, minf);
+0$
+
+/* Shifted step function */
+limit(hstep(x-2), x, 2, minus);
+0$
+
+limit(hstep(x-2), x, 2, plus);
+1$
+
+limit(hstep(x+3), x, -3, minus);
+0$
+
+limit(hstep(x+3), x, -3, plus);
+1$
+
+/* Symmetry check with reflection */
+limit(hstep(-x), x, 0, minus);
+1$
+
+limit(hstep(-x), x, 0, plus);
+0$
+
+limit(hstep(1/x),x,0);
+ind$
+
+limit(hstep(x) * cos(x),x,0);
+ind$
+
+limit(hstep(x) * cos(x),x,0,plus);
+1$
+
+limit(hstep(x) * cos(x),x,0,minus);
+0$
+
+/* sign of hstep */
+sign(hstep(x));
+pz$
+
+sign(hstep(x) + 8);
+pos$
+
+block([ans],
+ assume(x >=0),
+ ans : sign(hstep(x)),
+ forget(x >=0),
+ ans);
+pos$
+
+block([ans],
+ assume(x <= 0),
+ ans : sign(hstep(x)),
+ forget(x <= 0),
+ ans);
+pz$
+
+/* \#4646 minor hstep problems and missing features */
+hstep(x^2+1);
+1$
+
+block([ans],
+ declare(z,complex),
+ ans : hstep(z^2+1),
+ remove(z,complex),
+ [inpart(ans,0), inpart(ans,1)]);
+[hstep, z^2+1]$
+
+errcatch(sign(hstep(1-%i)));
+[]$
+
+errcatch(csign(hstep(1-%i)));
+[]$
+
+hstep(exp(z));
+1$
+
+block([ans],
+ declare(z,complex),
+ ans : hstep(exp(z)),
+ remove(z,complex),
+ [inpart(ans,0), inpart(ans,1)]);
+[hstep,%e^z]$
+
+
-----------------------------------------------------------------------
Summary of changes:
share/diffequations/hstep.lisp | 77 ---------------
src/hstep.lisp | 104 ++++++++++++++++++++
src/max_ext.lisp | 3 +-
src/maxima.system | 1 +
src/testsuite.lisp | 1 +
tests/rtest_hstep.mac | 210 +++++++++++++++++++++++++++++++++++++++++
6 files changed, 317 insertions(+), 79 deletions(-)
delete mode 100644 share/diffequations/hstep.lisp
create mode 100644 src/hstep.lisp
create mode 100644 tests/rtest_hstep.mac
hooks/post-receive
--
Maxima CAS
|
