I'm puzzled by this behavior of mathematica. The two following expressions should return the same result:
Simplify[(1 - w)^2 Sum[w^(k+kp) Sum[If[l == lp, 1, 0], {l, 0, k}, {lp, 0, kp}],
{k,0, \[Infinity]}, {kp, 0, \[Infinity]}]]
returns:
(-1 - w + w^3)/(-1 + w^2)
whereas the strictly equivalent:
Simplify[(1 - w)^2 Sum[w^(k+kp) Min[k, kp],{k,0,\[Infinity]},{kp,0,\[Infinity]}]
+ (1 - w)^2 Sum[w^(k+kp) ,{k,0,\[Infinity]},{kp,0,\[Infinity]}]]
returns:
1/(1 - w^2)
Not an answer, but if you use
$$\sum_{k=0}^{\infty} \sum_{l=0}^{k} = \sum_{l=0}^{\infty} \sum_{k=l}^{\infty}$$
then :
sum1 = Simplify[(1 - w)^2
Sum[w^(k + kp) Sum[KroneckerDelta[l, lp] , {l, 0, k}, {lp, 0, kp}],
{k, 0, Infinity}, {kp, 0, Infinity}]]
(* (-2 + w + w^2 - w^3)/(-1 + w^2) *)
but
sum2 = Simplify[(1 - w)^2
Sum[KroneckerDelta[l, lp]
Sum[w^(k + kp), {k, l, Infinity}, {kp, lp, Infinity}] ,
{l, 0, Infinity}, {lp, 0, Infinity}]]
(* 1/(1 - w^2) *)
Related
So im trying to code a general way to find the numerical integration gauss points in 2D. But want to choose my own points. All i can find on google is symmetrical points 2x2 and 3x3 etc. I have done it in 1D up to 5 points but im not sure how to do this is 2D. my code:
# Gauss Legendre Integrasjon 1D
from sympy import *
xi,eta = symbols("xi,eta")
Function = xi**6
D = int(input("Hvor mange dimensjoner? "))
if D == 1:
Vekter = [2, 1 , 8/9, 5/9, (18+sqrt(30))/(36), (18-sqrt(30))/(36), 128/225, (322+13*sqrt(70))/900, (322-13*sqrt(70))/900]
xi_p = [0, sqrt(1/3), -sqrt(1/3), 0, sqrt(3/5), -sqrt(3/5), sqrt((3/7)-(2/7)*sqrt(6/5)), -sqrt((3/7)-(2/7)*sqrt(6/5)), sqrt((3/7)+(2/7)*sqrt(6/5)), -sqrt((3/7)+(2/7)*sqrt(6/5)), 0, 1/3* sqrt(5-2*sqrt(10/7)), -1/3* sqrt(5-2*sqrt(10/7)), 1/3* sqrt(5+2*sqrt(10/7)), -1/3* sqrt(5+2*sqrt(10/7)) ]
N = int(input("Hvor mange integrasjons punkt? "))
if N == 1:
INT_NUM = Vekter[0]*Function.subs(xi,xi_p[0])
if N == 2:
INT_NUM = Vekter[1]*Function.subs(xi,xi_p[1])+Vekter[1]*Function.subs(xi,xi_p[2])
if N == 3:
INT_NUM = Vekter[2]*Function.subs(xi,xi_p[3]) + Vekter[3]*Function.subs(xi,xi_p[4]) + Vekter[3]*Function.subs(xi,xi_p[5])
if N == 4:
INT_NUM = Vekter[4]*Function.subs(xi,xi_p[6]) + Vekter[4]*Function.subs(xi,xi_p[7]) + Vekter[5]*Function.subs(xi,xi_p[8]) + Vekter[5]*Function.subs(xi,xi_p[9])
if N == 5:
INT_NUM = Vekter[6]*Function.subs(xi,xi_p[10]) + Vekter[7]*Function.subs(xi,xi_p[11]) + Vekter[7]*Function.subs(xi,xi_p[12]) + Vekter[8]*Function.subs(xi,xi_p[13]) + Vekter[8]*Function.subs(xi,xi_p[14])
if D == 2:
N_xi = int(input("Hvor mange integrasjons punkt i xi? "))
N_eta = int(input("Hvor mange integrasjons punkt i eta? "))
Vekter = [2, 1 , 8/9, 5/9, (18+sqrt(30))/(36), (18-sqrt(30))/(36), 128/225, (322+13*sqrt(70))/900, (322-13*sqrt(70))/900]
xi_p = [0, sqrt(1/3), -sqrt(1/3), 0, sqrt(3/5), -sqrt(3/5), sqrt((3/7)-(2/7)*sqrt(6/5)), -sqrt((3/7)-(2/7)*sqrt(6/5)), sqrt((3/7)+(2/7)*sqrt(6/5)), -sqrt((3/7)+(2/7)*sqrt(6/5)), 0, 1/3* sqrt(5-2*sqrt(10/7)), -1/3* sqrt(5-2*sqrt(10/7)), 1/3* sqrt(5+2*sqrt(10/7)), -1/3* sqrt(5+2*sqrt(10/7)) ]
eta_p = [0, sqrt(1/3), -sqrt(1/3), 0, sqrt(3/5), -sqrt(3/5), sqrt((3/7)-(2/7)*sqrt(6/5)), -sqrt((3/7)-(2/7)*sqrt(6/5)), sqrt((3/7)+(2/7)*sqrt(6/5)), -sqrt((3/7)+(2/7)*sqrt(6/5)), 0, 1/3* sqrt(5-2*sqrt(10/7)), -1/3* sqrt(5-2*sqrt(10/7)), 1/3* sqrt(5+2*sqrt(10/7)), -1/3* sqrt(5+2*sqrt(10/7)) ]
if N_xi == 2 and N_eta ==2:
for i in range(0,2):
for n in range(0,2):
print("s")
INT_NUM.evalf()
Remove["Global`*"]
a = 0;
For[z = 0, z < 3, z++, Sol[a] = x /. Solve[z^2 + x == 10, x];
a = a + 1;]
I am new to the mathematica so I'm experimenting with it.Answer of the problem changes at every loop so I stored them inside an array.
I can see the numeric results using Do[Print[Sol[a]], {a, 0, 2}]; but how can I plot the results I tried using Plot[Sol[[a]], {a, 0, 2}] but it didn't work.
Remove["Global`*"]
func = z^2 + x == 10;
sol = Solve[func, x];
Plot[x /. sol, {z, 0, 3}]
How can I find a bounded area in the first quadrant? And also I will do it by Mathematica. I tried several times, but I couldn't.
What I have tried:
NIntegrate[x^5, {x, 0, [Pi]}] - NIntegrate[3 x, {x, 0, [Pi]}] Plot[{x^5, 3 x}, {x, 0, [Pi]}, Filling -> {1 -> {2}}] RegionPlot[ y <= x^5 && y >= 3 x && 0 <= x <= [Pi], {x, 0, [Pi]}, {y, 0, 200}, PlotPoints -> 300] Area#ImplicitRegion[ y <= x^5 && y >= 3 x && 0 <= x <= [Pi], {{x, 0, [Pi]}, {y, 0, 200}}] % // N –
The bounded area in the first quadrant extends to the intercept.
intercept = Solve[x^5 == 3 x, x][[-1, 1]]
(Integrate[3 x, x] /. intercept) - (Integrate[x^5, x] /. intercept)
Plot[{x^5, 3 x}, {x, 0, x /. intercept},
Filling -> {1 -> {2}}, PlotLegends -> "Expressions"]
RegionPlot[y >= x^5 && y <= 3 x && 0 <= x <= Last[intercept],
{x, 0, 1.5}, {y, 0, 5},
PlotPoints -> 200, AspectRatio -> 1/GoldenRatio]
Area#ImplicitRegion[y >= x^5 && y <= 3 x && 0 <= x <= Last[intercept],
{{x, 0, 2}, {y, 0, 5}}]
I am trying to replicate an existing mathematical model in order to get "control" data for an independent research project. Link to article.
I want to solve a system of five ordinary differential equations in R, using the deSolve package. However, most of the parameters are seasonal; the previous researchers used the 'pchip' function from the pracma package in order to create functions for the parameters:
pchip is a `shape-preserving' piecewise cubic Hermite polynomial approach that apptempts to determine slopes such that function values do not overshoot data values. pchipfun is a wrapper around pchip and returns a function. Both pchip and the function returned by pchipfun are vectorized.
xi and yi must be vectors of the same length greater or equal 3 (for cubic interpolation to be possible), and xi must be sorted. pchip can be applied to points outside [min(xi), max(xi)], but the result does not make much sense outside this interval.
graphed, 'beta' parameter over five years
This is the code I have (just trying to get outputs for one year):
x <- c(0, 1, 2, 3, 4)
ybeta <- c(500, 1500, 500, 0, 500)
yk <- c(8000, 12, 0, 8000, 8000)
yrec <- c(0.25, 0.25, 0.25, 0, 0.25)
yfb <- c(1.5, 1.5, 1.5, 1.5, 1.5)
yno <- c(0, 0, 0, 0.00649, 0)
yni <- c(0, 0, 0, 0.00649, 0)
ypo <- c(0.08511, 0.08511, 0.08511, 0, 0.08511)
ypi <- c(0.16936, 0.16936, 0.16936, 0, 0.16936)
yalpha <- c(0.55, 0.12, 0.24, 0, 0.55)
yW <- 0.1
ydep <- c(0.2061 * yW, 0.2835 * yW, 0.2527 * yW, yW, 0.2061 * yW)
ydec <- c(0.006470, 0.023300, 0.015683, 0, 0.006470)
yup <- c(0.15, 0.15, 0.15, 0.15, 0.15)
xs <- seq(0, 1, len = 365)
nosema <- function(time, state, parameters) {
with(as.list(c(state, parameters)), {
H <- Ho + Hi
Fr <- Fo + Fi
Z <- H + Fr
dHo <- pchip(x, ybeta, xs)* (Z^n) / (pchip(x, yk, xs)^n + Z^n) - pchip(x, yrec, xs) * Ho + pchip(x, yfb, xs) * Fr/Z * Fo - pchip(x, yno, xs) * Ho - pchip(x, yalpha, xs) * Ho * E/(sr + E)
dHi <- -pchip(x, yrec, xs) * Hi + pchip(x, yfb, xs) * Fr/Z * Fi - pchip(x, yni, xs) * Hi + pchip(x, yalpha, xs) * Ho * E/(sr + E)
dFo <- pchip(x, yrec, xs) * Ho - pchip(x, yfb, xs) * Fr/Z * Fo - pchip(x, ypo, xs) * Fo
dFi <- pchip(x, yrec, xs) * Hi - pchip(x, yfb, xs) * Fr/Z * Fi - pchip(x, ypi, xs) * Fi
dE <- pchip(x, ydep, xs) * Hi - pchip(x, ydec, xs) * E - pchip(x, yup, xs) * Ho * E / (sr + E)
return(list(c(dHo, dHi, dFo, dFi, dE)))
})
}
init <- c(Ho = 10^4, Hi = 0, Fo = 10000, Fi = 0, E = 0)
parameters <- c(n = 2,
sr = 10000)
out <- ode(y = init, times = seq(0, 365, len = 365), func = nosema, parms = parameters)
out <- as.data.frame(out)
out$time <- NULL
head(out)
However, when I run the code above...
The number of derivatives returned by func() (1825) must equal the length of the initial conditions vector (5)
I think I have an inkling of why this isn't working, but I have no clue how to go about fixing it.
Does anyone have any advice on how to proceed?
library(deSolve)
?forcings
see page 72ff at http://desolve.r-forge.r-project.org/user2014/tutorial.pdf
I have a function which is a product composed by three (k) factors . Each factor is a subtraction of two Gaussian CDF with random variables R and L. These random variables are defined according to 4 parameters.
The code below shows how I plot the main function (according to two independent variables d and e) and how the random variables are calculated
sigma = 1;
k = 3;
priors = {};
AppendTo[priors, 1/k + e];
Do[AppendTo[priors, 1/k - e/(k - 1)], {c, 2, k}];
L[priors_, sigma_, d_, i_] := Do[
maxVal = -Infinity;
Do[
val = (2*sigma^2*Log[priors[[i]]/priors[[j]]] + d^2 (j^2 - i^2 + 2 (i - j)))/(2 (j - i) d);
If[val > maxVal, maxVal = val, Null];
, {j, 1, i - 1}];
Return[maxVal];
, {1}];
R[priors_, sigma_, d_, i_] := Do[
minVal = Infinity;
Do[
val = (2*sigma^2*Log[priors[[j]]/priors[[i]]] + d^2 (i^2 - j^2 + 2 (j - i)))/(2 (i - j) d);
If[val < minVal, minVal = val, Null];
, {j, i + 1, k}];
Return[minVal];
, {1}];
Print[
Plot3D[
Product[
If[R[priors, sigma, d, c] < L[priors, sigma, d, c], 0,
(CDF[NormalDistribution[(c - 1) d, sigma], R[priors, sigma, d, c]] -
CDF[NormalDistribution[(c - 1) d, sigma], L[priors, sigma, d, c]])]
, {c, 1, k}]
, {d, 0.01, 5}
, {e, -1/k, 1 - 1/k}, PlotRange -> {All, All, All}, AxesLabel -> Automatic]];
Now, I want to integrate the function over d (in the same region as the Plot3D, d=0.01-5) and to plot the results according to just the independent variable e.
Below is the code I've used.
Print[
Plot[
Integrate[
Product[
If[R[priors, sigma, d, c] < L[priors, sigma, d, c], 0,
(CDF[NormalDistribution[(c - 1) d, sigma], R[priors, sigma, d, c]] -
CDF[NormalDistribution[(c - 1) d, sigma], L[priors, sigma, d, c]])]
, {c, 1, k}]
, {d, 0.01, 5}]
, {e, -1/k, 1 - 1/k}, PlotRange -> {All, All}, AxesLabel -> Automatic]];
However, the resulting plot is not what I expect. It's constant and in the 3D plot it can be seen that this cannot happen. Does anyone know what is happening and what to do to obtain the real integration of the function? Thanks in advance.
When you compute val inside the functions L and R the result is symbolic (because e is not defined ). The logical val < minVal is thus indeterminate, and as a result minVal is never set (so that L and R return infinity every time )
(cleaned up a couple of other things as well.. )
sigma = 1;
k = 3;
priors = Join[ {1/k + e} , Table[1/k - e/(k - 1) , {c, 2, k} ] ];
L[priors0_, sigma_, d_, i_, e0_] := Module[{priors, maxVal, val, e},
Do[maxVal = -Infinity;
priors = priors0 /. e -> e0 ;
Do[val = (2*sigma^2*Log[priors[[i]]/priors[[j]]] +
d^2 (j^2 - i^2 + 2 (i - j)))/(2 (j - i) d);
If[val > maxVal, maxVal = val];, {j, 1, i - 1}];, {1}]; maxVal];
R[priors0_, sigma_, d_, i_, e0_] := Module[{priors, maxVal, val, e},
priors = priors0 /. e -> e0;
Min[Table[(2*sigma^2*Log[priors[[j]]/priors[[i]]] +
d^2 (i^2 - j^2 + 2 (j - i)))/(2 (i - j) d), {j, i + 1, k}]]];
g[d_?NumericQ, c_, e_] :=
Product[If[R[priors, sigma, d, c, e] < L[priors, sigma, d, c, e],
0,
(CDF[NormalDistribution[(c - 1) d, sigma], R[priors, sigma, d, c, e]] -
CDF[NormalDistribution[(c - 1) d, sigma], L[priors, sigma, d, c, e]])],
{c, 1, k}];
Plot[NIntegrate[g[d, c, e], {d, 0.01, 5}], {e, -1/k, 1 - 1/k},
PlotRange -> {All, All}, AxesLabel -> Automatic]