Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch master updated. branch-5_49-base-557-g8ccfb47b4
|
From: tomasriker <tom...@us...> - 2026-06-03 10:17:29
|
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 8ccfb47b479bcd135ee901916624479154eabeaa (commit)
via 1c86ba205e9937389ef99679026fad304e7ac161 (commit)
from f5b27223490fbbf0f96a7e2a80d9600fe5a42c37 (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 8ccfb47b479bcd135ee901916624479154eabeaa
Author: David Scherfgen <d.s...@go...>
Date: Wed Jun 3 12:14:24 2026 +0200
Introduce and use KIND-ANY-OF and KIND-ALL-OF-P
(KIND-ANY-OF X KINDS) avoids the repeated database access overhead caused by
(OR (KINDP X K1) (KINDP X K2) ...) constructs, where K1, K2, ... are mutually
exclusive kinds, e.g. '$EVEN and '$ODD. It resolves the query in a single
database pass. It returns the first kind found during traversal of X's kinds
that is a member of KINDS.
Similarly, (KIND-ALL-OF-P X KINDS) is a faster single-pass replacement for
(AND (KINDP X K1) (KINDP X K2) ...).
Refactored existing usage of KINDP to take advantage of these new functions,
in some cases significantly simplifying the code.
diff --git a/src/compar.lisp b/src/compar.lisp
index 0be22b6cc..4fddd039a 100644
--- a/src/compar.lisp
+++ b/src/compar.lisp
@@ -1349,6 +1349,7 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(list '$li #'(lambda (x)
(let ((z (first (margs x))) (n (cadadr x)))
(if (and (mnump n) (eq t (mgrp z 0)) (eq t (mgrp 1 z))) (sign z) (sign-any x)))))))
+
(defun sign (x)
(cond ((mnump x) (setq sign (rgrp x 0) minus nil odds nil evens nil))
((and *complexsign* (symbolp x) (eq x '$%i))
@@ -1364,9 +1365,12 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
((and (not (specrepp x)) ($subvarp (mop x)) (get (mop (mop x)) 'sign-function))
(funcall (get (mop (mop x)) 'sign-function) x))
((specrepp x) (sign (specdisrep x)))
- ((kindp (caar x) '$posfun) (sign-posfun x))
- ((kindp (caar x) '$oddfun) (sign-oddfun x))
- (t (sign-any x))))
+ (t
+ (let ((kind (kind-any-of (caar x) '($posfun $oddfun))))
+ (cond
+ ((eq kind '$posfun) (sign-posfun x))
+ ((eq kind '$oddfun) (sign-oddfun x))
+ (t (sign-any x)))))))
(defun sign-any (x)
(cond ((and *complexsign*
@@ -2074,10 +2078,11 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
evens nil))
(defun sign-oddfun (x)
- (cond ((kindp (caar x) '$increasing)
+ (let ((kind (kind-any-of (caar x) '($increasing $decreasing))))
+ (cond ((eq kind '$increasing)
; Take the sign of the argument
(sign (cadr x)))
- ((kindp (caar x) '$decreasing)
+ ((eq kind '$decreasing)
; Take the sign of negative of the argument
(sign (neg (cadr x))))
(t
@@ -2085,7 +2090,7 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
; the function value is the same). Otherwise, punt to SIGN-ANY.
(sign (cadr x))
(unless (eq sign '$zero)
- (sign-any x)))))
+ (sign-any x))))))
(defun imag-err (x)
(if sign-imag-errp
@@ -2210,11 +2215,7 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(kindp (caddr fact) '$integer))
(return t))
((eq mode 'evod)
- (cond ((kindp (caddr fact) '$odd)
- (return '$odd))
- ((kindp (caddr fact) '$even)
- (return '$even))
- (t (return nil))))
+ (kind-any-of (caddr fact) '($even $odd)))
(t (return nil))))
(t
(cond ((eq mode 'integer)
@@ -2230,11 +2231,7 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(kindp (cadr fact) '$integer))
(return t))
((eq mode 'evod)
- (cond ((kindp (cadr fact) '$odd)
- (return '$odd))
- ((kindp (cadr fact) '$even)
- (return '$even))
- (t (return nil))))
+ (kind-any-of (cadr fact) '($even $odd)))
(t (return nil))))
(t
(cond ((eq mode 'integer)
@@ -2295,11 +2292,10 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(defun evod (e)
(cond ((integerp e) (if (oddp e) '$odd '$even))
((mnump e) nil)
- ((atom e)
- (cond ((kindp e '$odd) '$odd)
- ((kindp e '$even) '$even)
- ;; Check the database for facts.
- ((symbolp e) (check-integer-facts e 'evod))))
+ ((symbolp e)
+ (or (kind-any-of e '($even $odd))
+ ;; Check the database for facts.
+ (check-integer-facts e 'evod)))
((eq 'mtimes (caar e)) (evod-mtimes e))
((eq 'mplus (caar e)) (evod-mplus e))
((eq 'mabs (caar e)) (evod (cadr e))) ;; extra code
@@ -2526,8 +2522,7 @@ TDNEG TDZERO TDPN) to store it, and also sets SIGN."
(if (and (equal rhs 0)
(or (mexptp lhs)
(and (not (atom lhs))
- (kindp (caar lhs) '$oddfun)
- (kindp (caar lhs) '$increasing))))
+ (kind-all-of-p (caar lhs) '($oddfun $increasing)))))
(setq lhs (cadr lhs)))
(values lhs rhs)))
diff --git a/src/db.lisp b/src/db.lisp
index 1ed18b459..c80683b92 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -411,6 +411,40 @@
(return t)
(mark+ p (+labs p))))))
+(defun kind-any-of (x kinds)
+ "Looks up the kind information on symbol X and returns the first kind that is
+ encountered that is a member of KINDS. The order of symbols in KINDS doesn't
+ affect the result. This function should only be used for mutually exclusive
+ kinds, e.g. '$EVEN and '$ODD. Returns NIL if no matching kind is found.
+ This is faster than (OR (KINDP X K1) (KINDP X K2) ...), since it only requires
+ a single database query."
+ (when (and (symbolp x) (get x 'data))
+ (clear)
+ (beg x 1)
+ (do ((p (dq+) (dq+)))
+ ((null p))
+ (let ((k (member p kinds :test #'eq)))
+ (if k
+ (return (car k))
+ (mark+ p (+labs p)))))))
+
+(defun kind-all-of-p (x kinds)
+ "Returns T iff (KINDP X K) would return T for all K in KINDS. This is faster
+ than (AND (KINDP X K1) (KINDP X K2) ...), since it only requires a single
+ database query. The implementation relies on counting matching kinds, therefore
+ KINDS should not contain repeated items."
+ (let ((remaining (length kinds)))
+ (when (and (symbolp x) (get x 'data))
+ (clear)
+ (beg x 1)
+ (do ((p (dq+) (dq+)))
+ ((or (null p)
+ (zerop remaining)))
+ (when (member p kinds :test #'eq)
+ (decf remaining))
+ (mark+ p (+labs p))))
+ (zerop remaining)))
+
(defun true* (pat)
(let ((dum (semant pat)))
(if dum
commit 1c86ba205e9937389ef99679026fad304e7ac161
Author: David Scherfgen <d.s...@go...>
Date: Wed Jun 3 11:11:34 2026 +0200
Make some of my previous tests more elegant and more verbose in case of failure
diff --git a/tests/rtest_integrate.mac b/tests/rtest_integrate.mac
index 64eb23f72..9c8ca9141 100644
--- a/tests/rtest_integrate.mac
+++ b/tests/rtest_integrate.mac
@@ -6350,26 +6350,20 @@ forget(x > 0, x < 1);
/* Bug #4037: "Error in symbolic integral" */
/* Test that the antiderivatives of a whole family of functions are correct. */
/* Certain cases are left out because they print "CQUOTIENT: quotient is not exact" errors. */
-map(
- lambda([e],
- block([f, u],
- f : x^e[1]*log(x)^e[2]/(1+x^e[3]),
- u : integrate(f, x),
- freeof('integrate, u) and zeroequiv(diff(u, x) - f, x) = true
- )
- ),
+sublist(
[[1,1,1],[1,1,2],[1,1,4],[1,2,1],[1,2,2],[1,2,4],[1,3,1],[1,3,2],[1,4,1],
[1,4,2],[1,5,1],[1,5,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2],[2,3,1],[2,3,2],
[2,4,1],[2,4,2],[2,5,1],[2,5,2],[3,1,1],[3,1,2],[3,1,4],[3,2,1],[3,2,2],
[3,2,4],[3,3,1],[3,3,2],[3,3,4],[3,4,1],[3,4,2],[3,4,4],[3,5,1],[3,5,2],
[3,5,4],[4,1,1],[4,1,2],[4,1,5],[4,2,1],[4,2,2],[4,2,5],[4,3,1],[4,3,2],
[4,3,5],[4,4,1],[4,4,2],[4,4,5],[4,5,1],[4,5,2],[4,5,5],[5,1,1],[5,1,2],
- [5,1,4],[5,2,1],[5,2,2],[5,3,1],[5,3,2],[5,4,1],[5,4,2],[5,5,1],[5,5,2]]
+ [5,1,4],[5,2,1],[5,2,2],[5,3,1],[5,3,2],[5,4,1],[5,4,2],[5,5,1],[5,5,2]],
+ lambda([e],
+ block([f, u],
+ f : x^e[1]*log(x)^e[2]/(1+x^e[3]),
+ u : integrate(f, x),
+ not freeof('integrate, u) or zeroequiv(diff(u, x) - f, x) # true
+ )
+ )
);
-[true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true];
+[];
diff --git a/tests/rtest_numth.mac b/tests/rtest_numth.mac
index 671a6fd6c..bf6a4d2cd 100644
--- a/tests/rtest_numth.mac
+++ b/tests/rtest_numth.mac
@@ -811,14 +811,6 @@ gcfactor (%i / 2);
*/
/* Bug #4623: "gcfactor(4), expand(%%) => -4" */
-
-create_list(is(a + %i * b = expand(gcfactor(a + %i * b))), a, makelist(i, i, -4, 4), b, makelist(i, i, -4, 4));
-[true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true,
- true, true, true, true, true, true, true, true, true];
+sublist(create_list([r, i], r, makelist(r, r, -4, 4), i, makelist(i, i, -4, 4)),
+ lambda([ri], ri[1] + %i * ri[2] # expand(gcfactor(ri[1] + %i * ri[2]))));
+[];
-----------------------------------------------------------------------
Summary of changes:
src/compar.lisp | 41 ++++++++++++++++++-----------------------
src/db.lisp | 34 ++++++++++++++++++++++++++++++++++
tests/rtest_integrate.mac | 26 ++++++++++----------------
tests/rtest_numth.mac | 14 +++-----------
4 files changed, 65 insertions(+), 50 deletions(-)
hooks/post-receive
--
Maxima CAS
|
