[Maxima-commits] CVS: maxima/share/contrib/integration abs_integrate.mac, 1.24, 1.25 rtest_abs_integrate.mac, 1.21, 1.22

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

Update of /cvsroot/maxima/maxima/share/contrib/integration
In directory sfp-cvsdas-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27455

Modified Files:
	abs_integrate.mac rtest_abs_integrate.mac 
Log Message:
o somewhat generalized abs_defint function
o additional regression tests

Index: abs_integrate.mac
===================================================================
RCS file: /cvsroot/maxima/maxima/share/contrib/integration/abs_integrate.mac,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- abs_integrate.mac	21 Jan 2010 11:36:15 -0000	1.24
+++ abs_integrate.mac	31 Jan 2010 21:20:41 -0000	1.25
@@ -21,7 +21,7 @@
 load("to_poly_solve_extra");
 load("partition");
 
-matchdeclare(x, symbolp, q, true, [a,b], lambda([s], numberp(s) or is(s = 'minf) or is(s = 'inf)));
+matchdeclare(x, symbolp, [q,a,b], lambda([s], true));
 block([simp : false], tellsimpafter('integrate(q,x), extra_integrate(q,x)),
 	     	      tellsimpafter('integrate(q,x,a,b), extra_definite_integrate(q,x,a,b)));
 
@@ -49,7 +49,7 @@
 
 /* The conditional gradefs work OK, but they complicate testing and they can generate messy expressions. */
 /* gradef(signum(x),%if(x # 0, 0, 'und)); */
-gradef(signum(x),0);
+gradef(signum(x),0); 
 
 /* gradef(abs(x), %if(x # 0, abs(x) / x, 'und)); */
 gradef(abs(x), abs(x) / x);
@@ -76,14 +76,15 @@
 /* Do signum(a) * signum(b) --> signum(a * b). Maybe it should, but when n is a positive integer,
    apply_signum_mult doesn't do signum(a)^n --> signum(a^n).*/
    
-apply_signum_mult_id (e) := block([p : 1, q : 1, inflag : true],
- if mapatom(e) then e
- else if (safe_op(e) = "*") then (
-   for ek in e do (
-     if (safe_op(ek) = 'signum) then p : p * first(ek) else q : q * ek),
-   signum(p) * q)
- else map('apply_signum_mult_id, e));
 
+apply_signum_mult_id (e) :=
+  subst(["*" = lambda([[x]], block([p : [], q : []],
+        for xk in x do (
+          if safe_op(xk) = 'signum then p : cons(first(xk),p) else q : cons(xk,q)),
+	p : xreduce("*",p),
+        q : xreduce("*",q),
+        q * signum(p)))],e);
+ 
 /* Do unit_step(a) * unit_step(b) --> unit_step(min(a,b)). This is an identity
 for either a left or right continuous unit_step. */
 
@@ -173,28 +174,31 @@
   xo : first(l),
   l : rest(l),
   for xi in l do (
-    i : errcatch(integrate(e,x,xo,xi)),
+    i : errcatch(integrate(simp_assuming(e,xo < x, x < xi, xo < xi),x,xo,xi)),
     if i = [ ] then return(acc : false) else acc : acc + first(i),
     xo : xi),
   acc);
 
-abs_defint(e,x,lo,hi) := block([l, knots, noun_int : nounify('integrate), f, es : e],
-  if (numberp(lo) or lo = 'minf or hi = 'inf) and (numberp(hi) or hi = 'minf or hi = 'inf) then (
-    if (hi < lo) then abs_defint(-es,x,hi,lo)
-    else if (lo = hi) then 0
-    else (
-      e : convert_to_signum(e),
-      l : flatten(gatherargs(e, 'signum)),
-      knots : flatten(map(lambda([s], real_linear_factors(s,x)), l)),
-      if every('numberp, knots) then (
-        knots : listify(setify(knots)),
-        knots : sublist(knots, lambda([s], is(s > lo) and is(s < hi))),
-        knots : append([lo, hi], knots),
-        f : dint(e,x, sort(knots, lambda([a,b], is(compare(a,b) = "<")))),
-        if f = false then funmake(noun_int,[es,x,lo,hi]) else f)
-      else funmake(noun_int,[es,x,lo,hi])))
-  else funmake(noun_int,[es,x,lo,hi]));
+partitions_interval_p(l,[endpts]) := (
+  if listp(l) then (
+    l : listify(setify(append(endpts, l))),
+    l : sort(l, lambda([a,b], is(a < b) = true)),
+    if every(lambda([a,b], is(a <= b)=true), l, endcons('inf, rest(l))) then l else false)
+  else false);
 
+abs_defint(e,x,lo,hi) := block([f,l],
+  if is(hi < lo)=true then -abs_defint(e,x,hi,lo)
+  else if is(lo = hi) then 0
+  else (
+    e : convert_to_signum(e),
+    l : xreduce('append, (gatherargs(e, 'signum))),
+    l : flatten(map(lambda([s], real_linear_factors(s,x)), l)), /* flatten([[1], false]) --> [1,false] */
+    l : partitions_interval_p(l,lo,hi),
+    if l # false then (
+      f : dint(e,x,l),
+      if f = false then false else f)
+    else false));
+ 
 /* The idea that of using a macro is due to Stavros Macrakis; the use of buildq is due to Robert Dodier.*/
 
 simp_assuming(e, [fcts]) ::= 
@@ -239,8 +243,8 @@
     %x : make_dummy(q,x),
     q : sublis([x = %x],q),
     k : listify(setify(k)),
-    k : sort(k, lambda([a,b], is(compare(a,b) = "<"))),
-    q : errcatch(interval_integrate(q,%x,k)),
+    k : partitions_interval_p(k),
+    q : if k # false then errcatch(interval_integrate(q,%x,k)) else [],
     if q = [] then false else subst(%x = x, first(q)))
   else false);
 

Index: rtest_abs_integrate.mac
===================================================================
RCS file: /cvsroot/maxima/maxima/share/contrib/integration/rtest_abs_integrate.mac,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- rtest_abs_integrate.mac	21 Jan 2010 11:36:15 -0000	1.21
+++ rtest_abs_integrate.mac	31 Jan 2010 21:20:42 -0000	1.22
@@ -383,6 +383,27 @@
 hyper_int(4 * (1-x^3)^(1/3),x);
 hypergeometric([2/3,4/3],[7/3],-((x-1)*(x^2+x+1))) *(x-1)*(x^2+x+1)*(1-x^3)^(1/3)$
 
+integrate(exp(-x) * (signum(x-a) + 1),x,minf,inf);
+2 * exp(-a)$
+
+(assume(0 < a, a < 1),0);
+0$
+
+integrate(1/(1+abs(x)),x,-a,a);
+log(a+1)-log(1-a)$
+
+(forget(0 < a, a < 1),0);
+0$
+
+integrate(1/ (1 + max(x^2,x)),x,-1,1);
+log(2)+%pi/4$
+
+integrate(x/ (1 + max(x^2,1)^2),x,minf,inf);
+0$
+
+integrate(x/ (1 + max(x^2,1)^2),x,0,inf);
+%pi/8$
+
 (print("time = ", elapsed_real_time () - start), is(elapsed_real_time () - start < 130));
 true$