Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: How do I create a parametric expression?

• To: mathgroup at smc.vnet.net
• Subject: [mg68579] Re: How do I create a parametric expression?
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Wed, 9 Aug 2006 23:57:42 -0400 (EDT)
• References: <200608090819.EAA21141@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

axlq wrote:
> I'm trying to figure out how to simplify a large expression so that it's
> expressed in terms of a sub-expression that's factored into the larger
> one.
> 
> My expression looks like this:
> 
> -((1 + 2*n)*((a^4*k^2 + a^2*(-1 + k^2*(q - z)^2) + 2*(q - z)^2)
>    *Cos[k*Sqrt[a^2 + (q - z)^2]] - k*(a^2 - 2*(q - z)^2)
>      *Sqrt[a^2 + (q - z)^2]*Sin[k*Sqrt[a^2 + (q - z)^2]])
>        *Sin[((1 + 2*n)*Pi*z)/L])/(8*Pi*w*(a^2 + (q - z)^2)^(5/2))
> 
> Now, I *know* there are places in there were Sqrt[a^2+(q-z)^2] occurs,
> either by itself or raised to various powers.  If I want to define
> 
> R:=Sqrt[a^2+(q-z)^2]
> 
> ...then how can I make Mathematica re-state my expression in terms
> of R?  The ReplaceRepated[] function doesn't seem to do the job.
> 
> I need to do this because I am translating the expressions into
> Visual Basic code for an Excel application, and it would be nice to
> find groupings of terms repeated throughout the expression that I
> need to calculate only once.
> 
> -Alex

This is probably best done with a form of algebraic replacement. I seem 
to revisit this from time to time, for example see the URLs below. But 
each time the code gets a bit longer.

http://forums.wolfram.com/mathgroup/archive/2005/Apr/msg00273.html

http://forums.wolfram.com/mathgroup/archive/2002/Jan/msg00354.html

The code in those threads will not go inside transcendental functions. 
So below is a modification that will.

replacementFunction[expr_,rep_,vars_] := With[
   {num=Numerator[expr],den=Denominator[expr],hed=Head[expr]},
   If [PolynomialQ[num,vars] && PolynomialQ[den,vars],
     PolynomialReduce[num, rep, vars][[2]] /
     PolynomialReduce[den, rep, vars][[2]]
     , (* else *)
     If [Head[hed]===Symbol&&MemberQ[Attributes[hed],NumericFunction],
       Map[replacementFunction[#,rep,vars]&, expr]
       , (* else *)expr]
     ]
   ]

Your example:

expr = -((1 + 2*n)*((a^4*k^2 + a^2*(-1 + k^2*(q - z)^2) + 2*(q - z)^2)*
      Cos[k*Sqrt[a^2 + (q - z)^2]] - k*(a^2 - 2*(q - z)^2)*
      Sqrt[a^2 + (q - z)^2]*Sin[k*Sqrt[a^2 + (q - z)^2]])*
    Sin[((1 + 2*n)*Pi*z)/L])/(8*Pi*w*(a^2 + (q - z)^2)^(5/2));

It appears to work best here if we do not encapsulate the thing we 
replace in a square root.

In[20]:= InputForm[replacementFunction[expr, a^2+(q-z)^2-R^2, {a,q,z}]]

Out[20]//InputForm=
-((1 + 2*n)*((-R^2 + k^2*R^4 + q^2*(3 - k^2*R^2) +
   q*(-6 + 2*k^2*R^2)*z + (3 - k^2*R^2)*z^2)*Cos[k*Sqrt[R^2]] -
     k*Sqrt[R^2]*(-3*q^2 + R^2 + 6*q*z - 3*z^2)*Sin[k*Sqrt[R^2]])*
    Sin[((Pi + 2*n*Pi)*z)/L])/(8*Pi*(R^2)^(5/2)*w)


Daniel Lichtblau
Wolfram Research

• References:
  • How do I create a parametric expression?
    • From: axlq@spamcop.net (axlq)