Mathematica collect a common factor not yet explicit - wolfram-mathematica

Suppose I have an expression of the form
x^2Coth[y] + 2xyCoth[y] + y^2Coth[y],
this is equal to
(x - y)^2Coth[y].
Is there a way to ask Mathematica to do this collection? That is, something like
Collect[x^2Coth[y] + 2xyCoth[y] + y^2Coth[y], x - y]
giving output (x - y)^2Coth[y] ?
Thanks!

This uses Rojo's solution. There may be a simpler way.
expr = x^2 Coth[y] + 2 x y Coth[y] + y^2 Coth[y];
var = Coth[y];
doThat[expr_, vars_List] := Expand[Simplify[
expr /. Flatten[Solve[# == ToString##, First#Variables##] & /# vars]],
Alternatives ## ToString /# vars] /. Thread[ToString /# vars -> vars];
doThat[expr, {var}]
(* (x + y)^2 Coth[y] *)
Edit
Indeed there is a simpler way:
Collect[expr, var, Factor]
(* (x + y)^2 Coth[y] *)

Related

Mathematica: Leaving as constants

I was going to simplify an equation with three variables (s, a, b) using Mathematica as follows:
In[3]:= f[s_] := ((1/4)*(s + s^2 + s^3 + s^4)*[a*(s^3 - s) +
b*(s^3 - s^2)])/(s^3 - (1/4)*(s + s^2 + s^3 + s^4))
In[4]:= Simplify[f[s_]]
Out[4]:= s_ (1 + s_ + s_^2)
As you can see, in the simplified version does not have 'a' and 'b'. I am sure that they should not be removed during simplification process. I am wondering what I am missing...
Thank you in advance!!!
Square brackets have very precise meaning in Mathematica and can't be used in place of parens. Likewise underscores can only be used in very specific ways.
Try this
f[s_] := (1/4*(s+s^2+s^3+s^4)*(a*(s^3-s)+b*(s^3-s^2)))/(s^3-1/4*(s+s^2+s^3+s^4));
Simplify[f[s]]
which gives you this
-((s*(a + a*s + b*s)*(1 + s + s^2 + s^3))/(-1 - 2*s + s^2))

mathematica, picking our linear terms from an equation

so I'm trying to pick out the linear terms in an expression - for example if I say
eqn = dy/dt + y == y^2
, dy/dt+y is linear and y^2 is non linear.
I know in this case I can just use
eqn[[1]] to pull out the lhs and have that be my linear terms, but is there some way I can use a string pattern or something to get the linear parts of any entered equation?
This is some quick solution I came up with. You may need to change this for your purposes, but maybe it is a possibility. First the terms are converted into a string. This is then searched for "+" or "-" and separated. The individual terms are tested for linearity.
terms = y + y^2 - Sqrt[y];
string = ToString[terms, InputForm];
split = StringSplit[string, {"+", "-"}];
Do[
(*Take term i and convert the string to an expression*)
exp = ToExpression[split[[i]]];
Print[exp];
(*Test for Additivity: f(x+y)= f(x)+f(y)*)
pexp = exp /. {y -> y + c};(*f(x+y)*)
cexp = exp /. {y -> c};(*f(y)*)
test1 = pexp - (exp + cexp) // Simplify;(*f(x+y)-(f(x)+f(y))*)
(*Test for Homogeneity: f(a*x) = a*f(x)*)
aexp = exp /. {y -> a*y};(*f(a*x)*)
test2 = a*exp - aexp // Simplify;(*a*f(x)-f(a*x)*)
If[test1 == 0 && test2 == 0,
Print["linear"]]
, {i, 1, Length[split]}]

How to replace implicit subexpressions in Mathematica?

I have this expression in Mathematica:
(a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) + 1
As you can see, the expression has a couple of subexpressions that repeat throughout it.
I want to be able to replace a/(b^2+c^2) with d and alpha+beta with gamma.
The final expression should then be:
1+d*gamma+a*d*gamma^2
I have much more complicated expressions where being able to do this would greatly simplify my work.
I have tried Googling this question, and I only find answers that use FactorTerms and ReplaceRepeated, but do not work consistently and for a more complicated expression like this one. I am hoping that someone here has the answer.
The hard part for the case at hand is the rule for d. Perhaps, there are simpler ways to do it, but one way is to expand the powers to products, to make it work. Let's say this is your expression:
expr = (a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) + 1
and these are the rules one would naively write:
rules = {a/(b^2 + c^2) -> d, alpha + beta -> gamma}
What we would like to do now is to expand powers to products, in both expr and rules. The problem is that even if we do, they will auto-evaluate back to powers. To prevent that, we'll need to wrap them into, for example, Hold. Here is a function which will help us:
Clear[withExpandedPowers];
withExpandedPowers[expr_, f_: Hold] :=
Module[{times},
Apply[f,
Hold[expr] /. x_^(n_Integer?Positive) :>
With[{eval = times ## Table[x, {n}]}, eval /; True] /.
times -> Times //.
HoldPattern[Times[left___, Times[middle__], right___]] :>
Times[left, middle, right]]];
For example:
In[39]:= withExpandedPowers[expr]
Out[39]= Hold[1+(a (alpha+beta))/(b b+c c)+((alpha+beta) (alpha+beta) a a)/(b b+c c)]
The following will then do the job:
In[40]:=
ReleaseHold[
withExpandedPowers[expr] //.
withExpandedPowers[Map[MapAt[HoldPattern, #, 1] &, rules], Identity]]
Out[40]= 1 + d gamma + a d gamma^2
We had to additionally wrap the l.h.s. of rules in HoldPattern, to prevent products from collapsing back to powers there.
This is just one case where we had to fight the auto-simplification mechanism of Mathematica, but for this sort of problems this will be the main obstacle. I can't assess how robust this will be for larger and more complex expressions.
Using ReplaceRepeated:
(a^2 (alpha + beta)^2)/(b^2 + c^2) + (a (alpha + beta))/(b^2 + c^2) +
1 //. {a/(b^2 + c^2) -> d, alpha + beta -> gamma}
Or using TransformationFunctions:
FullSimplify[(a^2 (alpha + beta)^2)/(b^2 +
c^2) + (a (alpha + beta))/(b^2 + c^2) + 1,
TransformationFunctions -> {Automatic, # /.
a/(b^2 + c^2) -> d &, # /. alpha + beta -> gamma &}]
Both give:
1 + gamma (d + (a^2 gamma)/(b^2 + c^2))
I modestly --- I am not a computer scientist --- think this is simpler than all other proposed solutions
1+a(alpha+beta)/(b^2 + c^2) +a^2(alpha+beta)^2/(b^2 + c^2) \\.
{a^2-> a z, a/(b^2 + c^2)-> d,alpha+\beta -> gamma,z-> a}

Best character assignment method in Mathematica

Running into a problem with the following example code for which I hope there is a way around.
Say I have defined a function:
f[x_,y_,z_] = x + y + z + x Log[x] + y Log[y] +z Log[z]
and I was to assign
f[x_,y_,z_] = x + y + z + x Log[x] + y Log[y] +z Log[z]//.x->1//.y->1//.z->0
But rather than have Mathematica replace z with 0 I just want z to be ignored to give the result f[x_,y_] = 2 without having to define a new function. Entering the above code into Mathematica results in an obvious Indeterminate solution
Helping this novice out is greatly appreciated.
Assuming that you want the treatment you describe for z to apply to x and y as well, you could do this:
f[x_, y_, z_] := g[x] + g[y] + g[z]
g[0] = 0;
g[x_] := x + x Log[x]
The helper function g handles the zero case explicitly. These definitions yield results like these:
f[1, E, E^2]
(* 1 + 2*E + 3*E^2 *)
f[1, 1, 1]
(* 3 *)
f[1, 1, 0]
(* 2 *)
f[0, 0, E]
(* 2*E *)
First, function application occurs by calling the function:
f[1,1,1]
Second, why not introduce a new function using limit?
f[x_,y_,z_] := x + y + z + x*Log[x] + y*Log[y] +z*Log[z]
g[x_,y_]:=Limit[f[x,y,z],z->0]
g[1,1]
That should give you the 2, though I'm not in front of mathematica now so i havent checked

How to get rid of denominator in numerator and denominator in mathematica

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

Resources