Reputation: 2429
I have the following function -((A N1 P (A B k (a N1 + aa P - r) + a aa (b B - bb) k R + 2 A B r R))/k) -- (1)
This function can be rewritten as: - A R P N1 d/k --- (2)
where:
R is (k (aa B m - a mm + A B r))/(a aa (b B - bb) k + A B r)
P is (-a^2 b k mm - A B m r +
a k (aa bb m + A b B r))/(A (a aa (b B - bb) k + A B r))
N1 is (-aa^2 bb k m + A mm r +
aa k (a b mm - A bb r))/(A (a aa (b B - bb) k + A B r))
d is a aa (b B - bb) k + A B r
How can I make these substitutions in (1) to arrive at (2) in Mathematica?
Edit: I had made a small error in the coding for "d". I have edited the equation now.
As per suggestion, I have evaluated both expressions in (1) and (2) to ensure that it is of equal magnitude.
{a, A, aa, b, B, bb, k, m, mm, r} = RandomReal[{0, 20}, 10];
R = (k (aa B m - a mm + A B r))/(a aa (b B - bb) k + A B r);
P = (-a^2 b k mm - A B m r +
a k (aa bb m + A b B r))/(A (a aa (b B - bb) k + A B r));
N1 = (-aa^2 bb k m + A mm r +
aa k (a b mm - A bb r))/(A (a aa (b B - bb) k + A B r));
d = a aa (b B - bb) k + A B r;
{-((A N1 P (A B k (a N1 + aa P - r) + a aa (b B - bb) k R +
2 A B r R))/k), -A R P N1 d/k}
{-39976.5, -39976.5}
Upvotes: 3
Views: 1366
Reputation: 2494
I can't guarantee the following workflow will succeed universally, but it works well here. It combines three ideas: (1) polynomial algebra to get closer to a nice result; (2) substitution to expand the variables; and (3) "collapsing" combinations of the variables ("terms") into single variables.
Begin by establishing the input: variables
is just a list of the atomic variable names; terms
is a list of the values to expand R
, P
, N1
, and d
into; and x
is the original polynomial.
variables = {a, aa, b, bb, d, k, mm, r, A, B, R, P, N1};
terms = {(k (aa B m - a mm + A B r))/(a aa (b B - bb) k + A B r),
(-a^2 b k mm - A B m r + a k (aa bb m + A b B r))/(A (a aa (b B - bb) k + A B r)),
(-aa^2 bb k m + A mm r + aa k (a b mm - A bb r))/(A (a aa (b B - bb) k + A B r)),
a aa (b B - bb) k + A B r};
x = ((A N1 P (A B k (a N1 + aa P - r) + a aa (b B - bb) k R + 2 A B r R))/k);
From this information we can construct a list of replacement rules for the terms. These will carry out the substitution step.
rules = (Rule @@ #) & /@ Transpose[{{R, P, N1, d}, terms}]
For instance, the fourth component of Rules
is
d -> a aa (b B - bb) k + A B r
and the first three components are comparable expressions for R
, P
, and N1
, respectively.
PolynomialReduce
gives us a first crack at expressing x
as a (rational) linear combination of terms
plus any remainder that might fall out.
{parts, remainder} = PolynomialReduce[x, terms, variables]
{{0, 0, 0, (A N1 P R)/k}, a A^2 B N1^2 P + A^2 aa B N1 P^2 - A^2 B N1 P r + (A^2 B N1 P r R)/k}
The first piece, parts
, contains the coefficients {0, 0, 0, (A N1 P R)/k}
: the coefficients of the first three terms are zero and the coefficient of the last term (which eventually will be expressed as d
) is A N1 P R/k
, whence the result is that x
has been expanded into the linear combination 0(R) + 0(P) + 0(N1) + (A N1 P R/k) d
plus the remainder.
We have already made progress, but now it's time to work with the remainder. To do so, apply the substitution rules: Simplify[remainder /. rules]
. To recreate x
, this remainder needs to be added to the preceding linear combination. Let's do it all at once:
parts . rules [[;; , 1]] + Simplify[remainder /. rules]
(A d N1 P R)/k
Notice how using the target patterns in rules
has implicitly collapsed a aa (b B - bb) k + A B r
into d
while the rules themselves simplified the remainder to 0. In general the remainder won't get that simple--but at least it's likely to be simpler than what you started with.
I believe that general manipulation of such algebraic expressions in an effort to twist one form into another that is "simple" in some sense is an NP-hard problem, so YMMV. My experience is that you have to experiment with simplifying complex expressions and augment that with your own algebraic skills as well as your sense of what form the simplification is likely to take.
Upvotes: 2
Reputation: 3977
For a quick check, we substitute in some random numbers to try to verify the original and reformatted expressions are equal. I replace D
with d
because D
is predefined as a function in Mathematica and otherwise make no changes.
{a, A, aa, b, B, bb, k, m, mm, r}=RandomReal[{0,20},10];
R=(k (aa B m - a mm + A B r))/(a aa (b B - bb) k + A B r);
P=(-a^2 b k mm - A B m r + a k (aa bb m + A b B r))/(A (a aa (b B - bb) k + A B r));
N1=(-aa^2 bb k m + A mm r + aa k (a b mm - A bb r))/(A (a aa (b B - bb) k + A B r));
d=A (a aa (b B - bb) k + A B r);
{-((A N1 P (A B k (a N1 + aa P - r) + a aa (b B - bb) k R + 2 A B r R))/k),A R P N1 d/k}
which this time happens to give
{21112.3,-65366.1}
So the two expressions do not seem to be equal and I must have misunderstood. Can you explain what I need to do differently to verify the two expressions are equal?
Upvotes: 1