I have to simulate some data from a Linear fractional stable motion. I have found an article where they simulate such data using Matlab. The code is from the article "Simulation methods for linear fractional stable motion and
FARIMA using the Fast Fourier Transform" by Stilian Stoev and Murad S. Taqqu. The following is the matlab code:
% Written by Stilian Stoev 05.06.2002, sstoev#math.bu.edu
%
% Usage:
% y = fftlfsn(H,alpha,m,M,C,N,n)
%
mh = 1/m;
d = H-1/alpha;
t0 = [mh:mh:1];
t1 = [1+mh:mh:M];
A = mh^(1/alpha)*[t0.^d, t1.^d-(t1-1).^d];
C = C*(sum(abs(A).^alpha)^(-1/alpha));
A = C*A;
Na = m*(M+N);
A = fft(A,Na);
y = [];
for i=1:n,
if alpha<2,
Z = rstab(alpha,0,Na)’;
elseif alpha==2,
Z = randn(1,Na);
end;
Z = fft(Z,Na);
w = real(ifft(Z.*A,Na));
y = [y; w(1:m:N*m)];
end;
Example:
The commands
H = 0.2; alpha =1.5; m = 256; M = 6000; N = 2^14 - M;
y = fftlfsn(H,alpha,m,M,1,N,1);
x = cumsum(y);
generate a simulated path y of length N of linear
fractional stable noise and a path x of LFSM.
In the following I have tried to translate it,
but I have some questions. I have commented on it in the code.
fftlfsn <- function(H,alpha,m,M,C,N,n){
mh = 1/m;
d = H-1/alpha;
t0 = seq(mh,mh, by =1);
t1 = seq(1+mh,mh, by=M);
# Is the following the right way to translate the matlab code into R?
A = mh^(1/alpha)*matrix(c(t0^d, t1^d-(t1-1)^d), ncol = length(t0), nrow = length(t1));
C = C*(sum(abs(A)^alpha)^(-1/alpha));
A = C*A;
Na = m*(M+N);
# I don't konw if it is right to use the function "fft" here.
#Does this respond directly to the function "fft" in matlab?
A = fft(A,Na);
#how can I do somthing similar in R?
#I think they create an empty matrix? Could I just write y=0?
y = [];
for (i in 1:n)
{
if(alpha<2){
# The function "rstab" generates symmetric alpha-stable variables. Is there a similar function in R, or do you know how to write one?
Z = t(rstab(alpha,0,Na))
}
else if(alpha==2){
Z = matrix (rnorm(Na, mean = 0, sd = 1), nrow = 1, ncol = Na)
}
# Again, can I just use the R-function "fft" directly?
Z = fft(Z,Na);
w = Re(fft(Z*A,Na, inverse= TRUE));
#I have trouble understanding the following and therefore I can't translate it.
y = [y; w(1:m:N*m)];
}
}
Any help appreciated!
Related
I need to integrate the following function where there is a differentiation term inside. Unfortunately, that term is not easily differentiable.
Is this possible to do something like numerical integration to evaluate this in R?
You can assume 30,50,0.5,1,50,30 for l, tau, a, b, F and P respectively.
UPDATE: What I tried
InnerFunc4 <- function(t,x){digamma(gamma(a*t*(LF-LP)*b)/gamma(a*t))*(x-t)}
InnerIntegral4 <- Vectorize(function(x) { integrate(InnerFunc4, 1, x, x = x)$value})
integrate(InnerIntegral4, 30, 80)$value
It shows the following error:
Error in integrate(InnerFunc4, 1, x, x = x) : non-finite function value
UPDATE2:
InnerFunc4 <- function(t,L){digamma(gamma(a*t*(LF-LP)*b)/gamma(a*t))*(L-t)}
t_lower_bound = 0
t_upper_bound = 30
L_lower_bound = 30
L_upper_bound = 80
step_size = 0.5
integral = 0
t <- t_lower_bound + 0.5*step_size
while (t < t_upper_bound){
L = L_lower_bound + 0.5*step_size
while (L < L_upper_bound){
volume = InnerFunc4(t,L)*step_size**2
integral = integral + volume
L = L + step_size
}
t = t + step_size
}
Since It seems that your problem is only the derivative, you can get rid of it by means of partial integration:
Edit
Not applicable solution for lower integration bound 0.
I am trying to test a linear approximation function and I am getting the error "no method matching current_axis(::Nothing)".
Here is my linear approximation function:
function linear_approx(A,b,c,p0)
p0 = [i for i in p0]
y(p) = p'*A*p .+ b'*p .+ c .-1
e = y(p0)
d = 2*A*p0 + b
(; d, e)
end
Here is the function that attempts to plot and throws an exception. I also included that value of the parameter when I tried to call it:
pts = [(1,1), (3,2), (4,4)]
function visualize_approx(pts)
# Use this function to inspect your solution, and
# ensure that the three points lie on one of
# the level-sets of your quadratic approximation.
(; A, b, c) = constant_curvature_approx(pts)
min_val = Inf
max_val = -Inf
for pt in pts
(; d, e) = linear_approx(A,b,c,pt)
P = LinRange(pt[1] - 0.2, pt[1]+0.2, 100)
Q = linear_segment(pt, d, e, P)
# the error arises here
plot!(P, Q)
plot!([pt[1]], [pt[2]])
end
delta = max_val - min_val
min_val -= 0.25*delta
max_val += 0.25*delta
X = Y = LinRange(min_val,max_val, 100)
Z = zeros(100,100)
for i = 1:100
for j = 1:100
pt = [X[i]; Y[j]]
Z[i,j] = pt'*A*pt + pt'*b + c
end
end
contour(X,Y,Z,levels=[-1,0,1,2,3])
for pt in pts
plot!([pt[1]], [pt[2]])
end
current_figure()
end
Does anyone know why this error arises?
plot! modifies a previously created plot object. It seems like you did not create a plot before calling it. This is why you get the error. Use plot when creating the plot and plot! when modifying it.
I want to plot a time-evolution of 3D Gaussian with Makie.jl.
Here is a surface-version code of sin(r)/r.
So I wrote a code in reference to it.
using Makie
using FileIO
using LinearAlgebra
using AbstractPlotting
scene = Scene(backgroundcolor = :black);
f(x,y,z) = exp(-((x)^2 + (y)^2 + (z)^2))
r = LinRange(-5, 5, 50)
vol_func(t) = [Float64(f(x - cos(t),y - sin(t),z - t)) for x = r, y = r,z = r]
vol = volume!(scene,r,r,r,vol_func(20),algorithm = :mip)[end]
scene[Axis].names.textcolor = :gray
N = 20
scene
record(scene, "voloutput.mp4", range(0, stop = 5, length = N)) do t
vol[3] = vol_func(t)
end
But this code does not work.
MethodError: Cannot `convert` an object of type Array{Float64,3} to an object of type LinRange{Float64}
How should I fix the code?
P.S.
The snapshot at initial time is like this.(reference)
using Makie
using FileIO
using LinearAlgebra
using AbstractPlotting
r = LinRange(-20, 20, 500); # our value range
ρ(x, y, z) = exp(-((x-1)^2 + (y)^2 + (z)^2)) # function (charge density)
# create a Scene with the attribute `backgroundcolor = :black`,
# can be any compatible color. Useful for better contrast and not killing your eyes with a white background.
scene = Scene(backgroundcolor = :black)
volume!(
scene,
r, r, r, # coordinates to plot on
ρ, # charge density (functions as colorant)
algorithm = :mip # maximum-intensity-projection
)
scene[Axis].names.textcolor = :gray # let axis labels be seen on dark
background
save("sp.png",scene)
I want to see the yellow region moving as spiral. (2020/08/28)
I just realized not vol[3] but vol[4]. Then, it worked.
But I have a next question. (2020/08/31)
I tried to do the same thing for the matrix-form time-dependent Schrodinger equation with its initial condition being Gaussian.
using LinearAlgebra
using OrdinaryDiffEq
using DifferentialEquations
#Define the underlying equation
function time_evolution(ψdot,ψ,p,t)
ψdot.=-im.*H(Lx,Ly,Lz)*ψ
end
Lx = Ly = Lz = 10
ψ0 = [] # Initial conditions
for iz = 1:Lz
for ix = 1:Lx
for iy = 1:Ly
gauss = exp(-((ix)^2 + (iy)^2 + (iz)^2))
push!(ψ0,gauss)
end
end
end
tspan = (0.,1.0) # Simulation time span
#Pass to Solvers
prob = ODEProblem(time_evolution,ψ0,tspan)
sol = solve(prob)
Here,H(Lx,Ly,Lz) is a N×N matrix parameterized by systemsize Lx,Ly,Lz and N = Lx×Ly×Lz. The sample code of H(Lx,Ly,Lz) is here.
Then,
using Makie
using FileIO
using LinearAlgebra
using AbstractPlotting
using ColorSchemes
x = 1: Lx # our value range
y = 1: Ly
z = 1: Lz
ρ(ix,iy,iz,nt) = abs2.((sol[nt][(iz-1)*Lx*Ly + (ix-1)*Ly + (iy-1)])./norm(sol[nt][(iz-1)*Lx*Ly + (ix-1)*Ly + (iy-1)]))
ψ(nt) = Float64[ρ(ix,iy,iz,nt) for ix in x, iy in y,iz in z]
scene = Scene(backgroundcolor = :white)
c = ψ(length(sol.t))
vol = volume!(
scene,
x, y, z, # coordinates to plot on
c, # charge density (functions as colorant)
algorithm = :mip, # maximum-intensity-projection
colorrange = (0,0.01),
transparency = true,
)[end]
update_cam!(scene, Vec3f0(1,0.5,0.1), Vec3f0(0))
scene[Axis].names.textcolor = :gray # let axis labels be seen on darkbackground
record(scene, "output.mp4", range(0, stop = length(sol.t)-1, length = 1)) do nt
vol[4] = ψ(nt)
end
But this code has an error.
ArgumentError: range(0.0, stop=5.0, length=1): endpoints differ
Where is the mistake?
I found the mistake.(2020/09/02)
sol[nt]→sol(nt)
range(0, stop = length(sol.t)-1, length = 1)→range(0, stop = 1.0, length = 20)
Then, the code passed and a mp4 animation was obtained.
But the plot can't be seen in the mp4 file. Why...
I simulated data in SAS where I have 861 poplar trees. These trees are correlated with correlation matrix K. The varcov is assumed known and equal to sigmaGK +sigmaEI. sigmaG is set at 3.5 and sigmaE at 2.5. There is 1 predictor beta set at 2.5, and an intercept set at 1. the sascode is as follows:
proc iml;
use work.dataK; /* open the data set */
read all var _ALL_ into K;
close work.dataK;
use work.snps; /* open the data set */
read all var _ALL_ into GT;
close work.snps;
snp2 = GT[,2];
n=861;
sigma2_g = 3.4;
sigma2_e = 2.5;
beta = {1, 2.5};
print(beta);
G = sigma2_g*K ;
R = sigma2_e*I(n);
varcov = G + R ;
print(varcov);
treeID = colvec(1:n);
X = J(n,1,1)||GT[,2] ; /*col vector of 1 for intercept*/
call randseed(1234);
create simdata2 var {"treeID" "trait1" "snp2"};
zero = j(1, n, 0); /* the zero vector */
eps = RandNormal(1, zero, varcov); /* eps ~ MVN(0,varcov) */
trait1 = X*beta + eps`; /* fixed effects, correlated errors */
append;
close;
quit;
and is analyzed with:
Proc mixed data = input METHOD=REML noprofile covtest itdetails ;
class treeID ;
model x = snp&snp /s ddfm=KR vciry outpm=out chisq;
random treeID / type=lin(1) ldata=kin ;
parms/ lowerb= 0 0;
run;
This yields the expected results
However, when I simulate this in R:
sigma2_g <- 3.4
sigma2_e <- 2.5
beta1 <- 2.7
I <- diag(nrow = nrow(X_snps_additive), ncol = nrow(X_snps_additive))
Intercept <- matrix(nrow = nrow(X_snps_additive), ncol = 1, data = 1)
G <- sigma2_g * K
R <- sigma2_e * I
var_cov <- G + R
SNP1 <- X_snps_additive[, colnames(X_snps_additive)=="SNP_SNP_IGA_1_21572990"]
lin1 <- as.matrix(SNP1) %*% beta1
zeros <- replicate(n = dim(K)[1], expr = 0)
library(mvtnorm)
error = mvtnorm::rmvnorm(n = 1, mean = zeros, sigma = var_cov, method="chol")
error = as.vector(error)
trait <- as.vector(lin1 + Intercept + error)
Followed by an analysis in SAS, then the estimate for sigmaG is off.
I my main objectif is to obtain the same results on SAS and on R. Somethimes and depending on the case, it is very easy. Otherwise it is difficult, specially when we want to compute something more complicated than the usual.
So, in ored to understand my case, I have the following differential equation system :
y' = z
z' = b* y'+c*y
Let :
b = - 2 , c = - 4, y(0) = 0 and z(0) = 1
In order to resolve this system, in SAS we use the command PROC MODEL :
data t;
do time=0 to 40;
output;
end;
run;
proc model data=t ;
dependent y 0 z 1;
parm b -2 c -4;
dert.y = z;
dert.z = b * dert.y + c * y;
solve y z / dynamic solveprint out=out1;
run;
In R, we could write the following solution using the lsoda function of the deSolve package:
library(deSolve)
b <- -2;
c <- -4;
rigidode <- function(t, y, parms) {
with(as.list(y), {
dert.y <- z
dert.z <- b * dert.y + c * y
list(c(dert.y, dert.z))
})
}
yini <- c(y = 0, z = 1)
times <- seq(from=0,to=40,by=1)
out_ode <- ode (times = times, y = yini, func = rigidode, parms = NULL)
out_lsoda <- lsoda (times = times, y = yini, func = rigidode, parms = NULL)
Here are the results :
SAS
R
For time t=0,..,10 , we obtain similar results. But for t=10,...,40, we start to have differences. For me, these differences are important.
In order to correct these differences, I fixed on R the error truncation term on 1E-9 in stead of 1E-6. I also verified if the numerical integration methods and the hypothesis used by default are the same.
Do you have any idea how to deal with this problem?
Sincerely yours,
Mily