The renewal function for Weibull distribution m(t) with t = 10 is given as below.
I want to find the value of m(t). I wrote the following r code to compute m(t)
last_term = NULL
gamma_k = NULL
n = 50
for(k in 1:n){
gamma_k[k] = gamma(2*k + 1)/factorial(k)
}
for(j in 1: (n-1)){
prev = gamma_k[n-j]
last_term[j] = gamma(2*j + 1)/factorial(j)*prev
}
final_term = NULL
find_value = function(n){
for(i in 2:n){
final_term[i] = gamma_k[i] - sum(last_term[1:(i-1)])
}
return(final_term)
}
all_k = find_value(n)
af_sum = NULL
m_t = function(t){
for(k in 1:n){
af_sum[k] = (-1)^(k-1) * all_k[k] * t^(2*k)/gamma(2*k + 1)
}
return(sum(na.omit(af_sum)))
}
m_t(20)
The output is m(t) = 2.670408e+93. Does my iteratvie procedure correct? Thanks.
I don't think it will work. First, lets move Γ(2k+1) from denominator of m(t) into Ak. Thus, Ak will behave roughly as 1/k!.
In the nominator of the m(t) terms there is t2k, so roughly speaking you're computing sum with terms
100k/k!
From Stirling formula
k! ~ kk, making terms
(100/k)k
so yes, they will start to decrease and converge to something but after 100th term
Anyway, here is the code, you could try to improve it, but it breaks at k~70
N <- 20
A <- rep(0, N)
# compute A_k/gamma(2k+1) terms
ps <- 0.0 # previous sum
A[1] = 1.0
for(k in 2:N) {
ps <- ps + A[k-1]*gamma(2*(k-1) + 1)/factorial(k-1)
A[k] <- 1.0/factorial(k) - ps/gamma(2*k+1)
}
print(A)
t <- 10.0
t2 <- t*t
r <- 0.0
for(k in 1:N){
r <- r + (-t2)^k*A[k]
}
print(-r)
UPDATE
Ok, I calculated Ak as in your question, got the same answer. I want to estimate terms Ak/Γ(2k+1) from m(t), I believe it will be pretty much dominated by 1/k! term. To do that I made another array k!*Ak/Γ(2k+1), and it should be close to one.
Code
N <- 20
A <- rep(0.0, N)
psum <- function( pA, k ) {
ps <- 0.0
if (k >= 2) {
jmax <- k - 1
for(j in 1:jmax) {
ps <- ps + (gamma(2*j+1)/factorial(j))*pA[k-j]
}
}
ps
}
# compute A_k/gamma(2k+1) terms
A[1] = gamma(3)
for(k in 2:N) {
A[k] <- gamma(2*k+1)/factorial(k) - psum(A, k)
}
print(A)
B <- rep(0.0, N)
for(k in 1:N) {
B[k] <- (A[k]/gamma(2*k+1))*factorial(k)
}
print(B)
shows that
I got the same Ak values as you did.
Bk is indeed very close to 1
It means that term Ak/Γ(2k+1) could be replaced by 1/k! to get quick estimate of what we might get (with replacement)
m(t) ~= - Sum(k=1, k=Infinity) (-1)k (t2)k / k! = 1 - Sum(k=0, k=Infinity) (-t2)k / k!
This is actually well-known sum and it is equal to exp() with negative argument (well, you have to add term for k=0)
m(t) ~= 1 - exp(-t2)
Conclusions
Approximate value is positive. Probably will stay positive after all, Ak/Γ(2k+1) is a bit different from 1/k!.
We're talking about 1 - exp(-100), which is 1-3.72*10-44! And we're trying to compute it precisely summing and subtracting values on the order of 10100 or even higher. Even with MPFR I don't think this is possible.
Another approach is needed
OK, so I ended up going down a pretty different road on this. I have implemented a simple discretization of the integral equation which defines the renewal function:
m(t) = F(t) + integrate (m(t - s)*f(s), s, 0, t)
The integral is approximated with the rectangle rule. Approximating the integral for different values of t gives a system of linear equations. I wrote a function to generate the equations and extract a matrix of coefficients from it. After looking at some examples, I guessed a rule to define the coefficients directly and used that to generate solutions for some examples. In particular I tried shape = 2, t = 10, as in OP's example, with step = 0.1 (so 101 equations).
I found that the result agrees pretty well with an approximate result which I found in a paper (Baxter et al., cited in the code). Since the renewal function is the expected number of events, for large t it is approximately equal to t/mu where mu is the mean time between events; this is a handy way to know if we're anywhere in the neighborhood.
I was working with Maxima (http://maxima.sourceforge.net), which is not efficient for numerical stuff, but which makes it very easy to experiment with different aspects. At this point it would be straightforward to port the final, numerical stuff to another language such as Python.
Thanks to OP for suggesting the problem, and S. Pappadeux for insightful discussions. Here is the plot I got comparing the discretized approximation (red) with the approximation for large t (blue). Trying some examples with different step sizes, I saw that the values tend to increase a little as step size gets smaller, so I think the red line is probably a little low, and the blue line might be more nearly correct.
Here is my Maxima code:
/* discretize weibull renewal function and formulate system of linear equations
* copyright 2020 by Robert Dodier
* I release this work under terms of the GNU General Public License
*
* This is a program for Maxima, a computer algebra system.
* http://maxima.sourceforge.net/
*/
"Definition of the renewal function m(t):" $
renewal_eq: m(t) = F(t) + 'integrate (m(t - s)*f(s), s, 0, t);
"Approximate integral equation with rectangle rule:" $
discretize_renewal (delta_t, k) :=
if equal(k, 0)
then m(0) = F(0)
else m(k*delta_t) = F(k*delta_t)
+ m(k*delta_t)*f(0)*(delta_t / 2)
+ sum (m((k - j)*delta_t)*f(j*delta_t)*delta_t, j, 1, k - 1)
+ m(0)*f(k*delta_t)*(delta_t / 2);
make_eqs (n, delta_t) :=
makelist (discretize_renewal (delta_t, k), k, 0, n);
make_vars (n, delta_t) :=
makelist (m(k*delta_t), k, 0, n);
"Discretized integral equation and variables for n = 4, delta_t = 1/2:" $
make_eqs (4, 1/2);
make_vars (4, 1/2);
make_eqs_vars (n, delta_t) :=
[make_eqs (n, delta_t), make_vars (n, delta_t)];
load (distrib);
subst_pdf_cdf (shape, scale, e) :=
subst ([f = lambda ([x], pdf_weibull (x, shape, scale)), F = lambda ([x], cdf_weibull (x, shape, scale))], e);
matrix_from (eqs, vars) :=
(augcoefmatrix (eqs, vars),
[submatrix (%%, length(%%) + 1), - col (%%, length(%%) + 1)]);
"Subsitute Weibull pdf and cdf for shape = 2 into discretized equation:" $
apply (matrix_from, make_eqs_vars (4, 1/2));
subst_pdf_cdf (2, 1, %);
"Just the right-hand side matrix:" $
rhs_matrix_from (eqs, vars) :=
(map (rhs, eqs),
augcoefmatrix (%%, vars),
[submatrix (%%, length(%%) + 1), col (%%, length(%%) + 1)]);
"Generate the right-hand side matrix, instead of extracting it from equations:" $
generate_rhs_matrix (n, delta_t) :=
[delta_t * genmatrix (lambda ([i, j], if i = 1 and j = 1 then 0
elseif j > i then 0
elseif j = i then f(0)/2
elseif j = 1 then f(delta_t*(i - 1))/2
else f(delta_t*(i - j))), n + 1, n + 1),
transpose (makelist (F(k*delta_t), k, 0, n))];
"Generate numerical right-hand side matrix, skipping over formulas:" $
generate_rhs_matrix_numerical (shape, scale, n, delta_t) :=
block ([f, F, numer: true], local (f, F),
f: lambda ([x], pdf_weibull (x, shape, scale)),
F: lambda ([x], cdf_weibull (x, shape, scale)),
[genmatrix (lambda ([i, j], delta_t * if i = 1 and j = 1 then 0
elseif j > i then 0
elseif j = i then f(0)/2
elseif j = 1 then f(delta_t*(i - 1))/2
else f(delta_t*(i - j))), n + 1, n + 1),
transpose (makelist (F(k*delta_t), k, 0, n))]);
"Solve approximate integral equation (shape = 3, t = 1) via LU decomposition:" $
fpprintprec: 4 $
n: 20 $
t: 1;
[AA, bb]: generate_rhs_matrix_numerical (3, 1, n, t/n);
xx_by_lu: linsolve_by_lu (ident(n + 1) - AA, bb, floatfield);
"Iterative solution of approximate integral equation (shape = 3, t = 1):" $
xx: bb;
for i thru 10 do xx: AA . xx + bb;
xx - (AA.xx + bb);
xx_iterative: xx;
"Should find iterative and LU give same result:" $
xx_diff: xx_iterative - xx_by_lu[1];
sqrt (transpose(xx_diff) . xx_diff);
"Try shape = 2, t = 10:" $
n: 100 $
t: 10 $
[AA, bb]: generate_rhs_matrix_numerical (2, 1, n, t/n);
xx_by_lu: linsolve_by_lu (ident(n + 1) - AA, bb, floatfield);
"Baxter, et al., Eq. 3 (for large values of t) compared to discretization:" $
/* L.A. Baxter, E.M. Scheuer, D.J. McConalogue, W.R. Blischke.
* "On the Tabulation of the Renewal Function,"
* Econometrics, vol. 24, no. 2 (May 1982).
* H(t) is their notation for the renewal function.
*/
H(t) := t/mu + sigma^2/(2*mu^2) - 1/2;
tx_points: makelist ([float (k/n*t), xx_by_lu[1][k, 1]], k, 1, n);
plot2d ([H(u), [discrete, tx_points]], [u, 0, t]), mu = mean_weibull(2, 1), sigma = std_weibull(2, 1);
I want to calculate the sum of the series as below
Lim
X->1 (2/3 - x/3 -(x^2)/3 +(x^3)*2/3 -..). I am not sure whether we have a formula for finding the sum of this kind of series. Tried a lot but couldn't find any. Any help is appreciated.
This seems to be more maths than computing.
It factorises as (1 + x^3 + x^6 + ...)(2 - x - x^2)/3
If x = 1-d (where d is small), then to first order in d, the (2 - x - x^2) term becomes (2 - (1-d) - (1-2d)) = 3d
And the (1 + x^3 + x^6 + ...) term is a geometric progression, with sum 1/(1-x^3), or here 1/(1-(1-d)^3), and the denominator to first order in d is (1 - (1-3d)) = 3d
Hence the whole thing is (1/3d) (3d) / 3 = 1/3
But we can also verify computationally with a value close to 1 (Python code here):
x = 0.999999
s = 0
f = (2 - x - x*x) / 3.
x3 = x ** 3
s_prev = None
while s != s_prev:
s_prev = s
s += f
f *= x3
print(s)
gives:
0.33333355556918565
J = 0.05;
B = 0.02;
Tload[t_] := 0.0;
R1 = 2;
\[Alpha] = 30*\[Pi]/180;
d = 0.05;
g = 0.001;
Nturns = 200;
\[Mu]0 = 4*\[Pi]*10^(-7);
r = 0.03;
lm = 0.02;
d = 0.1;
W = Sqrt[2*r^2 - 2*r^2*Cos[2*a]];
Rgmax = g/(\[Mu]0*r*d);
Rm = lm/(\[Mu]0*W*d);
square[x_, x1_, x2_] := UnitStep[x - x1]*(1 - UnitStep[x - x2])
Rg[\[Theta]_] :=
Rgmax/((2 \[Alpha] - Mod[\[Theta][t], \[Pi]])*
square[Mod[\[Theta][t], \[Pi]], -2 \[Alpha],
2 \[Alpha]] + (2 \[Alpha] - Mod[-\[Theta][t], \[Pi]])*
square[Mod[-\[Theta][t], \[Pi]], -2 \[Alpha], 2 \[Alpha]])
L[\[Theta]_] :=
Nturns^2/(
2*Rg[\[Theta]] +
Rm) *(square[Mod[\[Theta][t], \[Pi]], -2 \[Alpha], 2 \[Alpha]] +
square[Mod[-\[Theta][t], \[Pi]], -2 \[Alpha], 2 \[Alpha]])
Plot[L[\[Theta]], {\[Theta][t], -8 \[Alpha], 8 \[Alpha]},
PlotRange -> All]
I'm sorry but I could not paste as mathematica can show (newbie here). However, I tried several solutions to get rid of 1/0 inf expression of L[theta] but I didn't get it.
Please, copy and paste it to a notebook and run it.
I multiply L[theta] with my square function to make undefined areas equal to zero(f.e 2a, Pi-2a should be zero as other intervals) but it did not work.
How can I identify this function properly?
Thanks in advance.
This?
J=0.05; B=0.02; Tload[t_]:=0.0; R1=2; \[Alpha]=30*\[Pi]/180; d=0.05;
g=0.001; Nturns=200; \[Mu]0=4*\[Pi]*10^-7; r=0.03; lm=0.02; d=0.1;
W=Sqrt[2*r^2-2*r^2*Cos[2*\[Alpha]]]; Rgmax=g/(\[Mu]0*r*d); Rm=lm/(\[Mu]0*W*d);
square[x_, x1_, x2_]:=UnitStep[x-x1]*(1-UnitStep[x-x2]);
Rg[\[Theta]_]:=Rgmax/((2 \[Alpha]-Mod[\[Theta],\[Pi]])*square[Mod[\[Theta],
\[Pi]],-2 \[Alpha], 2 \[Alpha]] +(2 \[Alpha]-Mod[-\[Theta],\[Pi]])*
square[Mod[-\[Theta],\[Pi]],-2 \[Alpha], 2 \[Alpha]]);
L[\[Theta]_] := Nturns^2/(2*Rg[\[Theta]]+Rm)*(square[Mod[\[Theta],\[Pi]],
-2 \[Alpha],2 \[Alpha]]+square[Mod[-\[Theta],\[Pi]],-2 \[Alpha], 2 \[Alpha]]);
Plot[L[\[Theta]], {\[Theta],-8 \[Alpha],8 \[Alpha]}, PlotRange->All, PlotPoints->200]
All I did was fix your a versus Alpha and your Theta[t] versus Theta confusion.
Theta is a variable and Theta[t] is a function. There is a complicated explanation of this, but those are not necessarily the same thing and may mean very different things to Mathematica. The further you stray from the very conventional way of doing things in Mathematica the more confusing holes you can fall into with no way of understanding why it isn't doing what you expect it to.
Hi have made this code to plot a function.
I need to mark with an red X all the crossings between x = 0 and the blue wave line in the graph.
I have made some tries but with '-xr' in the plot function but it places X marks out of the crossings.
Anyone knows how to do it. Many thanks.
Code:
% entrada
a = input('Introduza o valor de a: ');
% ficheiro fonte para a função
raizes;
% chamada à função
x = 0:.1:50;
or = x;
or(:) = 0;
h = #(x) cos(x);
g = #(x) exp(a*x)-1;
f = #(x) h(x) - g(x);
zeros = fzero(f,0);
plot(x,f(x));
hold on
plot(zeros,f(zeros),'-xr')
hold off
Graph (it only marks one zero, i need all the zero crossings):
As mentioned in the comments above, you need to look for the zeros of your function before you can plot them. You can do this mathematically (in this case set f(x) = g(x) and solve for x) or you can do this analytically with something like fsolve.
If you read the documentation for fsolve, you will see that it searches for the zero closest to the provided x0 if passed a scalar or the first zero if passed an interval. What we can do for a quick attempt at a solution is to pass our x values into fsolve as initial guesses and filter out the unique values.
% Set up sample data
a = .05;
x = 0:.1:50;
% Set up equations
h = #(x) cos(x);
g = #(x) exp(a*x)-1;
f = #(x) h(x) - g(x);
% Find zeros of f(x)
crossingpoints = zeros(length(x), 1); % Initialize array
for ii = 1:length(x) % Use x data points as guesses for fzero
try
crossingpoints(ii) = fzero(f, x(ii)); % Find zero closest to guess
end
end
crossingpoints(crossingpoints < 0) = []; % Throw out zeros where x < 0
% Find unique zeros
tol = 10^-8;
crossingpoints = sort(crossingpoints(:)); % Sort data for easier diff
temp = false(size(crossingpoints)); % Initialize testing array
% Find where the difference between 'zeros' is less than or equal to the
% tolerance and throw them out
temp(1:end-1) = abs(diff(crossingpoints)) <= tol;
crossingpoints(temp) = [];
% Sometimes catches beginning of the data set, filter it out if this happens
if abs(f(crossingpoints(1))) >= (0 + tol)
crossingpoints(1) = [];
end
% Plot data
plot(x, f(x))
hold on
plot(crossingpoints, f(crossingpoints), 'rx')
hold off
grid on
axis([0 20 -2 2]);
Which gives us the following:
Note that due to errors arising from floating point arithmetic we have to utilize a tolerance to filter our zeros rather than utilizing a function like unique.
I want to create a polynomial with given coefficients. This seems very simple but what I have found till now did not appear to be the thing I desired.
For example in such an environment;
n = 11
K = GF(4,'a')
R = PolynomialRing(GF(4,'a'),"x")
x = R.gen()
a = K.gen()
v = [1,a,0,0,1,1,1,a,a,0,1]
Given a list/vector v of length n (I will set this n and v at the begining), I want to get the polynomial v(x) as v[i]*x^i.
(Actually after that I am going to build the quotient ring GF(4,'a')[x] /< x^n-v(x) > after getting this v(x) from above) then I will say;
S = R.quotient(x^n-v(x), 'y')
y = S.gen()
But I couldn't write it.
This is a frequently asked question in many places so it is better to leave it here as an answer although the answer I have is so simple:
I just wrote R(v) and it gave me the polynomial:
sage
n = 11
K = GF(4,'a')
R = PolynomialRing(GF(4,'a'),"x")
x = R.gen()
a = K.gen()
v = [1,a,0,0,1,1,1,a,a,0,1]
R(v)
x^10 + a*x^8 + a*x^7 + x^6 + x^5 + x^4 + a*x + 1
Basically (that is, ignoring the specifics of your polynomial ring) you have a list/vector v of length n and you require a polynomial which is the sum of all v[i]*x^i. Note that this sum equals the matrix product V.X where V is a one row matrix (essentially equal to the vector v) and X is a column matrix consisting of powers of x. In Maxima you could write
v: [1,a,0,0,1,1,1,a,a,0,1]$
n: length(v)$
V: matrix(v)$
X: genmatrix(lambda([i,j], x^(i-1)), n, 1)$
V.X;
The output is
x^10+ax^8+ax^7+x^6+x^5+x^4+a*x+1