I need to find a method to transform an expression like
a^(1+m+n) b^(2+2m - 2n)
into
(a b^2)^m (a/b^2)^n (a b^2),
that is, to group terms with the same exponent. I tried using Collect[], etc, but can't get anything to work.
Any suggestions?
Thanks,
Tom
Using Log in combination with CoefficientRules:
exp = a^(1 + m + n) b^(2 + 2 m - 2 n);
Times ## (Exp[#[[2]]]^(Times ## ({n, m}^#[[1]])) & /#
CoefficientRules[PowerExpand[Log[exp]], {n, m}])
output:
a (a/b^2)^n b^2 (a b^2)^m
You can do this, for example:
log[x_*y_] := log[x] + log[y];
log[x_^y_] := y*log[x];
log1 /: a_*log1[b_] := log1[b^a];
log1 /: Plus[x__log1] := log1[Times ## Map[First, {x}]];
exp[HoldPattern[Plus[x__]]] := Times ## Map[exp, {x}];
exp[log1[x_]] := x
and then:
In[58]:= exp[Collect[Expand[log[a^(1+m+n) b^(2+2m-2n)]],{m,n}]]/.log->log1
Out[58]= a (a/b^2)^n b^2 (a b^2)^m
Related
i'm trying to Integrate the following function:
(q (1 + q) - E^-q Sinh[q])/(-q + Cosh[q] Sinh[q]) - (
2 q Tanh[q])/(-q + Cosh[q] Sinh[q])
I already solved it numerically but i really need the indefinite integral so used:
In[67]:= Integrate[(
q (1 + q) - E^-q Sinh[q])/(-q + Cosh[q] Sinh[q]) - (
2 q Tanh[q])/(-q + Cosh[q] Sinh[q]), q]
but as output i get back the integrand again:
Out[67]= \[Integral]((
q (1 + q) - E^-q Sinh[q])/(-q + Cosh[q] Sinh[q]) - (
2 q Tanh[q])/(-q + Cosh[q] Sinh[q])) \[DifferentialD]q
any suggestions on how to perform this computation correctly?
thanks in advance
You can decompose this integral:
eq = (q (1 + q) - E^-q Sinh[q])/(-q +
Cosh[q] Sinh[q]) - (2 q Tanh[q])/(-q + Cosh[q] Sinh[q]);
Integrate[#, q] & /# Simplify /# Expand[eq]
One part of this integral can be done, rest contains simplest, but still no expressed in standard mathematical functions integrals.
You can do these integrals numerically, or search approximated form, for example using series expansion.
Exemplary series expansion you can find on link:
wolframalpha.com
I'm wondering if there is a different command than FullSimplify to tell mathematica to do the computation requested. Here's three variations of a simplification attempt
FullSimplify[Re[ (-I + k Rr)] Cos[Ttheta], Element[{k, Rr, Ttheta, t, omega}, Reals]]
FullSimplify[Re[E^(I (omega t - k Rr)) ] Cos[Ttheta], Element[{k, Rr, Ttheta, t, omega}, Reals]]
FullSimplify[Re[E^(I (omega t - k Rr)) (-I + k Rr)] Cos[Ttheta], Element[{k, Rr, Ttheta, t, omega}, Reals]]
I get respectively:
k Rr Cos[Ttheta]
Cos[k Rr - omega t] Cos[Ttheta]
I (-k Rr + omega t)
Cos[Ttheta] Re[E (-I + k Rr)]
Without the exponential, the real parts get evaluated. Without the complex factor multiplying the exponential, the real parts get evaluated. With both multiplied, the input is returned as output?
I tried the // Timings modifier, and this isn't because the expression is too complex (which is good since I can do this one in my head, but this was a subset of a larger test expression that was also failing).
Since your variables are declared Reals have you tried ComplexExpand?
To redeem my slow posting here is another approach: tell Mathematica that you do not want Complex in the result via ComplexityFunction
FullSimplify[Re[E^(I (omega t - k Rr)) (-I + k Rr)] Cos[Ttheta],
Element[{k, Rr, Ttheta, t, omega}, Reals],
ComplexityFunction -> (1 - Boole#FreeQ[#, Complex] &)]
ComplexExpand, perhaps?
ComplexExpand[Re[E^(I (omega t - k Rr)) (-I + k Rr)] Cos[Ttheta]]
This Is a problem I've been having with Mathematica for a long time, combining suggestions from here I've created a new function that can be used instead of Simplify[] when dealing with complex arguments. Works for me so far, any further suggestions?
CSimplify[in_] :=
FullSimplify[in // ComplexExpand,
ComplexityFunction -> (1 - Boole#FreeQ[#, Complex] &)]
I have the following expression
(-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B))
How can I multiply both the denominator and numberator by p^(A+B), i.e. to get rid of the denominators in both numerator and denominator? I tried varous Expand, Factor, Simplify etc. but none of them worked.
Thanks!
I must say I did not understand the original question. However, while trying to understand the intriguing solution given by belisarius I came up with the following:
expr = (-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B));
Together#(PowerExpand#FunctionExpand#Numerator#expr/
PowerExpand#FunctionExpand#Denominator#expr)
Output (as given by belisarius):
Alternatively:
PowerExpand#FunctionExpand#Numerator#expr/PowerExpand#
FunctionExpand#Denominator#expr
gives
or
FunctionExpand#Numerator#expr/FunctionExpand#Denominator#expr
Thanks to belisarius for another nice lesson in the power of Mma.
If I understand you question, you may teach Mma some algebra:
r = {(k__ + Power[a_, b_]) Power[c_, b_] -> (k Power[c, b] + Power[a c, b]),
p_^(a_ + b_) q_^a_ -> p^b ( q p)^(a),
(a_ + b_) c_ -> (a c + b c)
}
and then define
s1 = ((-1 + 1/p)^B/(-1 + (-1 + 1/p)^(A + B)))
f[a_, c_] := (Numerator[a ] c //. r)/(Denominator[a ] c //. r)
So that
f[s1, p^(A + B)]
is
((1 - p)^B*p^A)/((1 - p)^(A + B) - p^(A + B))
Simplify should work, but in your case it doesn't make sense to multiply numerator and denominator by p^(A+B), it doesn't cancel denominators
I am using Mathematica 7 in the notebook interface and I want to rearrange an inequality so that I get a certain variable on one side. For eg.
FullSimplify[x^3+L+r>3x^3+2r]
Gives
L > r + 2 x^3
However, I want :
r < L-2x^3
Is there anyway we can instruct FullSimplify to order variables in a particular way? I am using Mathematica for presentation as well so, the way I arrange the variables is important to me.
Thanks
SR
Edit: I tried Reduce, while that works for this example, it does not work for the actual expression I have, I get an error saying,
This system cannot be solved with the methods available to Reduce.
Edit: here is the actual expression:
{L - (m^2 ((-2 + e)^2 \[Delta] + (5 +
2 e (-7 + 4 e)) \[Tau]) \[Omega])/(36 (2 - 3 e + e^2)^2)} > {0}
I want this to be displayed in the form of \[delta]< *something*
Thanks!
First of all, getting Mathematica to output something exactly as you would like it is something of a black art, and requires a lot of patience. That said, if you apply Reduce to your original expression, as per Belisarius, you'd get
In[1]:=Reduce[x^3 + L + r > 3 x^3 + 2 r, r, Reals]
Out[1]:= r < L - 2 x^3
However, as you pointed out, this isn't the full expression, and Reduce produces what can only be described as a less than helpful answer when applied to it. It is at this point where patience and a lot of extra processing is required. I'd start with
In[2]:=Reduce[ <full expression>, Delta, Reals] // LogicalExpand // Simplify
While this doesn't give you a clean answer, it is better than before and reveals more of the structure of your solution. (I would not use FullSimplify as that mixes Delta in with the other terms.) At this point, we need to know more about the terms themselves, and the output from In[2] is not quite as useful as we want.
I'd re-expand this with LogicalExpand which gives you twelve terms that are significantly simpler than the what Reduce alone gives. (You'll note that only the last six terms actually involve Delta, so I'd check that the variable conditions actually match those.) Selecting those last six terms only,
In[3]:=%2[[-6;;]] // Simplify
Out[3]:= m != 0
&& ((Omega > 0 && Delta < something) || (Omega > 0 && Delta < something else)
&& (1 < e < 2 || e < 1 || e > 2)
The third term is tautological, but Simplify nor FullSimplify can't seem to remove it. And we're really only interested in the middle term anyway. If Omega > 0 your expression can then be extracted via %[[2,1,2]].
Putting this all together in one expression:
In[4]:=Simplify[LogicalExpand[Reduce[<expression>, Delta, Reals]]][[-6;;]] //
Simplify // #[[2,1,2]]&
Out[4]:= Delta < something
After writing that out, I realized that there is a much simpler way to approach this. I'd redo line 2, above, as follows:
In[5]:= Reduce[ <full expression>, Delta, Reals] // LogicalExpand // Simplify //
Cases[#, ___ && Delta < _ && ___, Infinity]&
Out[5]:= {Omega > 0 && Delta < something}
Or, provided you really do know that m != 0 and Omega > 0 you can do
In[6]:= Reduce[ <expr> && m!=0 && Omega > 0, Delta, Reals ] // LogicalExpand //
Simplify // #[[2]]&
Reduce[x^3 + L + r > 3 x^3 + 2 r, r, Reals]
Will do.
As I don't use Mathematica for editing or presentation, perhaps someone else may come with some extra advice.
Edit
based on your comment, you may try:
Reduce[{L - (m^2 ((-2 + e)^2 Delta + (5 +
2 e (-7 + 4 e)) Tau) Omega)/(36 (2 - 3 e + e^2)^2) > 0}, Delta, Reals]
Where I corrected some syntax errors. But you'll find that the resulting expression is rather unpleasant. To simplify it further you need to know the valid ranges for your vars. Please post that info if you have it.
HTH!
Inspect the output of
r=Simplify[Reduce[L-(m^2((-2+e)^2\\[Delta]+(5+2e(-7+4e))\\[Tau])\\[Omega])/(36(2-3e+e^2)^2)>0,\\[Delta],Reals]]
to see that
r[[2,1,1,1]] gives \\[Delta]>expr,
but
r[[2, 1, 2, 2]] gives \\[Delta]< expr,
because the sign of \[Omega] in the denominator of expr. All this ignores the other conditions on the values of L, e, m and \[Omega] that will change the result and different versions of Mathematica may change the form of the result from Simplify[Reduce[]] which will invalidate all of this.
Part of the difficulty in reducing the expressions returned by Reduce[] and LogicalExpand[] is that the supplied expression involves division by zero when e=1 or =2.
I get something bearably compact with
Assuming[{
(L | m | e | Tau | Omega | Delta) \[Element] Reals
},
FullSimplify[
LogicalExpand[
Reduce[{L - (m^2 ((-2 + e)^2 Delta + (5 +
2 e (-7 + 4 e)) Tau) Omega)/(36 (2 - 3 e + e^2)^2) >
0}, Delta, Reals]
]
]
]
Out[]:= (L > 0 && (1 < e < 2 || e < 1 || e > 2) && (m == 0 || Omega == 0)) ||
(m != 0 && (
(Omega > 0 &&
Delta < (36 (-1 + e)^2 L)/(m^2 Omega) + ((-5 + 2 (7 - 4 e) e) Tau)/(-2 + e)^2) ||
(Delta > (36 (-1 + e)^2 L)/(m^2 Omega) + ((-5 + 2 (7 - 4 e) e) Tau)/(-2 + e)^2 &&
Omega < 0)) &&
(e > 2 || e < 1 || 1 < e < 2))
where I've expended no effort to replace symbol names with symbols.
(Why Assuming[...]? Because I'm too lazy to remember to get the same assumptions jammed into each simplification step.)
So lately I have been toying around with how Mathematica's pattern matching and term rewriting might be put to good use in compiler optimizations...trying to highly optimize short blocks of code that are the inner parts of loops. Two common ways to reduce the amount of work it takes to evaluate an expression is to identify sub-expressions that occur more than once and store the result and then use the stored result at subsequent points to save work. Another approach is to use cheaper operations where possible. For instance, my understanding is that taking square roots take more clock cycles than additions and multiplications. To be clear, I am interested in the cost in terms of floating point operations that evaluating the expression would take, not how long it takes Mathematica to evaluate it.
My first thought was that I would tackle the problem developing using Mathematica's simplify function. It is possible to specify a complexity function that compares the relative simplicity of two expressions. I was going to create one using weights for the relevant arithmetic operations and add to this the LeafCount for the expression to account for the assignment operations that are required. That addresses the reduction in strength side, but it is the elimination of common subexpressions that has me tripped up.
I was thinking of adding common subexpression elimination to the possible transformation functions that simplify uses. But for a large expression there could be many possible subexpressions that could be replaced and it won't be possible to know what they are till you see the expression. I have written a function that gives the possible substitutions, but it seems like the transformation function you specify needs to just return a single possible transformation, at least from the examples in the documentation. Any thoughts on how one might get around this limitation? Does anyone have a better idea of how simplify uses transformation functions that might hint at a direction forward?
I imagine that behind the scenes that Simplify is doing some dynamic programming trying different simplifications on different parts of the expressions and returning the one with the lowest complexity score. Would I be better off trying to do this dynamic programming on my own using common algebraic simplifications such as factor and collect?
EDIT: I added the code that generates possible sub-expressions to remove
(*traverses entire expression tree storing each node*)
AllSubExpressions[x_, accum_] := Module[{result, i, len},
len = Length[x];
result = Append[accum, x];
If[LeafCount[x] > 1,
For[i = 1, i <= len, i++,
result = ToSubExpressions2[x[[i]], result];
];
];
Return[Sort[result, LeafCount[#1] > LeafCount[#2] &]]
]
CommonSubExpressions[statements_] := Module[{common, subexpressions},
subexpressions = AllSubExpressions[statements, {}];
(*get the unique set of sub expressions*)
common = DeleteDuplicates[subexpressions];
(*remove constants from the list*)
common = Select[common, LeafCount[#] > 1 &];
(*only keep subexpressions that occur more than once*)
common = Select[common, Count[subexpressions, #] > 1 &];
(*output the list of possible subexpressions to replace with the \
number of occurrences*)
Return[common];
]
Once a common sub-expression is chosen from the list returned by CommonSubExpressions the function that does the replacement is below.
eliminateCSE[statements_, expr_] := Module[{temp},
temp = Unique["r"];
Prepend[ReplaceAll[statements, expr -> temp], temp[expr]]
]
At the risk of this question getting long, I will put a little example code up. I thought a decent expression to try to optimize would be the classical Runge-Kutta method for solving differential equations.
Input:
nextY=statements[y + 1/6 h (f[t, n] + 2 f[0.5 h + t, y + 0.5 h f[t, n]] +
2 f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]] +
f[h + t,
y + h f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]]])];
possibleTransformations=CommonSubExpressions[nextY]
transformed=eliminateCSE[nextY, First[possibleTransformations]]
Output:
{f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]],
y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]],
0.5 h f[0.5 h + t, y + 0.5 h f[t, n]],
f[0.5 h + t, y + 0.5 h f[t, n]], y + 0.5 h f[t, n], 0.5 h f[t, n],
0.5 h + t, f[t, n], 0.5 h}
statements[r1[f[0.5 h + t, y + 0.5 h f[0.5 h + t, y + 0.5 h f[t, n]]]],
y + 1/6 h (2 r1 + f[t, n] + 2 f[0.5 h + t, y + 0.5 h f[t, n]] +
f[h + t, h r1 + y])]
Finally, the code to judge the relative cost of different expressions is below. The weights are conceptual at this point as that is still an area I am researching.
Input:
cost[e_] :=
Total[MapThread[
Count[e, #1, Infinity, Heads -> True]*#2 &, {{Plus, Times, Sqrt,
f}, {1, 2, 5, 10}}]]
cost[transformed]
Output:
100
There are also some routines here implemented here by this author: http://stoney.sb.org/wordpress/2009/06/converting-symbolic-mathematica-expressions-to-c-code/
I packaged it into a *.M file and have fixed a bug (if the expression has no repeated subexpressions the it dies), and I am trying to find the author's contact info to see if I can upload his modified code to pastebin or wherever.
EDIT: I have received permission from the author to upload it and have pasted it here: http://pastebin.com/fjYiR0B3
To identify repeating subexpressions, you could use something like this
(*helper functions to add Dictionary-like functionality*)
index[downvalue_,
dict_] := (downvalue[[1]] /. HoldPattern[dict[x_]] -> x) //
ReleaseHold;
value[downvalue_] := downvalue[[-1]];
indices[dict_] :=
Map[#[[1]] /. {HoldPattern[dict[x_]] -> x} &, DownValues[dict]] //
ReleaseHold;
values[dict_] := Map[#[[-1]] &, DownValues[dict]];
items[dict_] := Map[{index[#, dict], value[#]} &, DownValues[dict]];
indexQ[dict_, index_] :=
If[MatchQ[dict[index], HoldPattern[dict[index]]], False, True];
(*count number of times each sub-expressions occurs *)
expr = Cos[x + Cos[Cos[x] + Sin[x]]] + Cos[Cos[x] + Sin[x]];
Map[(counts[#] = If[indexQ[counts, #], counts[#] + 1, 1]; #) &, expr,
Infinity];
items[counts] // Column
I tried to mimic the dictionary compression function appears on this blog: https://writings.stephenwolfram.com/2018/11/logic-explainability-and-the-future-of-understanding/
Here is what I made:
DictionaryCompress[expr_, count_, size_, func_] := Module[
{t, s, rule, rule1, rule2},
t = Tally#Level[expr, Depth[expr]];
s = Sort[
Select[{First##, Last##, Depth[First##]} & /#
t, (#[[2]] > count && #[[3]] > size) &], #1[[2]]*#1[[3]] < #2[[
2]]*#2[[2]] &];
rule = MapIndexed[First[#1] -> func ## #2 &, s];
rule = (# //. Cases[rule, Except[#]]) & /# rule;
rule1 = Select[rule, ! FreeQ[#, Plus] &];
rule2 = Complement[rule, rule1];
rule = rule1 //. (Reverse /# rule2);
rule = rule /. MapIndexed[ Last[#1] -> func ## #2 &, rule];
{
expr //. rule,
Reverse /# rule
}
];
poly = Sum[Subscript[c, k] x^k, {k, 0, 4}];
sol = Solve[poly == 0, x];
expr = x /. sol;
Column[{Column[
MapIndexed[
Style[TraditionalForm[Subscript[x, First[#2]] == #], 20] &, #[[
1]]], Spacings -> 1],
Column[Style[#, 20] & /# #[[2]], Spacings -> 1, Frame -> All]
}] &#DictionaryCompress[expr, 1, 1,
Framed[#, Background -> LightYellow] &]