mathematica: evaluation order in numerical integration - math

Hi i have a problem concerning a numerical integration in mathematica. Here is my test function
Table[NIntegrate[
Boole[Sqrt[1 - cosk^2]*Sqrt[1 - cosk2^2] > Abs[a - cosk*cosk2]]/
Sqrt[(1 - cosk^2)*(1 - cosk2^2) - (a - cosk*cosk2)^2],
{cosk, -1,1}, {cosk2, -1, 1}, Method -> "GlobalAdaptive"], {a, -.9, .9, .1}]
The integration yields complex values although due to the boolean function in the integrand the argument in the sqrt should be always positive and hence only result in real values. Is it possible to first evaluate the boole function and only if it is true then start to numerically integrate?
If i calculate the same integral using a monte carlo integration strategy
Table[NIntegrate[
Boole[Sqrt[1 - cosk^2]*Sqrt[1 - cosk2^2] > Abs[a - cosk*cosk2]]/
Sqrt[(1 - cosk^2)*(1 - cosk2^2) - (a - cosk*cosk2)^2], {cosk, -1,
1}, {cosk2, -1, 1}, Method -> {"MonteCarlo", "MaxPoints" -> 10^8,
"SymbolicProcessing" -> None}], {a, -.9, .9, .1}]
how can I find out if it sums up a lot of zeroes due to the boolean function? I think the evaluation can save a lot of computation time if it first evaluates the boolean function for each sample point of the monte carlo grid. If i replace "MonteCarlo" by "AdaptiveMonteCarlo" the result goes totally wrong.

What happens if you convert to a true guard? (The Boole form may be too clever by half (Mathematica might not treat false --> 0 as a real guard).)
Table[NIntegrate[
If[Sqrt[1 - cosk^2]*Sqrt[1 - cosk2^2] > Abs[a - cosk*cosk2],
1/Sqrt[(1 - cosk^2)*(1 - cosk2^2) - (a - cosk*cosk2)^2], 0],
{cosk, -1,1}, {cosk2, -1, 1}], {a, -.9, .9, .1}]

here is how to use EvaluationMonitor to learn what the sampling methods do:
out = Reap[With[{a = -.9},
NIntegrate[
v = Boole[
Sqrt[1 - cosk^2]*Sqrt[1 - cosk2^2] > Abs[a - cosk*cosk2]]/
Sqrt[(1 - cosk^2)*(1 - cosk2^2) - (a -
cosk*cosk2)^2], {cosk, -1, 1}, {cosk2, -1, 1},
Method -> "LocalAdaptive",
EvaluationMonitor :> Sow[{cosk, cosk2, v}]]]]
Note LocalAdaptive is very slow, but is likely the most accurate purely numerical result:
Graphics#Point[out[[2, 1]][[All, {1, 2}]]]
here is global adaptive.
MonteCarlo just samples everywhere without regard to the integrand value.
Your best bet probably is to use global adaptive and set MinRecursion. Satisfy yourself the imaginary parts are negligible and take the real part of the result.
Of course it would be far better to analytically solve for your integration limits and eliminate the Boole all together.

Related

Is there a way to optimize the calculation of Bernoulli Log-Likelihoods for many multivariate samples?

I currently have two Torch Tensors, p and x, which both have the shape of (batch_size, input_size).
I would like to calculate the Bernoulli log likelihoods for the given data, and return a tensor of size (batch_size)
Here's an example of what I'd like to do:
I have the formula for log likelihoods of Bernoulli Random variables:
\sum_i^d x_{i} ln(p_i) + (1-x_i) ln (1-p_i)
Say I have p Tensor:
[[0.6 0.4 0], [0.33 0.34 0.33]]
And say I have the x tensor for the binary inputs based on those probabilities:
[[1 1 0], [0 1 1]]
And I want to calculate the log likelihood for every sample, which would result in:
[[ln(0.6)+ln(0.4)], [ln(0.67)+ln(0.34)+ln(0.33)]]
Would it be possible to do this computation without the use of for loops?
I know I could use torch.sum(axis=1) to do the final summation between the logs, but is it possible to do the Bernoulli log-likelihood computation without the use of for loops? or use at most 1 for loop? I am trying to vectorize this operation as much as possible. I could've sworn we could use LaTeX for equations before, did something change or is it another website?
Though not a good practice, you can directly use the formula on the tensors as follows (works because these are element wise operations):
import torch
p = torch.tensor([
[0.6, 0.4, 0],
[0.33, 0.34, 0.33]
])
x = torch.tensor([
[1., 1, 0],
[0, 1, 1]
])
eps = 1e-8
bll1 = (x * torch.log(p+eps) + (1-x) * torch.log(1-p+eps)).sum(axis=1)
print(bll1)
#tensor([-1.4271162748, -2.5879497528])
Note that to avoid log(0) error, I have introduced a very small constant eps inside it.
A better way to do this is to use BCELoss inside nn module in pytorch.
import torch.nn as nn
bce = nn.BCELoss(reduction='none')
bll2 = -bce(p, x).sum(axis=1)
print(bll2)
#tensor([-1.4271162748, -2.5879497528])
Since pytorch computes the BCE as a loss, it prepends your formula with a negative sign. The attribute reduction='none' says that I do not want the computed losses to be reduced (averaged/summed) across the batch in any way. This is advisable to use since we do not need to manually take care of numerical stability and error handling (such as adding eps above.)
You can indeed verify that the two solutions actually return the same tensor (upto a tolerance):
torch.allclose(bll1, bll2)
# True
or the tensors (without summing each row):
torch.allclose((x * torch.log(p+eps) + (1-x) * torch.log(1-p+eps)), -bce(p, x))
# True
Feel free to ask for further clarifications.

Calculate pi in prolog recursively with Leibniz formula

I want to learn some prolog and found the exercise to calculate pi recursively for a given predicat pi(10, Result). I don't want it to be tail recursive because I find tail recursion to be easier. I've been trying to do this for hours now but it seems like I can't come to a solution, this is how far I've come:
(I'm using Leibniz' pi formula as reference)
pi(0, 0).
pi(Next, Result) :-
Num is -1**(Next + 1),
Part is Num / (2 * Next - 1),
N1 is Next -1,
pi(N1, R),
Result is Part + R.
Now, I'm aware that the addition at the end is wrong. Also I need to multiply the end result by 4 and I don't know how to do that. Would be glad if anyone could help out. And no, this is not a homework or anything. :)
Here's a slightly different twist that terminates based upon reaching a given precision. It also is tail recursive. Because Leibniz converges very slowly, the formula is a stack hog when done using simple recursion. it's not an algorithm well-suited for a recursive solution in any language. However, a smart Prolog interpreter can take advantage of the tail recursion and avoid that. Just by way of example, it only allows precision within a specific range.
pi(Precision, Pi) :-
Precision > 0.0000001,
Precision < 0.1,
pi_over_4(1, 1, Precision/4, 1, Pi_over_4), % Compensate for *4 later
Pi is Pi_over_4 * 4.
pi_over_4(AbsDenominator, Numerator, Precision, Sum, Result) :-
NewAbsDenominator is AbsDenominator + 2,
NewNumerator is -Numerator,
NewSum is Sum + NewNumerator/NewAbsDenominator,
( abs(NewSum - Sum) < Precision
-> Result = NewSum
; pi_over_4(NewAbsDenominator, NewNumerator, Precision, NewSum, Result)
).
2 ?- pi(0.0001, P).
P = 3.1416426510898874.
3 ?- pi(0.00001, P).
P = 3.141597653564762.
4 ?- pi(0.000005, P).
P = 3.141595153583494.
This is strictly an imperative use of Prolog, which isn't what Prolog is strong for.

Prolog Recursion (Factorial of a Power Function)

I am having some troubles with my CS assignment. I am trying to call another rule that I created previously within a new rule that will calculate the factorial of a power function (EX. Y = (N^X)!). I think the problem with my code is that Y in exp(Y,X,N) is not carrying over when I call factorial(Y,Z), I am not entirely sure though. I have been trying to find an example of this, but I haven been able to find anything.
I am not expecting an answer since this is homework, but any help would be greatly appreciated.
Here is my code:
/* 1.2: Write recursive rules exp(Y, X, N) to compute mathematical function Y = X^N, where Y is used
to hold the result, X and N are non-negative integers, and X and N cannot be 0 at the same time
as 0^0 is undefined. The program must print an error message if X = N = 0.
*/
exp(_,0,0) :-
write('0^0 is undefined').
exp(1,_,0).
exp(Y,X,N) :-
N > 0, !, N1 is N - 1, exp(Y1, X, N1), Y is X * Y1.
/* 1.3: Write recursive rules factorial(Y,X,N) to compute Y = (X^N)! This function can be described as the
factorial of exp. The rules must use the exp that you designed.
*/
factorial(0,X) :-
X is 1.
factorial(N,X) :-
N> 0, N1 is N - 1, factorial(N1,X1), X is X1 * N.
factorial(Y,X,N) :-
exp(Y,X,N), factorial(Y,Z).
The Z variable mentioned in factorial/3 (mentioned only once; so-called 'singleton variable', cannot ever get unified with anything ...).
Noticed comments under question, short-circuiting it to _ won't work, you have to unify it with a sensible value (what do you want to compute / link head of the clause with exp and factorial through parameters => introduce some parameter "in the middle"/not mentioned in the head).
Edit: I'll rename your variables for you maybe you'll se more clearly what you did:
factorial(Y,X,Result) :-
exp(Y,X,Result), factorial(Y,UnusedResult).
now you should see what your factorial/3 really computes, and how to fix it.

Generic function for solving n-order polynomial roots in Julia

All,
I've just been starting to play around with the Julia language and am enjoying it quite a bit. At the end of the 3rd tutorial there's an interesting problem: genericize the quadratic formula such that it solves for the roots of any n-order polynomial equation.
This struck me as (a) an interesting programming problem and (b) an interesting Julia problem. Has anyone out there solved this one? For reference, here is the Julia code with a couple toy examples. Again, the idea is to make this generic for any n-order polynomial.
Cheers,
Aaron
function derivative(f)
return function(x)
# pick a small value for h
h = x == 0 ? sqrt(eps(Float64)) : sqrt(eps(Float64)) * x
# floating point arithmetic gymnastics
xph = x + h
dx = xph - x
# evaluate f at x + h
f1 = f(xph)
# evaluate f at x
f0 = f(x)
# divide the difference by h
return (f1 - f0) / dx
end
end
function quadratic(f)
f1 = derivative(f)
c = f(0.0)
b = f1(0.0)
a = f(1.0) - b - c
return (-b + sqrt(b^2 - 4a*c + 0im))/2a, (-b - sqrt(b^2 - 4a*c + 0im))/2a
end
quadratic((x) -> x^2 - x - 2)
quadratic((x) -> x^2 + 2)
The package PolynomialRoots.jl provides the function roots() to find all (real and complex) roots of polynomials of any order. The only mandatory argument is the array with coefficients of the polynomial in ascending order.
For example, in order to find the roots of
6x^5 + 5x^4 + 3x^2 + 2x + 1
after loading the package (using PolynomialRoots) you can use
julia> roots([1, 2, 3, 4, 5, 6])
5-element Array{Complex{Float64},1}:
0.294195-0.668367im
-0.670332+2.77556e-17im
0.294195+0.668367im
-0.375695-0.570175im
-0.375695+0.570175im
The package is a Julia implementation of the root-finding algorithm described in this paper: http://arxiv.org/abs/1203.1034
PolynomialRoots.jl has also support for arbitrary precision calculation. This is useful for solving equation that cannot be solved in double precision. For example
julia> r = roots([94906268.375, -189812534, 94906265.625]);
julia> (r[1], r[2])
(1.0000000144879793 - 0.0im,1.0000000144879788 + 0.0im)
gives the wrong result for the polynomial, instead passing the input array in arbitrary precision forces arbitrary precision calculations that provide the right answer (see https://en.wikipedia.org/wiki/Loss_of_significance):
julia> r = roots([BigFloat(94906268.375), BigFloat(-189812534), BigFloat(94906265.625)]);
julia> (Float64(r[1]), Float64(r[2]))
(1.0000000289759583,1.0)
There are no algebraic formulae for a general polynomials of degree five and above (infact there cant be see here). So theoretically, you could proceed using the same methodology for solutions to cubics and quartics, but even that would be a lot of hard work given very unwieldy formulae for roots of quartics. You could also use a CAS like SymPy to find out those formulae.

Finding Binet form in Mathematica

Suppose I have a linear recurrence* and I want to find its closed-form 'Binet' representation. Is there a good way to do this in Mathematica?
It seems like a very basic request, and there are certainly many natural ways to ask Mathematica to do it for me. But so far everything I've tried has failed: it churns until its memory use is so high the operating system is obliged to close it, or it gives warnings that it does not know how to simplify simple expressions†, or the like. I could understand this if the question was hard, but it's not—factor the characteristic equation, find the roots, and solve a linear system. The most recent time I tried this (and had the program crash) was on a degree-9 example, and I just don't think a 9-by-9 linear system should be that hard to solve.
Surely I'm not the only one who need to do this from time to time! What is the right way to do this?
I lost my session so I don't have the exact code I tried. One solution created a List with the recurrence and its initial points and used RSolve. Another found and factored the characteristic equation and took appropriate roots to the n-th power multiplied by polynomials of degree corresponding to the multiplicity with coefficients generated from C[i]. I also tried Solve and Reduce in various ways.
* Or a rational generating function. Actually I'll start from a List of numbers which are described by a recurrence of less than half its length, and FindLinearRecurrence or FindGeneratingFunction can do the not-too-difficult conversion.
† For example, when I asked it to solve one recurrence it choked on sin^2 (3pi/14) + cos^2(3pi/14) in the course of the calculation, saying that ran out of precision. You'd think it could symbolically simplify something like that, but no.
I'm not sure if this is what you had in mind, but you could do something like
Binet[ker_List, init_List] :=
Module[{charp, roots, polynomials, coeffs, base, p},
roots = Tally[
N#Eigenvalues[
PadLeft[Append[IdentityMatrix[Length[ker] - 1], Reverse[ker]]]]];
coeffs = Table[p[i, j], {i, Length[roots]}, {j, roots[[i, 2]]}];
polynomials =
Table[(Evaluate[i.#^Range[0, Length[i] - 1]]) &, {i, coeffs}];
base = roots[[All, 1]];
{polynomials /.
Solve[Table[
Through[polynomials[n]].base^n == init[[n + 1]], {n, 0,
Length[init] - 1}], Flatten[coeffs]][[1]], base}]
Then for a linear recurrence kernel and initial values init, Binet[kernel, init] returns two lists. The first one contains the polynomials and the second the roots of the characteristic polynomial. The n-th entry in the recurrence table is then equal to a[kernel, init][n] with
a[kernel_, init_] := Evaluate#Module[{p, b},
{p, b} = Binet[kernel, init];
Through[p[#]].b^#] &
So for example for the Fibonacci sequence you would get
kernel = {1, 1};
init = {1, 1};
{p, b} = Binet[kernel, init]
(* ==> {{0.723607 &, 0.276393 &}, {1.61803, -0.618034}} *)
With[{sol = a[{1, 1}, {1, 1}]},
Table[Chop#sol[n], {n, 0, 10}]];
(* ==> {1., 1., 2., 3., 5., 8., 13., 21., 34., 55., 89.} *)
I have no knowledge of Binet form, but addressing your concern regarding simplification:
expr = Sin[3 pi/14]^2 + Cos[3 pi/14]^2;
Simplify[expr]
1

Resources