IPX
An Improved Pattern Extractor

Frank Kronmueller

frank.kronmueller@ieee.org

Version 1.2  (25.01.2000)

This package simplifies arbitrary expressions according to one or more given variables.
Sometimes  Mathematica returns huge output equations which are hard to examine. 

The function IPX[ ] replaces all Terms and Coefficients that contain none of the given 
variables with ONE replacement variable.
The result is a more readable expression in terms of the given variables.

The  expression manipulations such as Simplify, Together... are more effective,
because you can see an existing pattern.
Furthermore the simplified expression makes a coefficient comparison possible.

This notebook contains some examples of the usage of IPX[].

Load the Package

Complete the following command with the Path to Package IPX.m.

SetDirectory[]

This loads the Package

<< IPX.m

Some Examples

This is demo expression No.1

eq1 = 
        1 + (E^h) + h + x + (E^(k x)) x + 
          7 g (h^2) x + 2 (x^3) + b (x^a) + x Sin[1 - g +  x] + 
          Sin[1 + (x^3)];

Let us analyze the Pattern according to x. 
The replacement variable shall be "q". 
This argument will be directly used with Unique[] with the appropriate results.
The returned Object has the Form {expr,{rules}}.

sol = IPX[eq1, x, "q"]
sol[[1]]    
sol[[2]]

Note that all Terms and Factors containing none of the given Variable x were replaced with
a single q.
We check the equality of this result:

Simplify[(ReplaceRepeated @@ sol) == eq1]

Note the different handling of the returned data below.
Now we want to examine our Expression regarding {g,h}

{ex, rep} = IPX[eq1, {g, h}, "q"];
ex
Simplify[(ex  //. rep ) == eq1]

and {h} alone:

sol = IPX[eq1, {h}, "q"];
sol[[1]]
Simplify[(ReplaceRepeated @@ sol) == eq1]

Now we give a Symbol instead of a String to repvar

sol = IPX[eq1, {g}, q];
sol[[1]]
Simplify[(ReplaceRepeated @@ sol) == eq1]

We can also process Equations,

eq2 = eq1 == Take[eq1, 6]

sol = IPX[eq2, {x}, "w"];
sol[[1]]
Simplify[(ReplaceRepeated @@ sol) == eq2]

...Rules...

eq2 = tar -> eq1;
sol = IPX[eq2, {k}, w];
sol[[1]]
Simplify[(ReplaceRepeated @@ sol) == eq2]

and all other Functions.

eq2 = Oops[eq1];
sol = IPX[eq2, {b}, w];
sol[[1]]
Simplify[(ReplaceRepeated @@ sol) == eq2]

If two or more extracted expressions are equal they will be replaced with the same variable, but there is no further simplification inside the generated rules.  (see Example Equation above)

The Function IPX don't use any Expand, Simplify or other manipulating functions.
The manipulation of the structure, such as eliminating brackets, collecting terms etc. is up to you. 
If your result contains terms such...+ (a1* a2)+... just do another IPX and they will be replaced.

The next example is a solution of an ODE. 

(* from DMUG  http://www.mathematica.ch/dmug-archive/1999/msg00037  *)
    
The solution should be of the general form

Solution -> k0+ k1 Exp[a1 x]+ k2  Exp[a2 x]

The problem was the comparison of coeffients between the solution and the general form.
Let's do it!

First we generate the Solution

\(\(gensol\  = \ 
        DSolve[\ {wwh\ \(Th'\)[x]\  == \ 
              k\ A\ \((Tk[x]\  - Th[x])\)\  - \ 
                lambda\ \(\(Th'\)'\)[
                    x], 
		\ \ \ \ \ \ \ \ \ \ \ \ \ \ wwk\ \(Tk'\)[
                  x]\  == \ k\ A\ \((\ Tk\ [x] - \ Th[x])\)\ }, \ {\ Th[x], 
            Tk[x]}, \ x];\)\)

We extract the first result Th[x]. Note that the Integration constant C[i] has the Head C; we must replace C[i] with eg. C1 (Head@C1 (should) return Symbol ), if we are interested in the pattern of C[i]

eq3 = Th[x]  /.  gensol[[1, 1]]  /. {C[1] -> C1, 
            C[2] -> C2, C[3] -> C3};
LeafCount[eq3]

Take a closer look and then better remove the output.

eq3

Oops, what a mess. Don't try to Simplify this! You won't get more insights.
    But now we do an IPX with this solution.

sol = IPX[eq3, {x}, "w"];
sol[[1]]

This should be more readable. Now we can clearly see the pattern of the solution.
We remove the brackets to get replaceable Parts  (eg. a*b)

sol[[1]] = Together[ sol[[1]] ]

A second IPX will replace the a*b Parts.
Now we call IPX with a composite-Object of form {expr,{rules}}, this keeps the previous generated rules.
We can change the replacement Variable to "v".

sol = IPX[sol, {x}, "v"];
sol[[1]]

A Simplify will be effective now.

sol[[1]] = Simplify[%]

This look rather good, but a another IPX will replace the last terms in Brackets and
show us some of the replacement rules

sol = IPX[sol, {x}, "v"];
sol[[1]]
Take[sol[[2]], -8]  
LeafCount[sol[[1]]]

This is of the above mentioned form 

    k0+ k1 Exp[a1 x]+ k2  Exp[a2 x] 

We doublecheck this remarkable result.
Warning!  Should only rePerformed on  PII-350 or faster with some Memory

Simplify[(ReplaceRepeated @@ sol) == eq3]

The last expression is a Transfer Function of an electrical network, which gives us Polynoms of higher order.

eq3 = (-((2 I Chp f π)/(R Rhp)) + ((2 I Chp f π v0)/((1 + ((I f)/f0)) Rhp Zout)) + ((2 I Clrd f π v0)/((1 + ((I f)/f0)) Rhp Zout)) + 
              (v0/((1 + ((I f)/f0)) R Rhp Zout)) + ((gm v0)/((1 + ((I f)/f0)) Rhp (1 + 2 I Chp f π Rhp) Zout)))/(((4 Chp Clrd (f^2) (π^2))/R) - ((2 I Chp f π)/(R Rhp)) - ((2 I Clrd f π)/(R Rhp)) - ((2 I Chp f gm π)/(R (1 + 2 I Chp f π Rhp))) - 
              (gm/(R Rhp (1 + 2 I Chp f π Rhp))) - ((2 I Chp f π)/(R Zin)) - ((2 I Clrd f π)/(R Zin)) - 
              (gm/(R (1 + 2 I Chp f π Rhp) Zin)) + ((4 Chp Clrd (f^2) (π^2))/Zout) - ((2 I Chp f π)/(R Zout)) - ((2 I Chp f π)/(Rhp Zout)) - ((2 I Clrd f π)/(Rhp Zout)) - 
              (1/(R Rhp Zout)) - ((2 I Chp f gm π)/((1 + 2 I Chp f π Rhp) Zout)) - 
              (gm/(Rhp (1 + 2 I Chp f π Rhp) Zout)) - ((2 I Chp f π v0)/((1 + ((I f)/f0)) R Zout)) - ((2 I Chp f π)/(Zin Zout)) - ((2 I Clrd f π)/(Zin Zout)) - 
              (1/(R Zin Zout)) - 
              (gm/((1 + 2 I Chp f π Rhp) Zin Zout)));

sol = IPX[eq3, {f}, "a"];
sol[[1]]
sol[[2]]
Simplify[(ReplaceRepeated @@ sol) == eq3]

We combine these terms into polynominals,

tmp = Together[sol[[1]]]

collect all Powers of  f  in Numerator and Denominator

num = 
      Collect[Numerator[tmp], {1, f, (f^2), (f^3)}]
den = Collect[Denominator[tmp], {1, f, (f^2), (f^3), (f^4)}]

and do another IPX. Note that we create a composite Object of the form
{expr,{rules}} in order to keep the previously generated Rules.

sol1 = 
        IPX[{(num/den), 
            sol[[2]]}, {f}, "b"];
sol1[[1]]

\(\(\(\ \)\(The\ f\^0\ Coefficient\ in\ the\ denominator\ should\ be\ 1\)\)\)

tmp = First[CoefficientList[Denominator[sol1[[1]]], f]]

num = 
      Numerator[sol1[[1]]]/tmp  // Apart
den = Denominator[sol1[[1]]]/tmp  // Apart

We check the result and the rules with the original expression. Do not forget adding the rules of sol1 !

sol1 = 
        IPX[{(num/den), 
            sol1[[2]]}, {f}, "c"];
sol1[[1]]
Simplify[(ReplaceRepeated @@ sol1) == eq3]

I hope you will find this little function useful in your daily work
 and if you encounter some errors don't hesitate to send me a message.