Related
Sometimes, we know that certain variables are positive, or natural numbers, or real and it helps to simplify the expressions. For example,
Integrate[Sign[x], {x, -l/2, l}]
evaluates to
ConditionalExpression[
1/2 l (-3 + 6 DiscreteDelta[l] + 2 HeavisideTheta[-l] +
4 HeavisideTheta[l]), l \[Element] Reals]
But if I know that l is a real positive number, I am actually looking at -l/2. Is there a way to specify this extra information or constraint so Mathematica can simplify the expression?
It will usually evaluate faster if you specify Assumptions inside of Integrate:
Integrate[Sign[x], {x, -l/2, l}, Assumptions -> l > 0]
I found the answer, you can specify assumptions, such as
Simplify[Integrate[Sign[x], {x, -l/2, l}], l > 0]
which reduces to l/2.
So generally, if you have two functions f,g: X -->Y, and if there is some binary operation + defined on Y, then f + g has a canonical definition as the function x --> f(x) + g(x).
What's the best way to implement this in Mathematica?
f[x_] := x^2
g[x_] := 2*x
h = f + g;
h[1]
yields
(f + g)[1]
as an output
of course,
H = Function[z, f[z] + g[z]];
H[1]
Yields '3'.
Consider:
In[1]:= Through[(f + g)[1]]
Out[1]= f[1] + g[1]
To elaborate, you can define h like this:
h = Through[ (f + g)[#] ] &;
If you have a limited number of functions and operands, then UpSet as recommended by yoda is surely syntactically cleaner. However, Through is more general. Without any new definitions involving Times or h, one can easily do:
i = Through[ (h * f * g)[#] ] &
i[7]
43218
Another way of doing what you're trying to do is using UpSetDelayed.
f[x_] := x^2;
g[x_] := 2*x;
f + g ^:= f[#] + g[#] &; (*define upvalues for the operation f+g*)
h[x_] = f + g;
h[z]
Out[1]= 2 z + z^2
Also see this very nice answer by rcollyer (and also the ones by Leonid & Verbeia) for more on UpValues and when to use them
I will throw in a complete code for Gram - Schmidt and an example for function addition etc, since I happened to have that code written about 4 years ago. Did not test extensively though. I did not change a single line of it now, so a disclaimer (I was a lot worse at mma at the time). That said, here is a Gram - Schmidt procedure implementation, which is a slightly generalized version of the code I discussed here:
oneStepOrtogonalizeGen[vec_, {}, _, _, _] := vec;
oneStepOrtogonalizeGen[vec_, vecmat_List, dotF_, plusF_, timesF_] :=
Fold[plusF[#1, timesF[-dotF[vec, #2]/dotF[#2, #2], #2]] &, vec, vecmat];
GSOrthogonalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Fold[Append[#1,oneStepOrtogonalizeGen[#2, #1, dotF, plusF, timesF]] &, {}, startvecs];
normalizeGen[vec_, dotF_, timesF_] := timesF[1/Sqrt[dotF[vec, vec]], vec];
GSOrthoNormalizeGen[startvecs_List, dotF_, plusF_, timesF_] :=
Map[normalizeGen[#, dotF, timesF] &, GSOrthogonalizeGen[startvecs, dotF, plusF, timesF]];
The functions above are parametrized by 3 functions, realizing addition, multiplication by a number, and the dot product in a given vector space. The example to illustrate will be to find Hermite polynomials by orthonormalizing monomials. These are possible implementations for the 3 functions we need:
hermiteDot[f_Function, g_Function] :=
Module[{x}, Integrate[f[x]*g[x]*Exp[-x^2], {x, -Infinity, Infinity}]];
SetAttributes[functionPlus, {Flat, Orderless, OneIdentity}];
functionPlus[f__Function] := With[{expr = Plus ## Through[{f}[#]]}, expr &];
SetAttributes[functionTimes, {Flat, Orderless, OneIdentity}];
functionTimes[a___, f_Function] /; FreeQ[{a}, # | Function] :=
With[{expr = Times[a, f[#]]}, expr &];
These functions may be a bit naive, but they will illustrate the idea (and yes, I also used Through). Here are some examples to illustrate their use:
In[114]:= hermiteDot[#^2 &, #^4 &]
Out[114]= (15 Sqrt[\[Pi]])/8
In[107]:= functionPlus[# &, #^2 &, Sin[#] &]
Out[107]= Sin[#1] + #1 + #1^2 &
In[111]:= functionTimes[z, #^2 &, x, 5]
Out[111]= 5 x z #1^2 &
Now, the main test:
In[115]:=
results =
GSOrthoNormalizeGen[{1 &, # &, #^2 &, #^3 &, #^4 &}, hermiteDot,
functionPlus, functionTimes]
Out[115]= {1/\[Pi]^(1/4) &, (Sqrt[2] #1)/\[Pi]^(1/4) &, (
Sqrt[2] (-(1/2) + #1^2))/\[Pi]^(1/4) &, (2 (-((3 #1)/2) + #1^3))/(
Sqrt[3] \[Pi]^(1/4)) &, (Sqrt[2/3] (-(3/4) + #1^4 -
3 (-(1/2) + #1^2)))/\[Pi]^(1/4) &}
These are indeed the properly normalized Hermite polynomials, as is easy to verify. The normalization of built-in HermiteH is different. Our results are normalized as one would normalize the wave functions of a harmonic oscillator, say. It is trivial to obtain a list of polynomials as expressions depending on a variable, say x:
In[116]:= Through[results[x]]
Out[116]= {1/\[Pi]^(1/4),(Sqrt[2] x)/\[Pi]^(1/4),(Sqrt[2] (-(1/2)+x^2))/\[Pi]^(1/4),
(2 (-((3 x)/2)+x^3))/(Sqrt[3] \[Pi]^(1/4)),(Sqrt[2/3] (-(3/4)+x^4-3 (-(1/2)+x^2)))/\[Pi]^(1/4)}
I would suggest defining an operator other than the built-in Plus for this purpose. There are a number of operators provided by Mathematica that are reserved for user definitions in cases such as this. One such operator is CirclePlus which has no pre-defined meaning but which has a nice compact representation (at least, it is compact in a notebook -- not so compact on a StackOverflow web page). You could define CirclePlus to perform function addition thus:
(x_ \[CirclePlus] y_)[args___] := x[args] + y[args]
With this definition in place, you can now perform function addition:
h = f \[CirclePlus] g;
h[x]
(* Out[3]= f[x]+g[x] *)
If one likes to live on the edge, the same technique can be used with the built-in Plus operator provided it is unprotected first:
Unprotect[Plus];
(x_ + y_)[args___] := x[args] + y[args]
Protect[Plus];
h = f + g;
h[x]
(* Out[7]= f[x]+g[x] *)
I would generally advise against altering the behaviour of built-in functions -- especially one as fundamental as Plus. The reason is that there is no guarantee that user-added definitions to Plus will be respected by other built-in or kernel functions. In some circumstances calls to Plus are optimized, and those optimizations might be not take the user definitions into account. However, this consideration may not affect any particular application so the option is still a valid, if risky, design choice.
If I have some function y[x_]:=ax+b (just an example), how do I obtain x[y_]:=(y-b)/a in Mathematica? I've tried InverseFunction,Collect and they don't work.
Treat it as an equation and use Solve.
In:=Solve[y-ax-b==0,x]
Out={{x -> (-b + y)/a}}
If you want to define a function, you could do:
x[y_] := x /. Solve[y == a x + b, x][[1]]
x[1]
-> (1 - b)/a
http://mathworld.wolfram.com/InverseFunction.html
Specifically the line:
In Mathematica, inverse functions are
represented using InverseFunction[f].
One way is with Solve:
In[29]:= Solve[y == a x + b, x]
Out[29]= {{x -> (-b + y)/a}}
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] &]
I need to find the minimum of a function f(t) = int g(t,x) dx over [0,1]. What I did in mathematica is as follows:
f[t_] = NIntegrate[g[t,x],{x,-1,1}]
FindMinimum[f[t],{t,t0}]
However mathematica halts at the first try, because NIntegrate does not work with the symbolic t. It needs a specific value to evaluate. Although Plot[f[t],{t,0,1}] works perferctly, FindMinimum stops at the initial point.
I cannot replace NIntegrate by Integrate, because the function g is a bit complicated and if you type Integrate, mathematica just keep running...
Any way to get around it? Thanks!
Try this:
In[58]:= g[t_, x_] := t^3 - t + x^2
In[59]:= f[t_?NumericQ] := NIntegrate[g[t, x], {x, -1, 1}]
In[60]:= FindMinimum[f[t], {t, 1}]
Out[60]= {-0.103134, {t -> 0.57735}}
In[61]:= Plot[f[t], {t, 0, 1}]
Two relevant changes I made to your code:
Define f with := instead of with =. This effectively gives a definition for f "later", when the user of f has supplied the values of the arguments. See SetDelayed.
Define f with t_?NumericQ instead of t_. This says, t can be anything numeric (Pi, 7, 0, etc). But not anything non-numeric (t, x, "foo", etc).
An ounce of analysis...
You can get an exact answer and completely avoid the heavy lifting of the numerical integration, as long as Mathematica can do symbolic integration of g[t,x] w.r.t x and then symbolic differentiation w.r.t. t. A less trivial example with a more complicated g[t,x] including polynomial products in x and t:
g[t_, x_] := t^2 + (7*t*x - (x^3)/13)^2;
xMax = 1; xMin = -1; f[t_?NumericQ] := NIntegrate[g[t, x], {x, xMin, xMax}];
tMin = 0; tMax = 1;Plot[f[t], {t, tMin, tMax}];
tNumericAtMin = t /. FindMinimum[f[t], {t, tMax}][[2]];
dig[t_, x_] := D[Integrate[g[t, x], x], t];
Print["Differentiated integral is ", dig[t, x]];
digAtXMax = dig[t, x] /. x -> xMax; digAtXMin = dig[t, x] /. x -> xMin;
tSymbolicAtMin = Resolve[digAtXMax - digAtXMin == 0 && tMin ≤ t ≤ tMax, {t}];
Print["Exact: ", tSymbolicAtMin[[2]]];
Print["Numeric: ", tNumericAtMin];
Print["Difference: ", tSymbolicAtMin [[2]] - tNumericAtMin // N];
with the result:
⁃Graphics⁃
Differentiated integral is 2 t x + 98 t x^3 / 3 - 14 x^5 / 65
Exact: 21/3380
Numeric: 0.00621302
Difference: -3.01143 x 10^-9
Minimum of the function can be only at zero-points of it's derivate, so why to integrate in the first place?
You can use FindRoot or Solve to find roots of g
Then you can verify that points are really local minimums by checking derivates of g (it should be positive at that point).
Then you can NIntegrate to find minimum value of f - only one numerical integration!