(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 21741, 664]*) (*NotebookOutlinePosition[ 22395, 687]*) (* CellTagsIndexPosition[ 22351, 683]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["\<\ IPX An Improved Pattern Extractor\ \>", "Title", TextAlignment->Center], Cell["\<\ Frank Kronmueller frank.kronmueller@ieee.org Version 1.2 (25.01.2000)\ \>", "Text", TextAlignment->Center, FontSize->14], Cell[TextData[{ "\n", StyleBox["T", FontSize->24], "his package simplifies arbitrary expressions according to one or more \ given variables.\nSometimes Mathematica returns huge output equations which \ are hard to examine. \n\nThe function IPX[ ] replaces all Terms and \ Coefficients that contain none of the given \nvariables with ONE replacement \ variable.\nThe result is a more readable expression in terms of the given \ variables.\n\nThe expression manipulations such as Simplify, Together... are \ more effective,\nbecause you can see an existing pattern.\n", "Furthermore the simplified expression makes a coefficient comparison \ possible.", "\n\nThis notebook contains some examples of the usage of IPX[]." }], "Text"], Cell[CellGroupData[{ Cell["Load the Package", "Subsubtitle"], Cell["\<\ Complete the following command with the Path to Package IPX.m.\ \>", "Text"], Cell[BoxData[ \(SetDirectory[]\)], "Input"], Cell["This loads the Package", "Text"], Cell[BoxData[ \(<< IPX.m\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Some Examples", "Subsubtitle"], Cell["This is demo expression No.1", "Text"], Cell[BoxData[ \(\(eq1 = 1 + \[ExponentialE]\^h + h + x + \[ExponentialE]\^\(k\ x\)\ x + 7\ g\ h\^2\ x + 2\ x\^3 + b\ x\^a + x\ Sin[1 - g + \ x] + Sin[1 + x\^3];\)\)], "Input", Background->GrayLevel[0.900008]], Cell["\<\ 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}}. \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(sol = IPX[eq1, x, "\"]\), "\[IndentingNewLine]", \(sol[\([1]\)]\ \ (*\ Equation\ *) \), "\[IndentingNewLine]", \(sol[\([2]\)]\ (*\ Replacement\ Rules\ for\ Equation\ *) \)}], "Input"], Cell[BoxData[ \({q1 + x + \[ExponentialE]\^\(k\ x\)\ x + q2\ x + 2\ x\^3 + b\ x\^a + x\ Sin[q3 + x] + Sin[1 + x\^3], {q1 \[Rule] 1 + \[ExponentialE]\^h + h, q2 \[Rule] 7\ g\ h\^2, q3 \[Rule] 1 - g}}\)], "Output"], Cell[BoxData[ \(q1 + x + \[ExponentialE]\^\(k\ x\)\ x + q2\ x + 2\ x\^3 + b\ x\^a + x\ Sin[q3 + x] + Sin[1 + x\^3]\)], "Output"], Cell[BoxData[ \({q1 \[Rule] 1 + \[ExponentialE]\^h + h, q2 \[Rule] 7\ g\ h\^2, q3 \[Rule] 1 - g}\)], "Output"] }, Open ]], Cell["\<\ 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:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq1]\)], "Input"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["\<\ Note the different handling of the returned data below. Now we want to examine our Expression regarding {g,h}\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\({ex, rep} = IPX[eq1, {g, h}, "\"];\)\), "\[IndentingNewLine]", \(ex\), "\[IndentingNewLine]", \(Simplify[\((ex\ //. rep\ )\) \[Equal] eq1]\)}], "Input"], Cell[BoxData[ \(\[ExponentialE]\^h + h + q4 + g\ h\^2\ q5 - x\ Sin[g - q6]\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["and {h} alone:", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[eq1, {h}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq1]\)}], "Input"], Cell[BoxData[ \(\[ExponentialE]\^h + h + q7 + h\^2\ q8\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["Now we give a Symbol instead of a String to repvar", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[eq1, {g}, q];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq1]\)}], "Input"], Cell[BoxData[ \(q$636 + g\ q$640 - x\ Sin[g - q$650]\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["We can also process Equations,", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(eq2 = eq1 \[Equal] Take[eq1, 6]\)], "Input"], Cell[BoxData[ \(1 + \[ExponentialE]\^h + h + x + \[ExponentialE]\^\(k\ x\)\ x + 7\ g\ h\^2\ x + 2\ x\^3 + b\ x\^a + x\ Sin[1 - g + x] + Sin[1 + x\^3] == 1 + \[ExponentialE]\^h + h + x + \[ExponentialE]\^\(k\ x\)\ x + 7\ g\ h\^2\ x\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[eq2, {x}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq2]\)}], "Input"], Cell[BoxData[ \(w12 + x + \[ExponentialE]\^\(k\ x\)\ x + w13\ x + 2\ x\^3 + b\ x\^a + x\ Sin[w14 + x] + Sin[1 + x\^3] == w12 + x + \[ExponentialE]\^\(k\ x\)\ x + w13\ x\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["...Rules...", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(eq2 = tar \[Rule] eq1;\)\), "\[IndentingNewLine]", \(\(sol = IPX[eq2, {k}, w];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq2]\)}], "Input"], Cell[BoxData[ \(tar \[Rule] w$736 + \[ExponentialE]\^\(k\ x\)\ x\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["and all other Functions.", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(eq2 = Oops[eq1];\)\), "\[IndentingNewLine]", \(\(sol = IPX[eq2, {b}, w];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq2]\)}], "Input"], Cell[BoxData[ \(Oops[w$753 + b\ w$757]\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell[TextData[StyleBox["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)\n\n\ The Function IPX don't use any Expand, Simplify or other manipulating \ functions.\nThe manipulation of the structure, such as eliminating brackets, \ collecting terms etc. is up to you. \nIf your result contains terms such...+ \ (a1* a2)+... just do another IPX and they will be replaced. \n", FontWeight->"Bold"]], "Text"], Cell["\<\ 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 \[Rule] 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 \ \>", "Text"], Cell[BoxData[ \(\(gensol\ = \ DSolve[\ {wwh\ \(Th'\)[x]\ == \ k\ A\ \((Tk[x]\ - Th[x])\)\ - \ lambda\ \(\(Th'\)'\)[ x], \n\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ wwk\ \(Tk'\)[ x]\ == \ k\ A\ \((\ Tk\ [x] - \ Th[x])\)\ }, \ {\ Th[x], Tk[x]}, \ x];\)\)], "Input", Background->GrayLevel[0.900008]], Cell["\<\ 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]\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(eq3 = \(Th[x]\ /. \ gensol[\([1, 1]\)]\)\ /. {C[1] \[Rule] C1, C[2] \[Rule] C2, C[3] \[Rule] C3};\)\), "\[IndentingNewLine]", \(LeafCount[eq3]\)}], "Input"], Cell[BoxData[ \(1115\)], "Output"] }, Open ]], Cell["Take a closer look and then better remove the output.", "Text"], Cell[BoxData[ \(eq3\)], "Input"], Cell["\<\ 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.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[eq3, {x}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\)}], "Input"], Cell[BoxData[ \(C1\ \((w1 + \[ExponentialE]\^\(w3\ x\)\ w2 + \[ExponentialE]\^\(w5\ x\)\ \ w4)\) + C2\ \((w6 + \[ExponentialE]\^\(w3\ x\)\ w7 + \[ExponentialE]\^\(w5\ x\)\ \ w8)\) + C3\ \((\[ExponentialE]\^\(w3\ x\)\ w10 + \[ExponentialE]\^\(w5\ x\)\ \ w11 + w9)\)\)], "Output"] }, Open ]], Cell["\<\ 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)\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sol[\([1]\)] = Together[\ sol[\([1]\)]\ ]\)], "Input"], Cell[BoxData[ \(C1\ w1 + C3\ \[ExponentialE]\^\(w3\ x\)\ w10 + C3\ \[ExponentialE]\^\(w5\ x\)\ w11 + C1\ \[ExponentialE]\^\(w3\ x\)\ w2 + C1\ \[ExponentialE]\^\(w5\ x\)\ w4 + C2\ w6 + C2\ \[ExponentialE]\^\(w3\ x\)\ w7 + C2\ \[ExponentialE]\^\(w5\ x\)\ w8 + C3\ w9\)], "Output"] }, Open ]], Cell["\<\ 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\".\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[sol, {x}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\)}], "Input"], Cell[BoxData[ \(v1 + \[ExponentialE]\^\(w3\ x\)\ v2 + \[ExponentialE]\^\(w5\ x\)\ v3 + \ \[ExponentialE]\^\(w3\ x\)\ v4 + \[ExponentialE]\^\(w5\ x\)\ v5 + \ \[ExponentialE]\^\(w3\ x\)\ v6 + \[ExponentialE]\^\(w5\ x\)\ v7\)], "Output"] }, Open ]], Cell["A Simplify will be effective now.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sol[\([1]\)] = Simplify[%]\)], "Input"], Cell[BoxData[ \(v1 + \[ExponentialE]\^\(w3\ x\)\ \((v2 + v4 + v6)\) + \[ExponentialE]\^\(w5\ x\)\ \((v3 + v5 + v7)\)\)], "Output"] }, Open ]], Cell["\<\ This look rather good, but a another IPX will replace the last terms in \ Brackets and show us some of the replacement rules\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[sol, {x}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(Take[sol[\([2]\)], \(-8\)]\ \ \), "\[IndentingNewLine]", \(LeafCount[sol[\([1]\)]]\)}], "Input"], Cell[BoxData[ \(v1 + \[ExponentialE]\^\(w3\ x\)\ v8 + \[ExponentialE]\^\(w5\ x\)\ \ v9\)], "Output"], Cell[BoxData[ \({v2 \[Rule] C3\ w10, v3 \[Rule] C3\ w11, v4 \[Rule] C1\ w2, v5 \[Rule] C1\ w4, v6 \[Rule] C2\ w7, v7 \[Rule] C2\ w8, v8 \[Rule] v2 + v4 + v6, v9 \[Rule] v3 + v5 + v7}\)], "Output"], Cell[BoxData[ \(16\)], "Output"] }, Open ]], Cell[TextData[{ "This is of the above mentioned form \n\n ", StyleBox[" k0+ k1 Exp[a1 x]+ k2 Exp[a2 x] ", FontWeight->"Bold"], "\n\nWe doublecheck this remarkable result.\nWarning! Should only \ rePerformed on PII-350 or faster with some Memory\n" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq3]\)], "Input"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["\<\ The last expression is a Transfer Function of an electrical network, which \ gives us Polynoms of higher order.\ \>", "Text"], Cell[BoxData[ \(\(eq3 = \((\(-\(\(2\ I\ Chp\ f\ \[Pi]\)\/\(R\ Rhp\)\)\) + \(2\ I\ Chp\ \ f\ \[Pi]\ v0\)\/\(\((1 + \(I\ f\)\/f0)\)\ Rhp\ Zout\) + \(2\ I\ Clrd\ f\ \ \[Pi]\ 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\ \[Pi]\ Rhp)\)\ Zout\ \))\)/\((\(4\ Chp\ Clrd\ f\^2\ \[Pi]\^2\)\/R - \(2\ I\ Chp\ f\ \[Pi]\)\/\(R\ \ Rhp\) - \(2\ I\ Clrd\ f\ \[Pi]\)\/\(R\ Rhp\) - \(2\ I\ Chp\ f\ gm\ \ \[Pi]\)\/\(R\ \((1 + 2\ I\ Chp\ f\ \[Pi]\ Rhp)\)\) - gm\/\(R\ Rhp\ \((1 + 2\ I\ Chp\ f\ \[Pi]\ Rhp)\)\) - \(2\ I\ \ Chp\ f\ \[Pi]\)\/\(R\ Zin\) - \(2\ I\ Clrd\ f\ \[Pi]\)\/\(R\ Zin\) - gm\/\(R\ \((1 + 2\ I\ Chp\ f\ \[Pi]\ Rhp)\)\ Zin\) + \(4\ Chp\ \ Clrd\ f\^2\ \[Pi]\^2\)\/Zout - \(2\ I\ Chp\ f\ \[Pi]\)\/\(R\ Zout\) - \(2\ I\ \ Chp\ f\ \[Pi]\)\/\(Rhp\ Zout\) - \(2\ I\ Clrd\ f\ \[Pi]\)\/\(Rhp\ Zout\) - 1\/\(R\ Rhp\ Zout\) - \(2\ I\ Chp\ f\ gm\ \[Pi]\)\/\(\((1 + 2\ \ I\ Chp\ f\ \[Pi]\ Rhp)\)\ Zout\) - gm\/\(Rhp\ \((1 + 2\ I\ Chp\ f\ \[Pi]\ Rhp)\)\ Zout\) - \(2\ I\ \ Chp\ f\ \[Pi]\ v0\)\/\(\((1 + \(I\ f\)\/f0)\)\ R\ Zout\) - \(2\ I\ Chp\ f\ \ \[Pi]\)\/\(Zin\ Zout\) - \(2\ I\ Clrd\ f\ \[Pi]\)\/\(Zin\ Zout\) - 1\/\(R\ Zin\ Zout\) - gm\/\(\((1 + 2\ I\ Chp\ f\ \[Pi]\ Rhp)\)\ Zin\ Zout\))\);\)\)], \ "Input", Background->GrayLevel[0.900008]], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol = IPX[eq3, {f}, "\"];\)\), "\[IndentingNewLine]", \(sol[\([1]\)]\), "\[IndentingNewLine]", \(sol[\([2]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol)\) \[Equal] eq3]\)}], "Input"], Cell[BoxData[ \(\((a1\ f + a5\/\(1 + a3\ f\) + \(a2\ f\)\/\(1 + a3\ f\) + \(a4\ f\)\/\(1 + a3\ \ f\) + a6\/\(\((1 + a3\ f)\)\ \((1 + a7\ f)\)\))\)/\((a8 + a1\ f + a10\ f + a13\ f + a14\ f + a17\ f + a18\ f + a19\ f + a23\ f + a24\ f + a16\ f\^2 + a9\ f\^2 + \(a22\ f\)\/\(1 + a3\ f\) + a12\/\(1 + a7\ f\) + a15\/\(1 + a7\ f\) + a21\/\(1 + a7\ f\) + a25\/\(1 + a7\ f\) + \(a11\ f\)\/\(1 + a7\ f\) + \(a20\ f\)\/\(1 + \ a7\ f\))\)\)], "Output"], Cell[BoxData[ \({a1 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\)\/\(R\ Rhp\)\)\), a2 \[Rule] \(2\ \[ImaginaryI]\ Chp\ \[Pi]\ v0\)\/\(Rhp\ Zout\), a3 \[Rule] \[ImaginaryI]\/f0, a4 \[Rule] \(2\ \[ImaginaryI]\ Clrd\ \[Pi]\ v0\)\/\(Rhp\ Zout\), a5 \[Rule] v0\/\(R\ Rhp\ Zout\), a6 \[Rule] \(gm\ v0\)\/\(Rhp\ Zout\), a7 \[Rule] 2\ \[ImaginaryI]\ Chp\ \[Pi]\ Rhp, a8 \[Rule] \(-\(1\/\(R\ Rhp\ Zout\)\)\) - 1\/\(R\ Zin\ Zout\), a9 \[Rule] \(4\ Chp\ Clrd\ \[Pi]\^2\)\/R, a10 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Clrd\ \[Pi]\)\/\(R\ Rhp\)\)\), a11 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ gm\ \[Pi]\)\/R\)\), a12 \[Rule] \(-\(gm\/\(R\ Rhp\)\)\), a13 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\)\/\(R\ Zin\)\)\), a14 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Clrd\ \[Pi]\)\/\(R\ Zin\)\)\), a15 \[Rule] \(-\(gm\/\(R\ Zin\)\)\), a16 \[Rule] \(4\ Chp\ Clrd\ \[Pi]\^2\)\/Zout, a17 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\)\/\(R\ Zout\)\)\), a18 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\)\/\(Rhp\ Zout\)\)\), a19 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Clrd\ \[Pi]\)\/\(Rhp\ Zout\)\)\), a20 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ gm\ \[Pi]\)\/Zout\)\), a21 \[Rule] \(-\(gm\/\(Rhp\ Zout\)\)\), a22 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\ v0\)\/\(R\ Zout\)\)\), a23 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Chp\ \[Pi]\)\/\(Zin\ Zout\)\)\), a24 \[Rule] \(-\(\(2\ \[ImaginaryI]\ Clrd\ \[Pi]\)\/\(Zin\ Zout\)\)\), a25 \[Rule] \(-\(gm\/\(Zin\ Zout\)\)\)}\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["We combine these terms into polynominals,", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(tmp = Together[sol[\([1]\)]]\)], "Input"], Cell[BoxData[ \(\((a5 + a6 + a1\ f + a2\ f + a4\ f + a5\ a7\ f + a1\ a3\ f\^2 + a1\ a7\ f\^2 + a2\ a7\ f\^2 + a4\ a7\ f\^2 + a1\ a3\ a7\ f\^3)\)/\((a12 + a15 + a21 + a25 + a8 + a1\ f + a10\ f + a11\ f + a13\ f + a14\ f + a17\ f + a18\ f + a19\ f + a20\ f + a22\ f + a23\ f + a24\ f + a12\ a3\ f + a15\ a3\ f + a21\ a3\ f + a25\ a3\ f + a3\ a8\ f + a7\ a8\ f + a16\ f\^2 + a1\ a3\ f\^2 + a10\ a3\ f\^2 + a11\ a3\ f\^2 + a13\ a3\ f\^2 + a14\ a3\ f\^2 + a17\ a3\ f\^2 + a18\ a3\ f\^2 + a19\ a3\ f\^2 + a20\ a3\ f\^2 + a23\ a3\ f\^2 + a24\ a3\ f\^2 + a1\ a7\ f\^2 + a10\ a7\ f\^2 + a13\ a7\ f\^2 + a14\ a7\ f\^2 + a17\ a7\ f\^2 + a18\ a7\ f\^2 + a19\ a7\ f\^2 + a22\ a7\ f\^2 + a23\ a7\ f\^2 + a24\ a7\ f\^2 + a3\ a7\ a8\ f\^2 + a9\ f\^2 + a16\ a3\ f\^3 + a16\ a7\ f\^3 + a1\ a3\ a7\ f\^3 + a10\ a3\ a7\ f\^3 + a13\ a3\ a7\ f\^3 + a14\ a3\ a7\ f\^3 + a17\ a3\ a7\ f\^3 + a18\ a3\ a7\ f\^3 + a19\ a3\ a7\ f\^3 + a23\ a3\ a7\ f\^3 + a24\ a3\ a7\ f\^3 + a3\ a9\ f\^3 + a7\ a9\ f\^3 + a16\ a3\ a7\ f\^4 + a3\ a7\ a9\ f\^4)\)\)], "Output"] }, Open ]], Cell[" collect all Powers of f in Numerator and Denominator", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(num = Collect[Numerator[tmp], {1, f, f\^2, f\^3}]\), "\[IndentingNewLine]", \(den = Collect[Denominator[tmp], {1, f, f\^2, f\^3, f\^4}]\)}], "Input"], Cell[BoxData[ \(a5 + a6 + \((a1 + a2 + a4 + a5\ a7)\)\ f + \((a1\ a3 + a1\ a7 + a2\ a7 + a4\ a7)\)\ f\^2 + a1\ a3\ a7\ f\^3\)], "Output"], Cell[BoxData[ \(a12 + a15 + a21 + a25 + a8 + \((a1 + a10 + a11 + a13 + a14 + a17 + a18 + a19 + a20 + a22 + a23 + a24 + a12\ a3 + a15\ a3 + a21\ a3 + a25\ a3 + a3\ a8 + a7\ a8)\)\ f + \((a16 + a1\ a3 + a10\ a3 + a11\ a3 + a13\ a3 + a14\ a3 + a17\ a3 + a18\ a3 + a19\ a3 + a20\ a3 + a23\ a3 + a24\ a3 + a1\ a7 + a10\ a7 + a13\ a7 + a14\ a7 + a17\ a7 + a18\ a7 + a19\ a7 + a22\ a7 + a23\ a7 + a24\ a7 + a3\ a7\ a8 + a9)\)\ f\^2 + \((a16\ a3 + a16\ a7 + a1\ a3\ a7 + a10\ a3\ a7 + a13\ a3\ a7 + a14\ a3\ a7 + a17\ a3\ a7 + a18\ a3\ a7 + a19\ a3\ a7 + a23\ a3\ a7 + a24\ a3\ a7 + a3\ a9 + a7\ a9)\)\ f\^3 + \((a16\ a3\ a7 + a3\ a7\ a9)\)\ f\^4\)], "Output"] }, Open ]], Cell["\<\ and do another IPX. Note that we create a composite Object of the form {expr,{rules}} in order to keep the previously generated Rules.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol1 = IPX[{num\/den, sol[\([2]\)]}, {f}, "\"];\)\), "\[IndentingNewLine]", \(sol1[\([1]\)]\)}], "Input"], Cell[BoxData[ \(\(b1 + b2\ f + b3\ f\^2 + b4\ f\^3\)\/\(b5 + b6\ f + b7\ f\^2 + b8\ \ f\^3 + b9\ f\^4\)\)], "Output"] }, Open ]], Cell[BoxData[ \(\(\(\ \)\(The\ f\^0\ Coefficient\ in\ the\ denominator\ should\ be\ 1\)\ \)\)], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(tmp = First[CoefficientList[Denominator[sol1[\([1]\)]], f]]\)], "Input"], Cell[BoxData[ \(b5\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ \(num = Numerator[sol1[\([1]\)]]/tmp\ // Apart\), "\[IndentingNewLine]", \(den = Denominator[sol1[\([1]\)]]/tmp\ // Apart\)}], "Input"], Cell[BoxData[ \(b1\/b5 + \(b2\ f\)\/b5 + \(b3\ f\^2\)\/b5 + \(b4\ f\^3\)\/b5\)], \ "Output"], Cell[BoxData[ \(1 + \(b6\ f\)\/b5 + \(b7\ f\^2\)\/b5 + \(b8\ f\^3\)\/b5 + \(b9\ \ f\^4\)\/b5\)], "Output"] }, Open ]], Cell[TextData[{ "We check the result and the rules with the original expression. Do not \ forget adding the rules of ", StyleBox["sol1", FontSlant->"Italic"], " !" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(sol1 = IPX[{num\/den, sol1[\([2]\)]}, {f}, "\"];\)\), "\[IndentingNewLine]", \(sol1[\([1]\)]\), "\[IndentingNewLine]", \(Simplify[\((ReplaceRepeated @@ sol1)\) \[Equal] eq3]\)}], "Input"], Cell[BoxData[ \(\(c1 + c2\ f + c3\ f\^2 + c4\ f\^3\)\/\(1 + c5\ f + c6\ f\^2 + c7\ f\^3 \ + c8\ f\^4\)\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell["\<\ 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. \ \>", "Text"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1152}, {0, 819}}, WindowSize->{594, 528}, WindowMargins->{{79, Automatic}, {Automatic, 7}} ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1739, 51, 83, 4, 150, "Title"], Cell[1825, 57, 137, 8, 114, "Text"], Cell[1965, 67, 745, 14, 273, "Text"], Cell[CellGroupData[{ Cell[2735, 85, 39, 0, 53, "Subsubtitle"], Cell[2777, 87, 86, 2, 33, "Text"], Cell[2866, 91, 47, 1, 30, "Input"], Cell[2916, 94, 38, 0, 33, "Text"], Cell[2957, 96, 41, 1, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[3035, 102, 36, 0, 42, "Subsubtitle"], Cell[3074, 104, 44, 0, 33, "Text"], Cell[3121, 106, 245, 5, 47, "Input"], Cell[3369, 113, 241, 7, 109, "Text"], Cell[CellGroupData[{ Cell[3635, 124, 220, 3, 70, "Input"], Cell[3858, 129, 243, 4, 48, "Output"], Cell[4104, 135, 139, 2, 29, "Output"], Cell[4246, 139, 121, 2, 29, "Output"] }, Open ]], Cell[4382, 144, 166, 5, 71, "Text"], Cell[CellGroupData[{ Cell[4573, 153, 84, 1, 30, "Input"], Cell[4660, 156, 38, 1, 29, "Output"] }, Open ]], Cell[4713, 160, 133, 3, 52, "Text"], Cell[CellGroupData[{ Cell[4871, 167, 190, 3, 70, "Input"], Cell[5064, 172, 92, 1, 29, "Output"], Cell[5159, 175, 38, 1, 29, "Output"] }, Open ]], Cell[5212, 179, 30, 0, 33, "Text"], Cell[CellGroupData[{ Cell[5267, 183, 199, 3, 70, "Input"], Cell[5469, 188, 72, 1, 29, "Output"], Cell[5544, 191, 38, 1, 29, "Output"] }, Open ]], Cell[5597, 195, 66, 0, 33, "Text"], Cell[CellGroupData[{ Cell[5688, 199, 193, 3, 70, "Input"], Cell[5884, 204, 70, 1, 29, "Output"], Cell[5957, 207, 38, 1, 29, "Output"] }, Open ]], Cell[6010, 211, 46, 0, 33, "Text"], Cell[CellGroupData[{ Cell[6081, 215, 64, 1, 30, "Input"], Cell[6148, 218, 282, 5, 48, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[6467, 228, 199, 3, 70, "Input"], Cell[6669, 233, 202, 3, 48, "Output"], Cell[6874, 238, 38, 1, 29, "Output"] }, Open ]], Cell[6927, 242, 27, 0, 33, "Text"], Cell[CellGroupData[{ Cell[6979, 246, 253, 4, 90, "Input"], Cell[7235, 252, 82, 1, 29, "Output"], Cell[7320, 255, 38, 1, 29, "Output"] }, Open ]], Cell[7373, 259, 40, 0, 33, "Text"], Cell[CellGroupData[{ Cell[7438, 263, 247, 4, 90, "Input"], Cell[7688, 269, 56, 1, 29, "Output"], Cell[7747, 272, 38, 1, 29, "Output"] }, Open ]], Cell[7800, 276, 549, 7, 147, "Text"], Cell[8352, 285, 374, 14, 242, "Text"], Cell[8729, 301, 389, 8, 66, "Input"], Cell[9121, 311, 230, 4, 52, "Text"], Cell[CellGroupData[{ Cell[9376, 319, 199, 3, 50, "Input"], Cell[9578, 324, 38, 1, 29, "Output"] }, Open ]], Cell[9631, 328, 69, 0, 33, "Text"], Cell[9703, 330, 36, 1, 30, "Input"], Cell[9742, 333, 144, 3, 52, "Text"], Cell[CellGroupData[{ Cell[9911, 340, 114, 2, 50, "Input"], Cell[10028, 344, 296, 6, 48, "Output"] }, Open ]], Cell[10339, 353, 166, 4, 52, "Text"], Cell[CellGroupData[{ Cell[10530, 361, 74, 1, 30, "Input"], Cell[10607, 364, 317, 6, 48, "Output"] }, Open ]], Cell[10939, 373, 220, 5, 71, "Text"], Cell[CellGroupData[{ Cell[11184, 382, 114, 2, 50, "Input"], Cell[11301, 386, 238, 3, 29, "Output"] }, Open ]], Cell[11554, 392, 49, 0, 33, "Text"], Cell[CellGroupData[{ Cell[11628, 396, 59, 1, 30, "Input"], Cell[11690, 399, 160, 3, 29, "Output"] }, Open ]], Cell[11865, 405, 148, 4, 52, "Text"], Cell[CellGroupData[{ Cell[12038, 413, 235, 4, 90, "Input"], Cell[12276, 419, 104, 2, 29, "Output"], Cell[12383, 423, 214, 3, 48, "Output"], Cell[12600, 428, 36, 1, 29, "Output"] }, Open ]], Cell[12651, 432, 274, 6, 147, "Text"], Cell[CellGroupData[{ Cell[12950, 442, 84, 1, 30, "Input"], Cell[13037, 445, 38, 1, 29, "Output"] }, Open ]], Cell[13090, 449, 136, 4, 52, "Text"], Cell[13229, 455, 1454, 22, 401, "Input"], Cell[CellGroupData[{ Cell[14708, 481, 245, 4, 90, "Input"], Cell[14956, 487, 501, 8, 137, "Output"], Cell[15460, 497, 1594, 24, 306, "Output"], Cell[17057, 523, 38, 1, 29, "Output"] }, Open ]], Cell[17110, 527, 57, 0, 33, "Text"], Cell[CellGroupData[{ Cell[17192, 531, 61, 1, 30, "Input"], Cell[17256, 534, 1210, 17, 220, "Output"] }, Open ]], Cell[18481, 554, 71, 0, 33, "Text"], Cell[CellGroupData[{ Cell[18577, 558, 182, 3, 52, "Input"], Cell[18762, 563, 161, 3, 29, "Output"], Cell[18926, 568, 793, 12, 181, "Output"] }, Open ]], Cell[19734, 583, 158, 3, 52, "Text"], Cell[CellGroupData[{ Cell[19917, 590, 159, 4, 61, "Input"], Cell[20079, 596, 121, 2, 45, "Output"] }, Open ]], Cell[20215, 601, 107, 2, 31, "Text"], Cell[CellGroupData[{ Cell[20347, 607, 92, 1, 30, "Input"], Cell[20442, 610, 36, 1, 29, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[20515, 616, 168, 3, 50, "Input"], Cell[20686, 621, 96, 2, 45, "Output"], Cell[20785, 625, 110, 2, 45, "Output"] }, Open ]], Cell[20910, 630, 185, 6, 33, "Text"], Cell[CellGroupData[{ Cell[21120, 640, 246, 5, 81, "Input"], Cell[21369, 647, 120, 2, 45, "Output"], Cell[21492, 651, 38, 1, 29, "Output"] }, Open ]], Cell[21545, 655, 168, 5, 90, "Text"] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)