Using alternative special functions in Simplify and Expand - wolfram-mathematica

I have Mathematica expressions involving the special functions Erf[x] and Erfc[x], but I'd like to express them in terms of the scaled and translated version
F[x_] := CDF[NormalDistribution[0,1]][x]
throughout the notebook. This is because F[x] has an easy interpretation in the context of my problem.

Not sure whether I understand your problem, but I'm trying to answer my interpretation of what your saying.
So you have an expression in erf and erfc, like this
expr = Erf[x] + 1/Erfc[x] + Sin[Erf[x]] + Cos[Erfc[x]]
All it takes to replace erf and erfc with F is this:
expr //. {Erfc[x_] -> 2 F[-(x) Sqrt[2]], Erf[x_] -> 1 - Erfc[x]}
(* ==> 1 + Cos[2 F[-Sqrt[2] x]] + 1/(2 F[-Sqrt[2] x]) -
2 F[-Sqrt[2] x] + Sin[1 - 2 F[-Sqrt[2] x]]
*)
which with your definition of F[x] is indeed the same:
1 + Cos[2 F[-Sqrt[2] x]] + 1/(2 F[-Sqrt[2] x]) - 2 F[-Sqrt[2] x] +
Sin[1 - 2 F[-Sqrt[2] x]] /. F[x_] -> CDF[NormalDistribution[0, 1]][x]
(* ==> 1 + Cos[Erfc[x]] + 1/Erfc[x] - Erfc[x] + Sin[1 - Erfc[x]] *)

Related

Implementing rules on functions in Mathematica

Suppose you have the following expression:
expr = f[p^(3) * q^(5) * m] * f[p^(-2) * q^(-5) * m] * f[p^(1/2) * q^(1) * m] + 5 * f[p^(1) * q^(2) * n] * f[q^(-2) * n] + s * f[p^(h) * q^(r) * j] * f[p^(1-h) * q^(-r) * j].
Moreover, suppose that the function f is such that
f[p^(a) * q^(b) * x] * f[p^(1-a) * q^(-b) * x] == 1
for any value (numerical or symbolic) of the exponents a,b and for any x.
This means that
expr == f[p^(1/2) * q^(1) * m] + 5 + s.
How can I teach Mathematica to recognise this property of f and then simplify expr according to it?
I tried to implement it as the following rule
/.f[p^(a_)*q^(b_)*x_]f[p^(1-a_)*q^(-b_)*x_]->1
but it doesn't work. It only works if you specify the numerical value of the exponents a and b, but not if you want them to be generic.
What is the right way to write such a rule?
The answer here may provide a solution : How to insert a subexpression into a larger expression in Mathematica? c/o Rojo
For example, using your expression expr and a larger expression A
expr = f[p^(a)*q^(b)*x] f[p^(1 - a)*q^(-b)*x];
A = 3 expr + z (f[p^(a)*q^(b)*x]) + y expr
doThat[expr_, vars_List] := Expand[Simplify[expr /. Flatten[
Solve[# == ToString##, First#Variables##] & /# vars]],
Alternatives ## ToString /# vars] /.
Thread[ToString /# vars -> vars];
done = doThat[A, {expr}];
ans = Simplify[done //. expr -> 1]
3 + y + z f[p^a q^b x]
The expected answer.
For general cases as per the comment, a pattern can be used, e.g.
expr = f[p^(a)*q^(b)*x] f[p^(1 - a)*q^(-b)*x];
A = 3 expr + z (f[p^(a)*q^(b)*x]) +
y f[p^(h)*q^(l)*x] f[p^(1 - h)*q^(-l)*x];
done = doThat[A, {expr}];
ans = Simplify[done //.
f[p^(a_)*q^(b_)*x] f[p^(1 - a_)*q^(-b_)*x] -> 1]
3 + y + z f[p^a q^b x]
But in the end it can simply be done by
A /. f[p^(a_)*q^(b_)*x] f[p^(1 - a_)*q^(-b_)*x] -> 1
3 + y + z f[p^a q^b x]
2nd edit
A = (3 f[p^(a)*q^(b)*x] f[p^(1 - a)*q^(-b)*x] +
z (f[p^(a)*q^(b)*x]) +
y f[p^(h)*q^(l)*x] f[p^(1 - h)*q^(-l)*x] f[p m])
A /. h -> 2 /. f[p^(a_)*q^(b_)*x_] f[p^(1 - a_)*q^(-b_)*x_] -> 1
3 + z f[p^a q^b x] + y f[m p] f[(q^-l x)/p] f[p^2 q^l x]
When h is 2 the second replacement no longer applies to the expression containing p^(1 - h) because the form has become p^(-1).
On the other hand, keeping the variables symbolic by using Z instead of 2
A /. h -> Z /. f[p^(a_)*q^(b_)*x_] f[p^(1 - a_)*q^(-b_)*x_] -> 1
3 + y f[m p] + z f[p^a q^b x]

Mathematica FullSimplify[Sqrt[5+2 Sqrt[6]]] yields Sqrt[2]+Sqrt[3] but FullSimplify[-Sqrt[5+2 Sqrt[6]]] is not simplified, why?

I was playing with the (beautiful) polynomial x^4 - 10x^2 + 1.
Look what happens:
In[46]:= f[x_] := x^4 - 10x^2 + 1
a = Sqrt[2];
b = Sqrt[3];
Simplify[f[ a + b]]
Simplify[f[ a - b]]
Simplify[f[-a + b]]
Simplify[f[-a - b]]
Out[49]= 0
Out[50]= 0
Out[51]= 0
Out[52]= 0
In[53]:= Solve[f[x] == 0, x]
Out[53]= {{x->-Sqrt[5-2 Sqrt[6]]},{x->Sqrt[5-2 Sqrt[6]]},{x->-Sqrt[5+2 Sqrt[6]]},{x->Sqrt[5+2 Sqrt[6]]}}
In[54]:= Simplify[Solve[f[x] == 0, x]]
Out[54]= {{x->-Sqrt[5-2 Sqrt[6]]},{x->Sqrt[5-2 Sqrt[6]]},{x->-Sqrt[5+2 Sqrt[6]]},{x->Sqrt[5+2 Sqrt[6]]}}
In[55]:= FullSimplify[Solve[f[x] == 0, x]]
Out[55]= {{x->Sqrt[2]-Sqrt[3]},{x->Sqrt[5-2 Sqrt[6]]},{x->-Sqrt[5+2 Sqrt[6]]},{x->Sqrt[2]+Sqrt[3]}}
Sqrt[5-2 Sqrt[6]] is equal to Sqrt[3]-Sqrt[2].
However, Mathematica's FullSimplify does not simplify Sqrt[5-2 Sqrt[6]].
Question: Should I use other more specialized functions to algebraically solve the equation? If so, which one?
Indeed, Solve doesn't simplify all roots to the max:
A FullSimplify postprocessing step simplifies two roots and leaves two others untouched:
Same initially happens with Roots:
Strange enough, now FullSimplify simplifies all roots:
The reason for this is, I assume, that for the default ComplexityFunction some of the solutions written above in nested radicals are in a sense simpler than the others.
BTW FunctionExpand knows how to deal with those radicals:
FullSimplify[ Solve[x^4-10x^2+1==0,x]
,
ComplexityFunction ->
(StringLength[ToString[
InputForm[#1]]] & )]
gives
{{x -> Sqrt[2] - Sqrt[3]}, {x -> -Sqrt[2] + Sqrt[3]}, {x -> -Sqrt[2] -
Sqrt[3]}, {x -> Sqrt[2] + Sqrt[3]}}

How to get mathematica to carry out a Sum when only part of it is defined?

I'm having a sum like this:
Sum[1 + x[i], {i, 1, n}]
Mathematica doesn't simplify it any more. What would I need to do so it translates it into:
n + Sum[x[i],{i,1,n}]
Maybe this?
Distribute[Sum[1 + x[i], {i, 1, n}]]
which returns:
n + Sum[x[i], {i, 1, n}]
AFAIK Sum simply won't give partial answers. But you can always split off the additive part manually, or semi-automatically. Taking your example,
In[1]:= sigma + (x[i] - X)^2 // Expand
Out[1]= sigma + X^2 - 2 X x[i] + x[i]^2
There's nothing we can do with the parts that contain x[i] without knowing anything about x[i], so we just split off the rest:
In[2]:= Plus ## Cases[%, e_ /; FreeQ[e, x[i]]]
Out[2]= sigma + X^2
In[3]:= Sum[%, {i, 1, n}]
Out[3]= n (sigma + X^2)
Unrelated: It is a good idea never to use symbols starting with capital letters to avoid conflicts with builtins. N has a meaning already, and you shouldn't use it as a variable.
A quick and dirty way would be to use Thread, so for example
Thread[Sum[Expand[sigma + (x[i] - X)^2], {i, 1, n}], Plus, 1]
A simpler way would be
Total[Sum[#, {i, 1, n}] & /# {sigma, x[i]}]
If your expression is longer, this should give you the answer without having to manually split the terms
expr = sigma + (x[i] + i)^2 + Cos[Sin[i - x[i]]];
Total[Sum[#, {i, 1, n}] & /# Level[expr, {1}]]
This can also be done in an easy to understand manner with rules:
sumofsumsrule = Sum[a_+b_,{i_,c_,d_}] :> Sum[a,{i,c,d}]+Sum[b,{i,c,d}];
expandsummandrule = Sum[a_,{i_,c_,d_}] :> Sum[Expand[a],{i,c,d}];
MyRules = {sumofsumsrule, expandsummandrule};
Now, if you are messing around, you can use this (here are some examples):
error = Sum[sigma+(x[i]-X)^2,{i,1,n}]
error /. sumofsumsrule
% /. expandsummandrule
error //. MyRules

Finding the Fixed Points of an Iterative Map

I need to find fixed points of iterative map x[n] == 1/2 x[n-1]^2 - Mu.
My approach:
Subscript[g, n_ ][Mu_, x_] := Nest[0.5 * x^2 - Mu, x, n]
fixedPoints[n_] := Solve[Subscript[g, n][Mu, x] == x, x]
Plot[
Evaluate[{x,
Table[Subscript[g, 1][Mu, x], {Mu, 0.5, 4, 0.5}]}
], {x, 0, 0.5}, Frame -> True]
I'll change notation slightly (mostly so I myself can understand it). You might want something like this.
y[n_, mu_, x_] := Nest[#^2/2 - mu &, x, n]
fixedPoints[n_] := Solve[y[n, mu, x] == x, x]
The salient feature is that the "function" being nested now really is a function, in correct format.
Example:
fixedPoints[2]
Out[18]= {{x -> -1 - Sqrt[-3 + 2*mu]},
{x -> -1 + Sqrt[-3 + 2*mu]},
{x -> 1 - Sqrt[ 1 + 2*mu]},
{x -> 1 + Sqrt[ 1 + 2*mu]}}
Daniel Lichtblau
First of all, there is an error in your approach. Nest takes a pure function. Also I would use exact input, i.e. 1/2 instead of 0.5 since Solve is a symbolic rather than numeric solver.
Subscript[g, n_Integer][Mu_, x_] := Nest[Function[z, 1/2 z^2 - Mu], x, n]
Then
In[17]:= fixedPoints[1]
Out[17]= {{x -> 1 - Sqrt[1 + 2 Mu]}, {x -> 1 + Sqrt[1 + 2 Mu]}}
A side note:
Look what happens when you start very near to a fixed point (weird :) :
f[z_, Mu_, n_] := Abs[N#Nest[1/2 #^2 - Mu &, z, n] - z]
g[mu_] := f[1 + Sqrt[1 + 2*mu] - mu 10^-8, mu, 10^4]
Plot[g[mu], {mu, 0, 3}, PlotRange -> {0, 7}]
Edit
In fact, it seems you have an autosimilar structure there:

Collect output of Roots[] into a list

If I do Roots[a x^2 + b x + c == 0, x], the output is
x == (-b - Sqrt[b^2 - 4 a c])/(2 a) ||
x == (-b + Sqrt[b^2 - 4 a c])/(2 a)
How do I collect the output of Roots into a list like so {(-b - Sqrt[b^2 - 4 a c])/(2 a), (-b + Sqrt[b^2 - 4 a c])/(2 a)} so that I can plot it?
An alternative (obvious?} method:
List ## Roots[a x^2 + b x + c == 0, x][[All, 2]]
giving
x /. {ToRules[Roots[a x^2 + b x + c == 0, x]]} // Flatten
==> {(-b - Sqrt[b^2 - 4 a c])/(2 a), (-b + Sqrt[b^2 - 4 a c])/(2 a)}

Resources