NIntegrate a function which involves another integration - wolfram-mathematica

I want to carry out a numeric integration using Mathematica. The integrand is
I=Exp[-z^2]F[z]^2
where this F[z] is defined as Integrate[1/(q+I) Exp[-c(q+z)^2],{q,-Infinity,0}]. Since Mathematica does not know how to carry out the Integration, it has to be carried out numerically. I have to change the integration into 'NIntegrate'. It seems to me that Mathematica refuses to do numerical integration over another numerical integration. The reason I am not using NIntegrate over multi-variables is that the actual integrand is long and complicated which involve F[z].
I also wonder if we could define our own special function like the build-in function in Mathematica. Since error function is an integration and Mathematica does not complain when Numerical integrate over error function. Can I transform the F[z] here like a built-in function?
Many Thanks

In[1]:= c = 2; (* make sure all variables have constant values assigned *)
F[z_?NumericQ] := NIntegrate[1/(q + I) Exp[-c (q + z)^2], {q, -Infinity, 0}];
NIntegrate[Exp[-z^2] F[z]^2, {z, 1, 3}]
Out[3]= 0.00387755 + 0.0794878 I

Related

How can I get mathematica to use the chain rule?

I want to teach mathematica that Subscript[w, i] differentiated by Subscript[w, j] is KroneckerDelta[i, j].
I tried
Unprotect[D]; D[Subscript[x_, i_], Subscript[x_, j_]] :=
KroneckerDelta[i, j]; Protect[D]
And this works with D[Subscript[w, i], Subscript[w, j]], but not with more complex expressions, e.g. D[Times[k, Subscript[w, i]], Subscript[w, j]]
I understand from the answer to this question: How to define a function that commutes with D in Mathematica that mathematica isn't matching my rule, but I don't understand why. Why does Mathematica not use the product rule, and then invoke my rule?
I think I see now what is happening.
Mathematica does not recursively define the D operator using the chain rule, presumably because this is too slow. It does some pattern matching on subexpressions to see if they contain the variable of differentiation, and subexpressions which don't are treated as constants; so my pattern for D is never applied.
The way around this turns out to be to tell Mathematica explicitly that
Subscript[w, i]
is not a constant.
My pattern now looks like this
Unprotect[D];
D[Subscript[x_, i_], Subscript[x_, j_],
NonConstants -> {___, Subscript[x_, i_], ___} ] := KroneckerDelta[i, j];
Protect[D]
And I have to apply it this way:
D[k * Subscript[w, i], Subscript[w, j], NonConstants -> Subscript[w, i]]
Mathematica does not have "mathematical maturity" which means it is not a competent graduate student who can look at your request, figure out what you actually meant and give you what you should get. In particular, pattern matching is "structural", which means it just literally matches exactly the structure of what the rules say. That means it doesn't realize that you probably meant k to be a constant and thus understand that the derivative of a constant times a function should be the constant times the derivative.
You can add more and more rules to try to simulate mathematical maturity, but many typical users don't have all the skills needed to exactly correctly write all the rules needed. You can include:
Unprotect[D];
D[Times[k_, Subscript[w_, i_]], Subscript[x_, j_]] := k*KroneckerDelta[i, j];
Protect[D];
D[Times[k, Subscript[w, i]], Subscript[x_, j_]]
but that is assuming that k is free of Subscript[w, i]] and you may want to enhance that rule with a condition ensuring that. This still doesn't deal with k+KroneckerDelta[i, j] or k*KroneckerDelta[i, j]+m, etc.
First of all, it's usually a bad idea to Unprotect symbols in Mathematica in order to add DownValues. In addition to the reasons Bill gave, this forces D to check that the arguments you give it doesn't match your patterns, before it can do its normal work. That can slow the system down.
You can often get away with UpValues (via UpSetDelayed) instead of DownValues. That doesn't require that you Unprotect, and it causes your rules to fire only when they apply.
In this case, though, I think you just want a custom differentiator on top of D:
myD[f_, Subscript[x_, i_]] :=
With[{vars = DeleteDuplicates[Cases[f, Subscript[x, _], {0, Infinity}]]},
Sum[D[f, v]*KroneckerDelta[i, v[[2]]], {v, vars}]
]
(if I'm not missing something crucial.)

Difference in argument evaluation in Mathematica: Plot vs. PlotLog

I can't seem to understand the difference between the behaviour of Plot and PlotLog (and other log-scale plotting functions) in Mathematica. Let's say I have this simple function:
f [a_] := Length[Range[0, a]]
now running Plot[f[x], {x, 1, 10}] yields a correct graph, but when I try
PlotLog[f[x], {x, 1, 10}]
I get no output save the following error:
Range::range: "Range specification in Range[1,x] does not have appropriate bounds."
Looks like the evaluation of x is postponed which makes it impossible to create a list from Range, but why on Earth would it happen to log-scale plotting functions only and how do I handle this issue?
PlotLog doesn't exists. If you use LogPlot it will work correctly.
In any case, you may have problems with that definition. I would recommend to define f like f2[a_Real] := Length[Range[0, a]] or f3[a_?NumericQ] := Length[Range[0, a]]so only numbers will be passed to Range.
For example, with your definition, this will fail:
NIntegrate[f[x], {x, 1, 10}]
During evaluation of In[43]:= Range::range: Range specification in Range[0,x] does not have appropriate bounds. >>
18.
But defining a as NumericQ or Real, it will work.
NIntegrate[f2[x],{x,1,10}]
54.
Regards.

Complex Error Function in Mathematica

The complex error function w(z) is defined as e^(-x^2) erfc(-ix). The problem with using w(z) as defined above is that the erfc tends to explode out for larger x (complemented by the exponential going to 0 so everything stays small), so that Mathematica reverts to arbitrary precision calculations that make life VERY slow. The function is used in implementing the voigt profile - a line shape commonly used in spectroscopy and other related areas. Right now I'm reverting to calculating the lineshape once and using an interpolation to speed things up, however this doesn't let me alter the parameters of the lineshape (or fit to them) easily.
scipy has a nice and fast implementation of w(z) as scipy.special.wofz, and I was wondering if there is an equivalent in Mathematica.
The complex error function can be written in terms of the Hermite "polynomial" H_{-1}(x):
In[1]:= FullSimplify[2 HermiteH[-1,I x] == Sqrt[Pi] Exp[-x^2] Erfc[I x]]
Out[1]= True
And the evaluation does not suffer as many underflows and overflows
In[68]:= 2 HermiteH[-1, I x] /. x -> 100000.
Out[68]= 6.12323*10^-22 - 0.00001 I
In[69]:= Sqrt[Pi] E^-x^2 Erfc[I x] /. x -> 100000.
During evaluation of In[69]:= General::unfl: Underflow occurred in computation. >>
During evaluation of In[69]:= General::ovfl: Overflow occurred in computation. >>
Out[69]= Indeterminate
That said, some quick tests show that the evaluation speed of the Hermite function to be slower than that of the product of the exponential and error function...
A series expansion at infinity shows that the real and imaginary parts are of very different scales. I'd suggest computing them separately and not adding them. Below I use the first few terms of the series expansion to get the imaginary part.
In[186]:=
w[x_?NumericQ] := {N[Exp[-SetPrecision[x, 25]^2], 20],
N[(3 /(4 Sqrt[\[Pi]] x^5) + 1/(2 Sqrt[\[Pi]] x^3) + 1/(
Sqrt[\[Pi]] x))]}
In[187]:= w[11]
Out[187]= {2.8207700884601354011*10^-53, 0.05150453151309212}
In[188]:= w[1000]
Out[188]= {3.296831478088558579*10^-434295, 0.0005641898656429712}
Not sure how badly you want that very small real part. If you can drop it that will keep the numbers in a reasonable range. In some ranges (or if higher than machine precision is desired) you may want to use more terms from the expansion on that imaginary part.
Daniel Lichtblau
Wolfram Research
The real and imaginary parts of the complex error function on the real line can be explicitly and efficiently computed in Mathematica using Dawson integral:
In[9]:= Sqrt[Pi] Exp[-x^2] Erfc[I x] ==
E^-x^2 Sqrt[\[Pi]] - 2 I DawsonF[x] // FullSimplify
Out[9]= True
This is about 4 times faster than using HermiteH[-1,z].
In[10]:= w1[x_] := E^-x^2 Sqrt[\[Pi]] - 2 I DawsonF[x]
w2[x_] := 2 HermiteH[-1, I x]
In[15]:= AbsoluteTiming[w1 /# Range[-5.0, 5.0, 0.001];]
Out[15]= {2.3272327, Null}
In[16]:= AbsoluteTiming[w2 /# Range[-5.0, 5.0, 0.001];]
Out[16]= {10.2400239, Null}
A program in language C for the complex error function (aka the Faddeeva function) that can be run from Mathematica is also available in RooFit. Read the article by Karbach et al. arXiv:1407.0748 for more information.
Just wrap the C library libcerf.

Can I automatically lazily evaluate function parameters in Mathematica?

In Mathematica, I'd like to do something along the lines of:
f[Rational[a_, b_], Rational[c_, d_]] := {a+c, b+d}
But if I evaluate it with expressions of the following form I get the wrong result:
In: f[Rational[50, 100], Rational[4, 10]]
Out: {3, 7}
(* Expected: 54 / 110 -> 27 / 55 *)
Is there any way I can force Mathematica to stop simplifying the expression immediately? I can just do a hold on whatever I pass in, then have the function in question just call ReleaseHold[..] on whatever what was passed in.
This solution is very ugly though, and I don't want to have to do this. I know some functions in Mathematica automatically hold whatever is passed in and delay evaluating it for some reason or another, and I would like to do this here.
In short: How can I force Mathematica to lazily evaluate something being passed into a function without having to manually hold it?
In the standard evaluation procedure, each argument of a function is evaluated in turn. This is prevented by setting the attributes HoldFirst, HoldRest and HoldAll. These attributes make Mathematica "hold" particular arguments in an unevaluated form.
http://reference.wolfram.com/legacy/v5/TheMathematicaBook/PrinciplesOfMathematica/EvaluationOfExpressions/2.6.5.html
e.g.
SetAttributes[yourFunction, HoldFirst]
http://reference.wolfram.com/mathematica/ref/HoldFirst.html
The docs say any auto-Held arguments are automatically evaluated the first time you use them in the function body. However if for some reason you want to continue working with the argument in the Hold form (e.g. if you'd like to do pattern-matching and rewriting on the unevaluated form of the expression), then perhaps you can re-Hold it.
Using the HoldAll attribute ninjagecko mentioned I was able to craft a solution.
There was actually another issue going on that I wasn't able to see immediately. Specifically, my function wasn't pattern matching as I thought it would be.
I thought my initial issue was simply that Mathematica was automatically simplifying my expressions and I needed to lazily evaluate the parameters being passed in for the correct behavior.
In reality, I forgot that there are multiple ways of representing expressions in Mathematica. As a toy example consider the following function which extracts the numerator and denominator of a fraction:
ExtractNumDem[Fraction[a_, b_]] := {a, b}
(* Already incorrect, ExtractNumDem[4 / 100] gives {1, 25} *)
Just adding the HoldAll (Or HoldFirst even) attribute results in another issue:
SetAttributess[ExtractNumDem, HoldAll];
ExtractNumDem[4 / 100] (* Gives ExtractNumDem[4 / 100] *)
The expression 4 / 100 is actually evaluating to Times[4, Power[100, -1]]. To fix this second issue I had to add a definition for fractions that look like that:
ExtractNumDem[Times[a_, Power[b_, -1]] := {a, b}
ExtractNumDem[4/100] (* Now gives {4, 100} *)
My solution to fixing the issue in my original answer applied the same exact principle. Here's some code to actually see the issue I was running into:
ClearAll[ExtractNumDem]
ExtractNumDem[Rational[a_, b_]] := {a, b}
ExtractNumDem[4 / 100]
SetAttributes[ExtractNumDem, HoldAll];
ExtractNumDem[4 / 100]
ExtractNumDem[Times[a_, Power[b_, -1]]] := {a, b}
ExtractNumDem[4/100]

Telling Plot to style vector-valued black-box functions in Mathematica

Suppose I write a black-box functions, which evaluates an expensive complex valued function numerically, and then returns real and imaginary part.
fun[x_?InexactNumberQ] := Module[{f = Sin[x]}, {Re[f], Im[f]}]
Then I can use it in Plot as usual, but Plot does not recognize that the function returns a pair, and colors both curves the same color. How does one tell Mathematica that the function specified always returns a vector of a fixed length ? Or how does one style this plot ?
EDIT: Given attempts attempted at answering the problem, I think that avoiding double reevalution is only possible if styling is performed as a post-processing of the graphics obtained. Most likely the following is not robust, but it seems to work for my example:
gr = Plot[fun[x + I], {x, -1, 1}, ImageSize -> 250];
k = 1;
{gr, gr /. {el_Line :> {ColorData[1][k++], el}}}
One possibility is:
Plot[{#[[1]], #[[2]]}, {x, -1, 1}, PlotStyle -> {{Red}, {Blue}}] &# fun[x + I]
Edit
If your functions are not really smooth (ie. almost linear!), there is not much you can do to prevent the double evaluation process, as it will happen (sort of) anyway due to the nature of the Plot[] mesh exploration algorithm.
For example:
fun[x_?InexactNumberQ] := Module[{f = Sin[3 x]}, {Re[f], Im[f]}];
Plot[{#[[1]], #[[2]]}, {x, -1, 1}, Mesh -> All,
PlotStyle -> {{Red}, {Blue}}] &#fun[x + I]
I don't think there's a good solution to this if your function is expensive to compute. Plot will only acknowledge that there are several curves to be styled if you either give it an explicit list of functions as argument, or you give it a function that it can evaluate to a list of values.
The reason you might not want to do what #belisarius suggested is that it would compute the function twice (twice as slow).
However, you could use memoization to avoid this (i.e. the f[x_] := f[x] = ... construct), and go with his solution. But this can fill up your memory quickly if you work with real valued functions. To prevent this you may want to try what I wrote about caching only a limited number of values, to avoid filling up the memory: http://szhorvat.net/pelican/memoization-in-mathematica.html
If possible for your actual application, one way is to allow fun to take symbolic input in addition to just numeric, and then Evaluate it inside of Plot:
fun2[x_] := Module[{f = Sin[x]}, {Re[f], Im[f]}]
Plot[Evaluate[fun2[x + I]], {x, -1, 1}]
This has the same effect as if you had instead evaluated:
Plot[{-Im[Sinh[1 - I x]], Re[Sinh[1 - I x]]}, {x, -1, 1}]

Resources