Error in RecurrenceTable with symbolic input - wolfram-mathematica

I am finally working on my n-point Pade code, again, and I am running across an error that was not occurring previously. The heart of the matter revolves around this code:
zi = {0.1, 0.2, 0.3}
ai = {0.904837, 1.05171, -0.499584}
Quiet[ RecurrenceTable[ {A[0] == 0, A[1] == ai[[1]],
A[n+1]==A[n] + (z - zi[[n]]) ai[[n+1]] A[n-1]},
A, {n, Length#ai -1 } ],
{Part::pspec}]
(The use of Quiet is necessary as Part complains about zi[[n]] and ai[[n+1]] when n is purely symbolic.) The code itself is part of a function that I want a symbolic result from, hence z is a Symbol. But, when I run the above code I get the error:
RecurrenceTable::nlnum1:
The function value {0.904837,0.904837+0. z} is not a list of numbers with
dimensions {2} when the arguments are {0,0.,0.904837}.
Note the term {0.904837,0.904837+0. z} where 0. z is not reduced to zero. What do I need to do to force it to evaluate to zero, as it seems to be the source of the problem? Are there alternatives?
Additionally, as a general complaint about the help system for the Wolfram Research personnel who haunt stackoverflow: in v.7 RecurrenceTable::nlnum1 is not searchable! Nor, does the >> link at the end of the error take you to the error definition, but takes you to the definition of RecurrenceTable, instead, where the common errors are not cross-referenced.
Edit: After reviewing my code, the solution I came up with was to evaluate the RecurrenceTable completely symbolically, including the initial conditions. The working code is as follows:
Clear[NPointPade, NPointPadeFcn]
NPointPade[pts : {{_, _} ..}] := NPointPade ## Transpose[pts]
NPointPade[zi_List, fi_List] /; Length[zi] == Length[fi] :=
Module[{ap, fcn, rec},
ap = {fi[[1]]};
fcn = Module[{gp = #, zp, res},
zp = zi[[-Length#gp ;;]];
res = (gp[[1]] - #)/((#2 - zp[[1]]) #) &[Rest#gp, Rest#zp];
AppendTo[ap, res[[1]]];
res
] &;
NestWhile[fcn, fi, (Length[#] > 1 &)];
(*
The recurrence relation is used twice, with different initial conditions, so
pre-evaluate it to pass along to NPointPadeFcn
*)
rec[aif_, zif_, a_, b_][z_] :=
Evaluate[RecurrenceTable[
{A[n + 1] == A[n] + (z - zif[n])*aif[n + 1]*A[n - 1],
A[0] == a, A[1] == b},
A, {n, {Length#ap - 1}}][[1]]];
NPointPadeFcn[{zi, ap, rec }]
]
NPointPadeFcn[{zi_List, ai_List, rec_}][z_] /; Length[zi] == Length[ai] :=
Module[{aif, zif},
zif[n_Integer] /; 1 <= n <= Length[zi] := zi[[n]];
aif[n_Integer] /; 1 <= n <= Length[zi] := ai[[n]];
rec[aif, zif, 0, ai[[1]]][z]/rec[aif, zif, 1, 1][z]
]
Format[NPointPadeFcn[x_List]] := NPointPadeFcn[Shallow[x, 1]];
Like the built-in interpolation functions, NPointPade does some pre-processing, and returns a function that can be evaluated, NPointPadeFcn. The pre-processing done by NPointPade generates the list of ais from the zis and the function values at those points, in addition to pre-evaluating the recurrence relations. When NPointPadeFcn is supplied with a z value, it evaluates two linear recurrence relations by supplying it with the appropriate values.
Edit: for the curious, here's NPointPade in operation
In the first plot, it is difficult to tell the difference between the two functions, but the second plot shows the absolute (blue) and relative (red) errors. As written, it takes a very long time to create a Pade for 20 points, so I need to work on speeding it up. But, for now, it works.

You can hide part extraction behind a function:
In[122]:= zi = {0.1, 0.2, 0.3};
ai = {0.904837, 1.05171, -0.499584};
In[124]:= zif[n_Integer] /; 1 <= n <= Length[zi] := zi[[n]]
aif[n_Integer] /; 1 <= n <= Length[ai] := ai[[n]]
In[127]:= RecurrenceTable[{A[0] == 0, A[1] == aif[1],
A[n + 1] ==
A[n] + (z - zif[n]) aif[n + 1] A[n - 1]}, A, {n, (Length#ai) - 1}]
Out[127]= {0.904837, 0.904837,
0.904837 - 0.271451 aif[4] + 0.904837 z aif[4]}
EDIT
Here is the work-around for the problem:
In[4]:= zi = {0.1, 0.2, 0.3};
ai = {0.904837, 1.05171, -0.499584};
In[6]:= zif[n_Integer] /; 1 <= n <= Length[zi] := zi[[n]]
aif[n_Integer] /; 1 <= n <= Length[ai] := ai[[n]]
In[8]:= Block[{aif, zif},
RecurrenceTable[{A[0] == 0, A[1] == aif[1],
A[n + 1] == A[n] + (z - zif[n]) aif[n + 1] A[n - 1]},
A, {n, 0, (Length#ai) - 1}]]
Out[8]= {0, 0.904837, 0.904837}
Block serves to temporarily remove definitions of aif and zif while RecurrenceTable is executed. Then, when Block exits, the values are restored, and the output of RecurrenceTable evaluates.

It seems to me that Sasha's approach can be mimicked by just Blocking Part.
zi = {0.1, 0.2, 0.3};
ai = {0.904837, 1.05171, -0.499584};
Block[{Part},
RecurrenceTable[{A[0] == 0, A[1] == ai[[1]],
A[n + 1] == A[n] + (z - zi[[n]]) ai[[n + 1]] A[n - 1]},
A, {n, Length#ai - 1}]
]
{0, 0.904837, 0.904837}
Addressing Sasha's criticism, here are two other ways one might approach this:
With[{Part = $z},
RecurrenceTable[{A[0] == 0, A[1] == ai[[1]],
A[n + 1] == A[n] + (z - zi[[n]]) ai[[n + 1]] A[n - 1]},
A, {n, Length#ai - 1}]
] /. $z -> Part
-
With[{Part = Hold[Part]},
RecurrenceTable[{A[0] == 0, A[1] == ai[[1]],
A[n + 1] == A[n] + (z - zi[[n]]) ai[[n + 1]] A[n - 1]},
A, {n, Length#ai - 1}]
] // ReleaseHold

Related

List generation via Array in Wolfram Language

I have a code where we first need to generate n + 1 numbers in a range with a given step. However, I don't understand how and why it works:
a = 2;
b = 7;
h = (b-a)/n;
x[0] = a;
Array[x, n+1, 0];
For[i = 0, i < n + 1, i++, x[i] = a + h*i]
My questions are:
Are elements of x automatically generated when accessed? There's no mention of x before the line x[0] = a
Shouldn't index access be like x[[i]]?
What exactly does Array do here? It isn't assigned to anything which confuses me
Try Range[2,10,2] for a range of numbers from 2 to 10 in steps of 2, etc.
Beyond that there some faults in your code, or perhaps in your understanding of Mathematica ...
x[0] = a defines a function called x which, when presented with argument 0 returns a (or a's value since it is previously defined). Mathematica is particular about the bracketing characters used [ and ] enclose function argument lists. Since there is no other definition for the function x (at least not that we can see here) then it will return unevaluated for any argument other than 0.
And you are right, doubled square brackets, ie [[ and ]], are used to enclose index values. x[[2]] would indeed refer to the second element of a list called x. Note that Mathematica indexes from 1 so x[[0]] would produce an error if x existed and was a list.
The expression Array[x, n+1, 0] does return a value, but it is not assigned to any symbol so is lost. And the trailing ; on the line suppresses Mathematica's default behaviour to print the return value of any expression you execute.
Finally, on the issue of the use of For to make lists of values, refer to https://mathematica.stackexchange.com/questions/7924/alternatives-to-procedural-loops-and-iterating-over-lists-in-mathematica. And perhaps ask further Mathematica questions at that site, the real experts on the system are much more likely to be found there.
I suppose I might add ... if you are committed to using Array for some reason ask another question specifically about that. As you might (not) realise, I recommend not using that function to create a list of numbers.
From the docs, Array[f, n, r] generates a list using the index origin r.
On its own Array[x, n + 1, 0] just produces a list of x functions, e.g.
n = 4;
Array[x, n + 1, 0]
{x[0], x[1], x[2], x[3], x[4]}
If x is defined it is applied, e.g.
x[arg_] := arg^2
Array[x, 4 + 1, 0]
{0, 1, 4, 9, 16}
Alternatively, to use x as a function variable the Array can be set like so
Clear[x]
With[{z = Array[x, n + 1, 0]}, z = {m, n, o, p, q}]
{x[0], x[1], x[2], x[3], x[4]}
{m, n, o, p, q}
The OP's code sets function variables of x in the For loop, e.g.
Still with n = 4
a = 2;
b = 7;
h = (b - a)/n;
For[i = 0, i < n + 1, i++, x[i] = a + h*i]
which can be displayed by Array[x, n + 1, 0]
{2, 13/4, 9/2, 23/4, 7}
also x[0] == 2
True
The same could be accomplished thusly
Clear[x]
With[{z = Array[x, n + 1, 0]}, z = Table[a + h*i, {i, 0, 4}]]
{2, 13/4, 9/2, 23/4, 7}
Note also DownValues[x] shows the function definitions
{HoldPattern[x[0]] :> 2,
HoldPattern[x[1]] :> 13/4,
HoldPattern[x[2]] :> 9/2,
HoldPattern[x[3]] :> 23/4,
HoldPattern[x[4]] :> 7}

How to find a desired initial condition?

I am solving a set of differential equations, where the coefficient is determined by the solution itself. Here is a minimal example:
s = NDSolve[{M'[r] == a r^2, M[0] == 0}, M, r];
Plot[Evaluate[M[r] /. s], {r, 0, 1}]
where a is determined by requiring M[r=1]=1. Once the correct a is found, I then solve the equations normally and plot M[r]. In fortran I could iterate over a until such a requirement is met. I would like to know how to do this with Mathematica, or better still, do this more elegantly (not iterating, since it is time consuming in Mathematica).
Or if you find the above example too silly, here is the original problem:
s = NDSolve[{M'[r] == r^2 Exp[lnp[r]], lnp'[r] == - M[r]/r^2, M[0.01] == 0, lnp[0.01] == a}, {M, lnp}, {r, 0.01, 1}]
Plot[Evaluate[M[r] /. s], {r, 0.01, 1}]
where a is determined by requiring M[1]=1.
Thanks!
There is probably a neater way of doing this.
DSolve[D[M[r], r] == a r^2, M[r], r]
{{M[r] -> (a r^3)/3 + C[1]}} . . . (eqn. 1)
From eqn. 1, when r = 0, M[0] == C[1], therefore
M[r] == (a r^3)/3 + M[0]
Given M[0] = 0
M[r] == (a r^3)/3
Also given M[1] = 1, a == 3, therefore
M[r_] := r^3
Plot[M[r], {r, 0, 10}]

How to efficiently set matrix's minor in Mathematica?

While looking at the belisarius's question about generation of non-singular integer matrices with uniform distribution of its elements, I was studying a paper by Dana Randal, "Efficient generation of random non-singular matrices". The algorithm proposed is recursive, and involves generating a matrix of lower dimension and assigning it to a given minor. I used combinations of Insert and Transpose to do it, but there are must be more efficient ways of doing it. How would you do it?
The following is the code:
Clear[Gen];
Gen[p_, 1] := {{{1}}, RandomInteger[{1, p - 1}, {1, 1}]};
Gen[p_, n_] := Module[{v, r, aa, tt, afr, am, tm},
While[True,
v = RandomInteger[{0, p - 1}, n];
r = LengthWhile[v, # == 0 &] + 1;
If[r <= n, Break[]]
];
afr = UnitVector[n, r];
{am, tm} = Gen[p, n - 1];
{Insert[
Transpose[
Insert[Transpose[am], RandomInteger[{0, p - 1}, n - 1], r]], afr,
1], Insert[
Transpose[Insert[Transpose[tm], ConstantArray[0, n - 1], r]], v,
r]}
]
NonSingularRandomMatrix[p_?PrimeQ, n_] := Mod[Dot ## Gen[p, n], p]
It does generate a non-singular matrix, and has uniform distribution of matrix elements, but requires p to be prime:
The code is also not every efficient, which is, I suspect due to my inefficient matrix constructors:
In[10]:= Timing[NonSingularRandomMatrix[101, 300];]
Out[10]= {0.421, Null}
EDIT So let me condense my question. The minor matrix of a given matrix m can be computed as follows:
MinorMatrix[m_?MatrixQ, {i_, j_}] :=
Drop[Transpose[Drop[Transpose[m], {j}]], {i}]
It is the original matrix with i-th row and j-th column deleted.
I now need to create a matrix of size n by n that will have the given minor matrix mm at position {i,j}. What I used in the algorithm was:
ExpandMinor[minmat_, {i_, j_}, v1_,
v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[minmat] :=
Insert[Transpose[Insert[Transpose[minmat], v2, j]], v1, i]
Example:
In[31]:= ExpandMinor[
IdentityMatrix[4], {2, 3}, {1, 2, 3, 4, 5}, {2, 3, 4, 4}]
Out[31]= {{1, 0, 2, 0, 0}, {1, 2, 3, 4, 5}, {0, 1, 3, 0, 0}, {0, 0, 4,
1, 0}, {0, 0, 4, 0, 1}}
I am hoping this can be done more efficiently, which is what I am soliciting in the question.
Per blisarius's suggestion I looked into implementing ExpandMinor via ArrayFlatten.
Clear[ExpandMinorAlt];
ExpandMinorAlt[m_, {i_ /; i > 1, j_}, v1_,
v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[m] :=
ArrayFlatten[{
{Part[m, ;; i - 1, ;; j - 1], Transpose#{v2[[;; i - 1]]},
Part[m, ;; i - 1, j ;;]},
{{v1[[;; j - 1]]}, {{v1[[j]]}}, {v1[[j + 1 ;;]]}},
{Part[m, i ;;, ;; j - 1], Transpose#{v2[[i ;;]]}, Part[m, i ;;, j ;;]}
}]
ExpandMinorAlt[m_, {1, j_}, v1_,
v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[m] :=
ArrayFlatten[{
{{v1[[;; j - 1]]}, {{v1[[j]]}}, {v1[[j + 1 ;;]]}},
{Part[m, All, ;; j - 1], Transpose#{v2}, Part[m, All, j ;;]}
}]
In[192]:= dim = 5;
mm = RandomInteger[{-5, 5}, {dim, dim}];
v1 = RandomInteger[{-5, 5}, dim + 1];
v2 = RandomInteger[{-5, 5}, dim];
In[196]:=
Table[ExpandMinor[mm, {i, j}, v1, v2] ==
ExpandMinorAlt[mm, {i, j}, v1, v2], {i, dim}, {j, dim}] //
Flatten // DeleteDuplicates
Out[196]= {True}
It took me a while to get here, but since I spent a good part of my postdoc generating random matrices, I could not help it, so here goes. The main inefficiency in the code comes from the necessity to move matrices around (copy them). If we could reformulate the algorithm so that we only modify a single matrix in place, we could win big. For this, we must compute the positions where the inserted vectors/rows will end up, given that we will typically insert in the middle of smaller matrices and thus shift the elements. This is possible. Here is the code:
gen = Compile[{{p, _Integer}, {n, _Integer}},
Module[{vmat = Table[0, {n}, {n}],
rs = Table[0, {n}],(* A vector of r-s*)
amatr = Table[0, {n}, {n}],
tmatr = Table[0, {n}, {n}],
i = 1,
v = Table[0, {n}],
r = n + 1,
rsc = Table[0, {n}], (* recomputed r-s *)
matstarts = Table[0, {n}], (* Horizontal positions of submatrix starts at a given step *)
remainingShifts = Table[0, {n}]
(*
** shifts that will be performed after a given row/vector insertion,
** and can affect the real positions where the elements will end up
*)
},
(*
** Compute the r-s and vectors v all at once. Pad smaller
** vectors v with zeros to fill a rectangular matrix
*)
For[i = 1, i <= n, i++,
While[True,
v = RandomInteger[{0, p - 1}, i];
For[r = 1, r <= i && v[[r]] == 0, r++];
If[r <= i,
vmat[[i]] = PadRight[v, n];
rs[[i]] = r;
Break[]]
]];
(*
** We must recompute the actual r-s, since the elements will
** move due to subsequent column insertions.
** The code below repeatedly adds shifts to the
** r-s on the left, resulting from insertions on the right.
** For example, if vector of r-s
** is {1,2,1,3}, it will become {1,2,1,3}->{2,3,1,3}->{2,4,1,3},
** and the end result shows where
** in the actual matrix the columns (and also rows for the case of
** tmatr) will be inserted
*)
rsc = rs;
For[i = 2, i <= n, i++,
remainingShifts = Take[rsc, i - 1];
For[r = 1, r <= i - 1, r++,
If[remainingShifts[[r]] == rsc[[i]],
Break[]
]
];
If[ r <= n,
rsc[[;; i - 1]] += UnitStep[rsc[[;; i - 1]] - rsc[[i]]]
]
];
(*
** Compute the starting left positions of sub-
** matrices at each step (1x1,2x2,etc)
*)
matstarts = FoldList[Min, First#rsc, Rest#rsc];
(* Initialize matrices - this replaces the recursion base *)
amatr[[n, rsc[[1]]]] = 1;
tmatr[[rsc[[1]], rsc[[1]]]] = RandomInteger[{1, p - 1}];
(* Repeatedly perform insertions - this replaces recursion *)
For[i = 2, i <= n, i++,
amatr[[n - i + 2 ;; n, rsc[[i]]]] = RandomInteger[{0, p - 1}, i - 1];
amatr[[n - i + 1, rsc[[i]]]] = 1;
tmatr[[n - i + 2 ;; n, rsc[[i]]]] = Table[0, {i - 1}];
tmatr[[rsc[[i]],
Fold[# + 1 - Unitize[# - #2] &,
matstarts[[i]] + Range[0, i - 1], Sort[Drop[rsc, i]]]]] =
vmat[[i, 1 ;; i]];
];
{amatr, tmatr}
],
{{FoldList[__], _Integer, 1}}, CompilationTarget -> "C"];
NonSignularRanomMatrix[p_?PrimeQ, n_] := Mod[Dot ## Gen[p, n],p];
NonSignularRanomMatrixAlt[p_?PrimeQ, n_] := Mod[Dot ## gen[p, n],p];
Here is the timing for the large matrix:
In[1114]:= gen [101, 300]; // Timing
Out[1114]= {0.078, Null}
For the histogram, I get the identical plots, and the 10-fold efficiency boost:
In[1118]:=
Histogram[Table[NonSignularRanomMatrix[11, 5][[2, 3]], {10^4}]]; // Timing
Out[1118]= {7.75, Null}
In[1119]:=
Histogram[Table[NonSignularRanomMatrixAlt[11, 5][[2, 3]], {10^4}]]; // Timing
Out[1119]= {0.687, Null}
I expect that upon careful profiling of the above compiled code, one could further improve the performance. Also, I did not use runtime Listable attribute in Compile, while this should be possible. It may also be that the parts of the code which perform assignment to minors are generic enough so that the logic can be factored out of the main function - I did not investigate that yet.
For the first part of your question (which I hope I understand properly) can
MinorMatrix be written as follows?
MinorMatrixAlt[m_?MatrixQ, {i_, j_}] := Drop[mat, {i}, {j}]

Mathematica integral with many singularities

What's the best way of getting Mathematica 7 or 8 to do the integral
NIntegrate[Exp[-x]/Sin[Pi x], {x, 0, 50}]
There are poles at every integer - and we want the Cauchy principle value.
The idea is to get a good approximation for the integral from 0 to infinity.
With Integrate there is the option PrincipleValue -> True.
With NIntegrate I can give it the option Exclusions -> (Sin[Pi x] == 0), or manually give it the poles by
NIntegrate[Exp[-x]/Sin[Pi x], Evaluate[{x, 0, Sequence##Range[50], 50}]]
The original command and the above two NIntegrate tricks give the result 60980 +/- 10. But they all spit out errors. What is the best way of getting a quick reliable result for this integral without Mathematica wanting to give errors?
Simon, is there reason to believe your integral is convergent ?
In[52]:= f[k_Integer, eps_Real] :=
NIntegrate[Exp[-x]/Sin[Pi x], {x, k + eps, k + 1 - eps}]
In[53]:= Sum[f[k, 1.0*10^-4], {k, 0, 50}]
Out[53]= 2.72613
In[54]:= Sum[f[k, 1.0*10^-5], {k, 0, 50}]
Out[54]= 3.45906
In[55]:= Sum[f[k, 1.0*10^-6], {k, 0, 50}]
Out[55]= 4.19199
It looks like the problem is at x==0. Splitting integrand k+eps to k+1-eps for integer values of k:
In[65]:= int =
Sum[(-1)^k Exp[-k ], {k, 0, Infinity}] Integrate[
Exp[-x]/Sin[Pi x], {x, eps, 1 - eps}, Assumptions -> 0 < eps < 1/2]
Out[65]= (1/((1 +
E) (I + \[Pi])))E (2 E^(-1 + eps - I eps \[Pi])
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(-2 I eps \[Pi])] +
2 E^(I eps (I + \[Pi]))
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(2 I eps \[Pi])])
In[73]:= N[int /. eps -> 10^-6, 20]
Out[73]= 4.1919897038160855098 + 0.*10^-20 I
In[74]:= N[int /. eps -> 10^-4, 20]
Out[74]= 2.7261330651934049862 + 0.*10^-20 I
In[75]:= N[int /. eps -> 10^-5, 20]
Out[75]= 3.4590554287709991277 + 0.*10^-20 I
As you see there is a logarithmic singularity.
In[79]:= ser =
Assuming[0 < eps < 1/32, FullSimplify[Series[int, {eps, 0, 1}]]]
Out[79]= SeriesData[eps, 0, {(I*(-1 + E)*Pi -
2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1]
In[80]:= Normal[
ser] /. {{eps -> 1.*^-6}, {eps -> 0.00001}, {eps -> 0.0001}}
Out[80]= {4.191989703816426 - 7.603403526913691*^-17*I,
3.459055428805136 -
7.603403526913691*^-17*I,
2.726133068607085 - 7.603403526913691*^-17*I}
EDIT
Out[79] of the code above gives the series expansion for eps->0, and if these two logarithmic terms get combined, we get
In[7]:= ser = SeriesData[eps, 0,
{(I*(-1 + E)*Pi - 2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*
Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1];
In[8]:= Collect[Normal[PowerExpand //# (ser + O[eps])],
Log[eps], FullSimplify]
Out[8]= -(Log[eps]/\[Pi]) + (
I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
Clearly the -Log[eps]/Pi came from the pole at x==0. So if one subtracts this, just like principle value method does this for other poles you end up with a finitely value:
In[9]:= % /. Log[eps] -> 0
Out[9]= (I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
In[10]:= N[%, 20]
Out[10]= -0.20562403655659928968 + 0.*10^-21 I
Of course, this result is difficult to verify numerically, but you might know more that I do about your problem.
EDIT 2
This edit is to justify In[65] input that computes the original regularized integral. We are computing
Sum[ Integrate[ Exp[-x]/Sin[Pi*x], {x, k+eps, k+1-eps}], {k, 0, Infinity}] ==
Sum[ Integrate[ Exp[-x-k]/Sin[Pi*(k+x)], {x, eps, 1-eps}], {k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k]*Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}],
{k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k], {k, 0, Infinity}] *
Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}]
In the third line Sin[Pi*(k+x)] == (-1)^k*Sin[Pi*x] for integer k was used.
Simon, I haven't spent much time with your integral, but you should try looking at stationary phase approximation. What you have is a smooth function (exp), and a highly oscillatory function (sine). The work involved is now in brow-beating the 1/sin(x) into the form exp(if(x))
Alternatively, you could use the series expansion of the cosecant (not valid at poles):
In[1]:=Series[Csc[x], {x, 0, 5}]
(formatted) Out[1]=1/x + x/6 + 7/360 x^3 + 31/15120 x^5 +O[x]^6
Note that for all m>-1, you have the following:
In[2]:=Integrate[x^m Exp[-x], {x, 0, Infinity}, Assumptions -> m > -1]
Out[2]=Gamma[1+m]
However, summing the series with the coefficients of cosecant (from wikipedia), not including 1/x Exp[-x] case, which doesn't converge on [0,Infinity].
c[m_] := (-1)^(m + 1) 2 (2^(2 m - 1) - 1) BernoulliB[2 m]/Factorial[2 m];
Sum[c[m] Gamma[1 + 2 m - 1], {m, 1, Infinity}]
does not converge either...
So, I'm not sure that you can work out an approximation for the integral to infinity, but I if you're satisfied with a solution upto some large N, I hope these help.
I have to agree with Sasha, the integral does not appear to be convergent. However, if you exclude x == 0 and break the integral into pieces
Integrate[Exp[-x]/Sin[Pi x], {x, n + 1/2, n + 3/2}, PrincipalValue -> True]
where n >= 0 && Element[n, Integers], then it seems you may get an alternating series
I Sum[ (-1/E)^n, {n, 1, Infinity}] == - I / (1 + E )
Now, I only took it out to n == 4, but it looks reasonable. However, for the integral above with Assumptions -> Element[n, Integers] && n >= 0 Mathematica gives
If[ 2 n >= 1, - I / E, Integrate[ ... ] ]
which just doesn't conform to the individual cases. As an additional note, if the pole lies at the boundary of the integration region, i.e. your limits are {x, n, n + 1}, you only get DirectedInfinitys. A quick look at the plot implies that you with the limits {x, n, n + 1} you only have a strictly positive or negative integrand, so the infinite value may be due to the lack of compensation which {x, n + 1/2, n + 3/2} gives you. Checking with {x, n, n + 2}, however it only spits out the unevaluated integral.

How to solve recursion relations analytically in mathematica?

For example, I have the following recursion and I want to get f[3,n]:
f[m_, n_] := Module[{}, If[m < 0, Return[0];];
If[m == 0, Return[1];];
If[2*m - 1 >= n, Return[0];];
If[2*m == n, Return[2];];
If[m == 1, Return[n];];
Return[f[m, n - 1] + f[m - 1, n - 2]];]
f[3, n]
The code does not seem to work. Please help. Many thanks!
You have an infinite recursion because when m is not initialized, none of the boundary cases match.
Instead of using Return you'll get more predictable behavior if you use functional programming, ie
f[m_, n_] := Which[
m < 0, 0,
2 m - 1 >= n, 0,
2 m == n, 2,
m == 1, n,
True, f[m, n - 1] + f[m - 1, n - 2]
]
In this case Which can not decide which option to take with n not initialized, so f[3, n] will return an expression.
One way to get a formula is with RSolve. Doesn't look like it can solve this equation in full generality, but you can try it with one variable fixed using something like this
Block[{m = 3},
RSolve[f[m, n] == f[m, n - 1] + f[m - 1, n - 2], f[m, n], {n}]
]
In the result you will see K[1] which is an arbitrary iteration variable and C[1] which is a free constant. It's there because boundary case is not specified

Resources