Thanks for your announcement. I have a few questions and comments:
1500 rules for indefinite integration amount to 2.5 times the number
implemented in Derive 6.10. A large part of the new rules probably
involve special functions unknown to the Derive kernel, like exponential
integrals, sine and cosine integrals, Fresnel integrals, the Lambert W
function, elliptic integrals, polylogarithms, incomplete gamma
functions, and perhaps even general hypergeometric functions. But there
seem to be additions in the original Derive area of elementary functions
as well (Derive 6.10 knows about ERF, DIGAMMA, DILOG, and Hurwitz ZETA
only).
Does this imply that Rubi can do more elementary antiderivatives than
Derive 6.10 can? That would require that the Rubi tries about as many
integrand transformations, including various substitutions, partial
fraction decomposition and integration by parts, as Derive 6.10 does.
For example, Derive succeeds on INT(x*(x^2+3)/(2*a^2+b^2*(x^2+1))^
(5/2)*LN((SQRT(2)*x*SQRT(2*a^2+b^2*(x^2+1))-2*x*a+b*(x^2+1))/x),x), but
the task is obviously hard - and Derive's answer is characteristically
incomplete. Does Rubi do better on this one?
Derive 6.10 can do INT(1/SQRT(1-a*x),x), of course, but produces an
incorrect result for the equivalent INT((LN(a*x-1)-2*LN(-SQRT(a*x-1)))/
(2*pi*SQRT(a*x-1)),x), as a graphic comparison of the antiderivatives
will show. Has this bug been repaired in Rubi?
In my feeling, the choice to base Rubi on Mathematica may seriously
impede a pedagogical mission. What capabilities of MMA are actually used
in the implementation of Rubi? How many man-years would it take to move
Rubi to a freely available programming language like LISP or Python?
Martin.
I wonder why Rubi fails here. Integration by parts produces an algebraic
integrand containing SQRT(b^2*x^2 + 2*a^2 + b^2) and no other root.
Derive 6.10 discovers this route, but then does not fully succeed on the
algebraic problem. Yet this algebraic integral would obviously yield to
one of Euler's substitutions, for example. In particular, Derive's
result contains the following three unevaluated integrals:
INT(SQRT(b^2*x^2+2*a^2+b^2)/(b^3*x^4+4*a*b^2*x^3+2*a^2*b*x^2+4*a~
*x*(2*a^2+b^2)-b*(2*a^2+b^2)),x)
INT(SQRT(b^2*x^2+2*a^2+b^2)/(b^3*x^6+4*a*b^2*x^5+b*x^4*(2*a^2+b^~
2)+8*a*x^3*(a^2+b^2)-b^3*x^2+4*a*x*(2*a^2+b^2)-b*(2*a^2+b^2)),x)
INT(x/((b^2*x^2+2*a^2+b^2)*((b*x^2-2*a*x+b)*SQRT(b^2*x^2+2*a^2+b~
^2)+SQRT(2)*b^2*x^3+SQRT(2)*x*(2*a^2+b^2))),x)
However, Derive can evaluate these too, once they are rewritten as:
INT(SQRT(b^2*x^2+2*a^2+b^2)*(-a*b^2*x/((9*a^4+6*a^2*b^2+b^4)*(b^~
2*x^2+2*a^2+b^2))-b*(a^2+b^2)/(2*(9*a^4+6*a^2*b^2+b^4)*(b^2*x^2+~
2*a^2+b^2))+a*b*x/((9*a^4+6*a^2*b^2+b^4)*(b*x^2+4*a*x-b))+(9*a^2~
+b^2)/(2*(9*a^4+6*a^2*b^2+b^4)*(b*x^2+4*a*x-b))),x)
INT(SQRT(b^2*x^2+2*a^2+b^2)*(b^4*x/(2*a*(9*a^4+6*a^2*b^2+b^4)*(b~
^2*x^2+2*a^2+b^2))+b^3*(a^2+b^2)/(4*a^2*(9*a^4+6*a^2*b^2+b^4)*(b~
^2*x^2+2*a^2+b^2))+a*b*x*(9*a^2+2*b^2)/(2*(4*a^2+b^2)*(9*a^4+6*a~
^2*b^2+b^4)*(b*x^2+4*a*x-b))+(72*a^4+21*a^2*b^2+b^4)/(4*(4*a^2+b~
^2)*(9*a^4+6*a^2*b^2+b^4)*(b*x^2+4*a*x-b))-x/(2*a*(x^2+1)*(4*a^2~
+b^2))-b/(4*a^2*(x^2+1)*(4*a^2+b^2))),x)
INT((SQRT(b^2*x^2+2*a^2+b^2)-SQRT(2)*x)*(b*x*(a^2+1)*(b^2-2)^2/(~
4*(2*a^2+b^2)*(a^4*(3*b^2-4)+a^2*b^4+b^2)*(x^2*(b^2-2)+2*a^2+b^2~
))+a*(b^2-2)^2/(4*(a^4*(3*b^2-4)+a^2*b^4+b^2)*(x^2*(b^2-2)+2*a^2~
+b^2))-b^3*x/(4*(2*a^2+b^2)*(3*a^2+b^2)*(b^2*x^2+2*a^2+b^2))-b^2~
/(4*a*(3*a^2+b^2)*(b^2*x^2+2*a^2+b^2))),x)+INT((SQRT(b^2*x^2+2*a~
^2+b^2)-SQRT(2)*x)*(b^2*x*(a^2-b^2+3)/(4*(3*a^2+b^2)*(a^4*(3*b^2~
-4)+a^2*b^4+b^2)*(b*x^2-2*a*x+b))+b*(2*a^2*(2*b^2-3)+b^2)/(4*a*(~
3*a^2+b^2)*(a^4*(3*b^2-4)+a^2*b^4+b^2)*(b*x^2-2*a*x+b))),x)
In the first two cases, the rational part has simply been expanded into
partial fractions. In the third case the denominator has been
rationalized, the rational part subsequently been expanded into partial
fractions, and the single integral then split into two. The latter step
seems to be necessary if you want Derive to evaluate the third integral
in reasonable time.
I conclude that, on Rubi too, work remains to be done in this area.
Martin.
One tiny example.
The VM machine says:
Mathematica 7.0.1.0 returns
Integrate[1/(Sqrt[2] + Sin[z] + Cos[z]), z]
unevaluated (!).
Rubi returns
-(2/(1 + (-1 + Sqrt[2]) Tan[z/2]))
which is a correct answer.
Best wishes,
Vladimir Bondarenko
VM and GEMM architect
Co-founder, CEO, Mathematical Director
http://www.cybertester.com/ Cyber Tester, LLC
http://maple.bug-list.org/ Maple Bugs Encyclopaedia
http://www.CAS-testing.org/ CAS Testing
-----------------------------------------------------
"We must understand that technologies
like these are the way of the future."
-----------------------------------------------------
> Aloha from Hawaii,
> Albert D. Rich
This is quite interesting.
Suppose we add real coefficients h and k for sin(2x)
and cos(2x) respectively.
Then, in the Mathematica notation, I arrive at this:
Integrate[1/(a+b*Sin[x]+c*Cos[x]+h*Sin[2x]+k*Cos[2x]), x]
Of course, there could be quite a few special cases here.
David Bernier
my solution involves "PetSie.nb" which can be found at
http://dl.dropbox.com/u/3030567/Mathematica/PetSie.nb
In[3]:= <<PetSie`
In[6]:=
Assuming[Pi>x>0,ChangeVar[Tan[z/2]==t,Integrate[1/(Sqrt[2]+Sin[z]+Cos[z]),{z,0,x}],t]]
Out[6]= (2 (-1+Sqrt[2])Sin[x/2])/(Cos[x/2]+(-1+Sqrt[2]) Sin[x/2])
there is a difference between the usage of a cas and simply asking a
cas.
Greetings, Peter
Am Wed, 9 Jun 2010 05:14:21
-0700 (PDT) schrieb Vladimir Bondarenko <v...@cybertester.com>:
Very interesting. I wonder how have you checked that these O(10^3)
rules are mutually exclusive. And how would newly contributed rules be
checked against previous ones.
Regards, Alejandro Jakubi
So there are two kinds of rules: "ordinary" rules where mutual
exclusivity is desirable (otherwise the result would depend on the order
of application by the pattern matcher), and "super" rules that recast
the problem when the pattern matcher has failed to find a match. Then
the ordinary rules are traversed again, and perhaps this cycle is
iterated with the same or a different super rule. I suppose
trigonometric transformations and (very importantly) integration by
parts are also included among the super rules.
If not included already, I propose to add the rationalization of
algebraic denominators to this group, where integrands of the type
C(x)/(A(x)*SQRT(F(x))+B(x)*SQRT(G(x))) are replaced by
C(x)*(A(x)*SQRT(F(x))-B(x)*SQRT(G(x))) / (A(x)^2*F(x)-B(x)^2*G(x)). The
fairly common functions C(x)/P(x,SQRT(F(x))), where P(x,y) is a
polynomial in two variables, represent just a special case of this (with
G(x)=1).
Here is a small gallery of fairly simple algebraic integrands on which I
have found Derive 6.10 to fail (as in an earlier example, more or less
obvious transformations on part of the operator help it succeed though):
INT(1/(SQRT(x^2+1)+2*x)^2,x)
INT(1/(SQRT(x^2-1)*(3*x^2-4)^2),x)
INT(1/(2*SQRT(x)+SQRT(x+1))^2,x)
INT(SQRT(x^2-1)/(x-#i)^2,x)
INT(1/(SQRT(x^2-1)*(x^2+1)^2),x)
INT(1/(SQRT(x-1)*(SQRT(x-1)+2*SQRT(x))^2),x)
INT(1/(SQRT(x^2-1)*(SQRT(x^2-1)+SQRT(x))^2),x)
INT(SQRT(SQRT(x^4+1)+x^2)/((x+1)^2*SQRT(x^4+1)),x)
INT(((x-1)^(3/2)+(x+1)^(3/2))/((x+1)^(3/2)*(x-1)^(3/2)),x)
Martin.
If you use a program that looks like this:
toplevel(integrand, var) :=
repeat until no more changes {
if match(super_pattern1,integrand,var)
then
integrand := apply(super-rhs1, run_some_algorithm(integrand), var);
else
if match(.....)
}
If the run_some_algorithm includes much of the traditional computer
algebra repertoire, it is not surprising that the integration
program would be at least as successful. An important but tricky
optimization is ordering the matching so that no time is wasted
on rules that cannot possibly match.
An advantage of the rule-based approach is that it is possible,
though not necessarily as easy as it might seem, to insert an
"optimal patch". This would be a rule that adds a new capability, but
does it in such a way as to interfere with nothing else. And to not
slow down anything else. Finding a place to put an optimal patch
in a conventional program requires tracking down where some critical
decision is made and putting in an extra test.
Ordering the rules automatically so that all possibly applicable rules
are tried, and the ruleset converges, are challenges.
There was period during which people wrote rule-based expert
systems (and meta-systems), and tried various things to keep correctness
and cost under control as the systems were scaled up in size.
(1980's?) I think people had enough bad experiences to sour them
on "Artificial Intelligence" for a few decades.
Nevertheless, if Albert's stuff works, there is no arguing with
success!
RJF
Side remark: Maple 12 finds them directly, except the one
before the last (though I neither checked the answers nor
want to / can to judge the 'simplicity' of the results).
That is good.
I just did a quick test on the above 9 integrations posted by Martin,
using Mathematica 7 and Rubi, and numbers 7 and 8 in the list did not
evaluate.
To compare the result from Matematica and Rubi, I cheated, I just
plotted the difference over some range, and in all cases I get a zero
plot. So numerically the result is the same. Not the best way to check
equivalence of the 2 analytical results, but a quick and dirty way for now.
If someone wants to see the output, here is a link
http://12000.org/my_notes/rubiTest/rubi_1/rubi.html
and the notebook is here
http://12000.org/my_notes/rubiTest/rubi_1/rubi.nb
--Nasser
In the case of MMA the effect is called "Risch integration (not fully
implemented)". Could someone perhaps try them on Maxima and on FriCAS
too?
Martin.
I do accept this obligation. But note that the performance statistics
for the venerable Lady Maxima and for the renowned Sir Axiom, also
performing under the alias of FriCAS, are not yet in. In fact, I expect
the latter to be able to relieve me from my obligation. Hence only this
much for now: compact (though not optimized) forms of the
antiderivatives 7 and 8 are roughly 350 and 500 Bytes in size.
I realize that the advance that Rubi represents over Derive 6.10 is
truly substantial!
Martin.
1-5 and 9 evaluate quickly (I did not check correctness). 6, 7, 8
are slow. In my experience integrals like 6 and 7 worked but
needed a lot of time (days or weeks). I left nr 8 running, will
report about result.
--
Waldek Hebisch
heb...@math.uni.wroc.pl
((x^4+1)^(1/2)+x^2)^(1/2)/(x+1)^2/(x^4+1)^(1/2) =
1/2*2^(1/2)/(x+1)^2/(x^2+I)^(1/2) +
1/2*2^(1/2)/(x+1)^2/(x^2-I)^(1/2)
and for that Maple finds anti-derivatives (though they
lengthy and involve ln and sqrt, but they are real and
obey the problem in x=-1 and can be simplified):
((-1-I)*(2*x^2-2*I)^(1/2)+(-1+I)*(2*x^2+2*I)^(1/2)+
(-I*(1-I)^(1/2)*ln((-2*I-2*x+2*(1-I)^(1/2)*(x^2-I)^(1/2))/
(x+1))+I*(1+I)^(1/2)*ln((2*I-2*x+2*(1+I)^(1/2)*
(x^2+I)^(1/2))/(x+1)))*(x+1)*2^(1/2))/(4*x+4)
I did cross checking by differentiation against the task
only by plotting or a (finite) Taylor series (seems some
work is needed to convince Maple to proof it).
Agreed, there is a brunch cut problem (term1 - term2 would be
correct, but I do not want to correct it by paper and pencil).
Fine, if your system finds it without pain!
I wonder how the Derive 6.10 and Rubi indefinite integrators compare
on
the elementary function integrands?
Do you expect with Rubi to surpass the Derive 6.10 indefinite
integration
facility?
Do you expect to reinforce the Rubi so it would be stronger in
indefinite
integration than the Mathematica 7 integrator?
On Jun 4, 6:18 am, Albert <Albert_R...@msn.com> wrote:
> I would like to announce the launch of the website
>
> www.apmaths.uwo.ca/RuleBasedMathematics
>
> It is dedicated to dedicated to demonstrating the numerous advantages
> of the rule-based approach to automating mathematics. In systems
> implemented using this approach, rules are expressed as elegant
> mathematical formulas, rather than embedded in conventional program
> code.
>
> As proof-of-concept, I have implemented an efficient and robust Rule-
> based Integrator, nicknamed Rubi. Not only can Rubi compute the
> antiderivative for a broad class of integrands, but the results are
> often significantly superior to those produced by the commercial
> computer algebra systems.
>
> The 1500 or so integration rules Rubi uses are freely available on the
In[12]:= expr = y(y^2+1)/(y^4+2y^3-2y^2+2y+1);
In[13]:= solns = y /. Solve[Denominator[expr]==0, y];
In[14]:= quadratics = Union[Cases[solns, Power[_Integer,1/2], Infinity]];
In[15]:= InputForm[Apart[Factor[expr, Extension->quadratics]]]
Out[15]//InputForm=
((-1 + Sqrt[5])*y)/(2*Sqrt[5]*(1 + y - Sqrt[5]*y + y^2)) +
((1 + Sqrt[5])*y)/(2*Sqrt[5]*(1 + y + Sqrt[5]*y + y^2))
Daniel Lichtblau
Wolfram Research
Your transformation is valid for Re(x^2) > 0, and so your result will be
valid in this region (which includes the positive and negative real
axis); but because the transformation is invalid outside this region, so
should be your result.
However, there is a indeed a clean way of splitting the factor
SQRT(SQRT(x^4+1) + x^2) / (SQRT(x^4+1)) in the integrand, namely as
1/SQRT(2) (SQRT(#i)/SQRT(1 + #i*x^2) + SQRT(-#i)/SQRT(1 - #i*x^2)).
Subsequent integration by Rubi, Maple, or Mathematica should be no
problem. But can the systems be instructed to remove the imaginary units
from the antiderivative? Can Maple and Mathematica verify the result for
the entire complex plane?
This complex splitting method of solving integral no 8 is simple and
elegant; I therefore propose to include the most general version of the
transformation that can be worked out and all possible variants of it
(such as the case resulting for x = #i*y) with Rubi's set of integration
rules.
Martin.
Aha, one has to care only for the radicals and uses 1/(x+1)^2 later
(and then Maple finds an antiderivative).
I could not convince Maple to proof your identity A=B directly
(where I assume there is a multiplication after 1/SQRT(2), yes?).
# translate Derive to Maple notation, saves typing ...
"SQRT(SQRT(x^4+1) + x^2) / (SQRT(x^4+1)) = 1/SQRT(2) *
(SQRT(#i)/SQRT(1 + #i*x^2) + SQRT(-#i)/SQRT(1 - #i*x^2))";
StringTools[SubstituteAll]( %, "INT", "Int" ):
StringTools[SubstituteAll]( %, "SQRT", "sqrt" ):
StringTools[SubstituteAll]( %, "#i", "I" ):
A,B:=lhs(%), rhs(%);
Now
(A/B); # this should be 1, we only take the square
simplify(%): simplify(%, size); # simplify it
%^2;
numer(%) - denom(%); # should be 0
expand(%):
C:=combine(%): # simplified, show C=0
RootOf(%, x); # solve this algebraic equation
[allvalues(%)]; # and show all solutions
(1/4)
[_X, -I (-1) ]
This says: _any_ x is a solution. And the second value as well.
(if one trusts the system ...).
Both MultiSeries:-limit(A/B, x=-I*(-1)^(1/4), complex)
and MultiSeries:-limit(C, x=-I*(-1)^(1/4), complex) give
what the should give (1 and 0).
Now I am too lazy to care for +-1 = sqrt(1) ...
I think I should sketch (in a _polished_ way) how one can come across
it (since just looking at the (corrected) result does not give it),
may be it is a kind of recipe as well.
The integrand is algebraic and univariate, hence it satisfies a DE
with polynomial coefficients (have no reference).
In that case (a standard attack with 'dpolyform' fails) one can use
the package 'gfun' to find first a polynomial equation, which is
satisfied by the integrand by 'algfuntoalgeq').
In a second step the package has 'algeqtodiffeq' to give the DE for
the problem and 'dsolve' two linear independent solutions; they do
involve integrand(0) and the 2nd derivative of it in 0.
I got my coefficients by trusting that and using the known values
for that (hence there might be a bug in the used routines).
However it is *much* more simple to try a splitting method directly,
if having that in mind. Just thought it might be worth to sketch a
way, how to get a different view on such integrands.
Some clarifications first: I was not aware that this kind of splitting
is possible until I saw the post by Axel Vogt. As Axel explained, he
discovered (a somewhat incorrect version of) the formula by deriving and
solving a differential equation for the entire integrand using Maple.
When you pointed out the branch-cut problem with his transformation, my
intuition told me that a correct version should exist; the problem thus
remained on my mind until three days later (while awaking in the
morning) I "saw" the necessary correction, and later that day confirmed
it graphically and posted it here. I also used it to integrate problem 8
on Derive 6.10, and (with some massaging) obtained the simple
antiderivative:
INT(SQRT(SQRT(x^4+1)+x^2)/((x+1)^2*SQRT(x^4+1)),x)
(LN(-SQRT(#i-1)*SQRT(1-#i*x^2)-x+#i)/(2*SQRT(#i-1))+LN(-SQRT(-#i~
-1)*SQRT(1+#i*x^2)-x-#i)/(2*SQRT(-#i-1)))-SQRT(SQRT(2)-1)*LN(x+1~
)/2-SQRT(SQRT(x^4+1)+1)/(SQRT(2)*(x+1))
As regards a manual derivation of the splitting relation, I can only
offer what you are probably aware of already:
SQRT(SQRT(1+x^4) + x^2) / SQRT(1+x^4)
SQRT(SQRT((1 - #i*x^2)*(1 + #i*x^2)) + x^2) /
SQRT((1 + #i*x^2)*(1 - #i*x^2))
SQRT(SQRT(1 - #i*x^2)*SQRT(1 + #i*x^2) + x^2) /
(SQRT(1 + #i*x^2) * SQRT(1 - #i*x^2))
SQRT(#i*(1 - #i*x^2) + 2*#i*SQRT(1 - #i*x^2)*(-#i)*SQRT(1 + #i*x^2) +
(-#i)*(1 + #i*x^2)) / (SQRT(2) * SQRT(1 + #i*x^2) * SQRT(1 - #i*x^2))
(SQRT(#i)*SQRT(1 - #i*x^2) + SQRT(-#i)*SQRT(1 + #i*x^2)) /
(SQRT(2) * SQRT(1 + #i*x^2) * SQRT(1 - #i*x^2))
1/SQRT(2) * (SQRT(#i)/SQRT(1 + #i*x^2) + SQRT(-#i)/SQRT(1 - #i*x^2))
I am in doubt whether this derivation should be called "simple and
elegant"; the validity of the numerator transformation may not be
obvious to many.
As regards possible generalizations needed for a good Rubi rule, I
suspect that SQRT(1+x^4) and SQRT(1 +- #i*x^2) in the formula can be
replaced by SQRT(a+x^4) and SQRT(SQRT(a) +- #i*x^2), respectively, where
RE(a) must probably be > 0 or perhaps only >= 0 (as I haven't looked
into this, the range of values actually allowed in the complex plane may
also be a smaller "wedge" only). For pattern matching, x should
presumably be generalized to b*x+c. I don't know if a separate rule
based on SQRT(SQRT(1+x^4) - x^2) / SQRT(1+x^4) = 1/SQRT(2) *
(SQRT(-#i)/SQRT(1 + #i*x^2) + SQRT(#i)/SQRT(1 - #i*x^2)) would still be
needed then; this variant is obtained upon replacing x by #i*x.
Martin.
> sqrt(a+z^2) = sqrt(sqrt(a)+I*z)*sqrt(sqrt(a)-I*z)
> which is valid for all z provided a>0.
...
Just for the records (as you certainly do not have the 'obvious
and false proof' in mind): sqrt(1-x)*sqrt(1+x)=sqrt(1-x^2) is
shown in Davenport & Corless, Reasoning about the Elementary
Functions of Complex Analysis (2000). Now using z=x/sqrt(a)*I
and multiplying by a gives it (Maple does not know that, it
even states it as false for a=1).
...
> Aloha,
> Albert
Another way to look at these identities is 'denesting radicals'
(as you did with Jeffrey in 'Simplifying square roots of square
roots by denesting').
Is there a way to make use of Rubi's abilities calling it from
Maple?
>
> If someone wants to see the output, here is a link
>
> http://12000.org/my_notes/rubiTest/rubi_1/rubi.html
>
fyi,
I added Maple 14 output to the above. The link to Maple output is
contained in the above, near the top.
Maple 14 did them all, except for Martin's number 8 problem.
--Nasser
The Cyber Tester's team is interested in improvements along
the direction you offer, rule-based approach to automating
mathematics.
As you know, we do not test software ourselves; instead, this
work is done by our VM machine.
It is important to learn how much we could help you and the
community in reinforcing Rubi as the very first step of your
project.
To know this, it would be nice and fair to learn, before we
start presenting the results by the VM machine,
1) how much time have you spent writing the Rubi?
2) how much time you and your beta testers spent for QA?
3) is there a list of known bugs in the Rubi?
About the time, ANY estimation however approximate is good.
Best wishes from algorithmic Simferopol,
Vladimir
Experiments of mine confirm that SQRT(a^2+z^2) = SQRT(a + #i*z) * SQRT(a
- #i*z) requires a > 0, and doesn't permit a larger domain. I think this
particular relation (in suitably generalized form) should be available
both ways, to help matching a given integrand to rules in Rubi's
collection. The same applies to SQRT(a^2-z^2) = SQRT(a+z) * SQRT(a-z),
provided this was indeed needed as a separate rule (where again a > 0).
It appears that Rubi's newly crafted rule involving the fourth power x^4
covers the case resulting for x <- #i*x automatically. But does it also
cover the simpler quadratic case for x^2 <- x and x^2 <- -x (unless
never needed), or that of arbitrary functions x^2 <- f(x) (unless
completely useless)? How about related root splitting or denesting
rules? Some candidate relations:
SQRT(SQRT(1+z^2) + 1) = (SQRT(1 + #i*z) + SQRT(1 - #i*z)) / SQRT(2)
1 / SQRT(SQRT(1+z^2) + 1) = (SQRT(1 + #i*z) - SQRT(1 - #i*z)) /
(SQRT(2)*#i*z)
SQRT(SQRT(1+z^2) - 1) = SQRT(z^2) (SQRT(1 + #i*z) - SQRT(1 - #i*z)) /
(SQRT(2)*#i*z)
1 / SQRT(SQRT(1+z^2) - 1) = (SQRT(1 + #i*z) + SQRT(1 - #i*z)) /
SQRT(2*z^2)
Needless to say, these can be generalized in similar ways (z <- x^2,
z <- #i*x, z <- #i*x^2, z <- SQRT(#i)*x, z <- SQRT(#i)*x^2, etc.).
Finally, wouldn't it be more profitable to concentrate on the (suitably
generalized) true root splitting (or denesting) step
SQRT(SQRT(1+z^2) + z) = 1 / SQRT(SQRT(1+z^2) - z) =
(SQRT(-#i)*SQRT(1 + #i*z) + SQRT(#i)*SQRT(1 - #i*z)) / SQRT(2),
as a new Rubi rule, and let everything else follow automatically via
other rules? But I haven't looked at your code.
Martin.
PS: If you want sci.math.symbolic readers to suggest new rules, it would
be helpful if your site could present the tests with unsatisfactory or
missing Rubi answers in a form readable without access to MMA (or
some MMA "player"). Or perhaps you could post a selection of the more
"promising" failures here?
PPS: I didn't know that the Risch integrator of Axiom (or FriCAS) was
this abysmally slow (it's been running for _ten_ days now). In 1984 (the
year of Trager's thesis), the code must have been near impossible to
debug even on a Cray!
Axiom code is mostly due to Manuel Bronstein in 1990-1994 (I do not
think is make much difference, in 1984 Axiom team should have access
to 30 MIPS mainframe (maybe better) and in 1994 Bronstein probably
had 30-100 MIPS workstation).
Actually, the Risch integrator itself runs reasonably fast. The
problem is arithmetic with expressions containing two square
roots. Risch integrator creates intermediate expressions which are
significantly larger than input expression -- not very large but
enough to make arithmetic very slow. I think that all routines
were debugged using single algebraics (in such case arithmetic is
reasonably fast).
BTW1: Arithmetic on algebraic expression can be done much faster
then currently in FriCAS. New routines are under developement.
BTW2: Currently Risch integrator makes some shortcuts for case
of roots (as opposed to general algebraics). But I think that
in case of two roots it is possible to make shortcut doing
only slightly more computatins as for single root, while
current code treats roots in sequence doing much more
expensive operations.
--
Waldek Hebisch
heb...@math.uni.wroc.pl
This is what I was getting at. These files are awfully hard to read
without access to Mathematica; even Euler would have despaired. Wide
dissemination of Rubi's failures could help increase feedback in the
form of suggestions, which might lead to improved rules.
Martin.
Fyi;
I've added Sage 4.4.4 (downloaded on july 2,2010) result to the above
page (the link to Sage worksheet output can be found near the top of the
above page) it is an HTML page.
Sage did only integral #9.
I am not a Sage user, so may be someone with more Sage experience can
try some other tricks or commands to get a better result than what I
got. I used sage integral() command with no assumptions. Run sage from
inside VM machine on windows.
--Nasser
Sage itself is open source, so adding open source code to it should not
be a problem.
For integration, using integral(), it seems to use Maxima interface
based on my reading of the top of this page:
http://www.sagemath.org/doc/constructions/calculus.html
>Does it support a pattern-matching programming language?
>
> Albert
Some pattern commands on expressions can be seen here:
http://www.sagemath.org/doc/reference/sage/symbolic/expression.html
Since sage is phython based, I also assume that any pattern matching
functionality in python or sympy can be used from within sage as well.
I know very little about sage, every once in a while I download the
latest version and play with it a little and that is all.
--Nasser
That Maxima is used seems to follow from the output for problem #4 as
well:
#4 f=sqrt(x^2-1)/(x-I)^2 f.integral(x)
Traceback (click to the left of this block for traceback)
...
Is (I-1)*(I+1) zero or nonzero?
This kind of question to the operator is typical of the Maxima
integrator. Nobody will be surprised to learn that Derive 6.10
simplifies IDENTICAL?((#i-1)*(#i+1), 0) to FALSE automatically, no
questions asked. Perhaps your "I" was not really #i, the imaginary unit
- in spite of the definition at the top of your page?
Martin.
I too understand that Sage uses Maxima for integration, if so, if you
want to test integrals, you can just download and use Maxima.
Maxima uses %i for sqrt(-1), not I.
and (%i-1)*(%i+1) expands to -2, as expected.
And if you want to add rules to the integration procedure in Maxima,
you can do so using procedures or patterns in Maxima. There are
several pattern matchers, but the one that is only incompletely
accessible in Maxima is the one probably of most interest, which is the
one from MockMMA -- it looks like Mathematica's.
I think that Sage and Python are, in this case, merely a distraction.
You might try one of the Axiom variants, too.
As for the possibility of expressing integrals without algebraic
extensions, I think that Barry Trager's MIT thesis describes the
conditions under which this works. It looks like one direction
to head is to encode the Risch algorithm as a side-light to certain
rules.
RJF
> Perhaps your "I" was not really #i, the imaginary unit
> - in spite of the definition at the top of your page?
>
> Martin.
Thanks. It looks like you are correct. I corrected #4 and just used
sqrt(-1), and now sage does this problem. So sage does #4 and #9 now.
I updated the page
http://12000.org/my_notes/rubiTest/rubi_1/rubi.html
#4
I=sqrt(-1)
x=var('x')
f=sqrt(x^2-1)/(x-I)^2
f.integral(x)
(answer below)
I also plotted difference of sage answer against Mathematica's answer
Zero plot. good. at least numerically same answer.
Btw, for this problem, sage (or maxima really) has the smallest leaf
count. Using Mathematica LeafCount on sage answer, Rubi and Mathematica
own answers, I get
LeafCount[sageAnswer]
69
LeafCount[mmaAnswer]
154
LeafCount[rubiAnswer]
136
sageAnswer = (1/2)*I*Sqrt[2]*ArcSin[I*(x/Sqrt[x^2 + 1]) - 1/Sqrt[x^2 +
1]] - Sqrt[x^2 - 1]/(x - I) + Log[2*x + 2*Sqrt[x^2 - 1]];
mmaAnswer = (1/4)*(-((4*(-1 + x^2)^(1/2))/(-I + x)) -
2*I*2^(1/2)*ArcTan[(1/2)*(-I + x - 2^(1/2) - 1 + x^2^(1/2))] +
4*ArcTanh[(2*x)/(I - x + (-1 + x^2)^(1/2))] - 2^(1/2)*Log[-I + x]
+ 2^(1/2)*Log[2*I + 6*x - 4*2^(1/2) - 1 + x^2^(1/2)] +
2*Log[-4 + 8*x^2 - 8*I - 1 + x^2^(1/2) + 8*x*(-I - 1 + x^2^(1/2))]);
rubiAnswer = 4/(1 - 2*I*(x + Sqrt[-1 + x^2]) + (x + Sqrt[-1 + x^2])^2) -
(I*(-2*I + 2*(x + Sqrt[-1 + x^2])))/(1 - 2*I*(x + Sqrt[-1 + x^2]) +
(x + Sqrt[-1 + x^2])^2) + I*Sqrt[2]*ArcTan[(-2*I + 2*(x + Sqrt[-1 +
x^2]))/ (2*Sqrt[2])] + Log[x + Sqrt[-1 + x^2]];
--Nasser
I have difficulties matching the "Euler substitution" displayed in the
pdf file with what seems to be actually going on. Could the wrong rule
be displayed for both integrands? Or am I having a bad day? I think
there is only one way of matching SQRT(a+b*x+c*x^2) with the integrand,
which should result in a=3, b=0, c=4. The actual transformation,
however, apparently just takes the argument of the outer root as the new
integration variable. This procedure works with problem #8 as well: it
is the solution I was originally aware of (I believe it was once shown
on this group by Oleksandr at WRI), where the resulting antiderivative
is larger but doesn't involve the imaginary unit. For the general user,
this would often be preferable, I think.
>
> Euler's ability to avoid introducing the imaginary unit makes me
> wonder whether there is an analogous substitution for integrands
> having subexpressions of the form sqrt(a+b*x^4), thus obviating the
> need for our algebraic expansion rule. If anyone knows of such a
> substitution, please let me know.
>
All that seems to be needed would be to extend the range of
applicability of your secret substitution rule to a larger class of
integrands, namely those involving the denestable radicands
SQRT(1+x^4)+x^2, SQRT(1+x^4)+1, SQRT(1+x^4)-1 (all of them suitably
g