This might be more of a math question than an R question but here it goes...
I'm trying to generate a low frequency oscillator (LFO2) where the frequency is controlled by another low frequency oscillator (LFO1). LFO1 has a frequency of 0.02 Hz while I want LFO2 to have a frequency that oscillates between 0.00 and 0.11 Hz dependent on the output of LFO1.
# length in seconds
track_length <- 356
upsample <- 10 # upsample the signal
# LFO rates (Hz)
rate1 <- 0.02
rate2_range <- list(0.00, 0.11)
# make plot of LFO1
x1 <- 1:(track_length*upsample)/upsample
amp <- (rate2_range[[2]] - rate2_range[[1]])/2
y1 <- amp*cos(2*pi*rate1*x1) + amp
plot(x1, y1, type='l')
The variable frequency for LFO2 generated by LFO1 looks exactly as I expected.
So I go on to make LFO2 using the output of LFO1 like so..
# make plot of LFO2
x2 <- x1
y2 <- cos(2*pi*y1*x2)
plot(x2, y2, type='l')
However, the output of LFO2 is not what I expected... It seems to be continuously getting faster and also has some peaks that don't oscillate at the full range. I don't understand this as the only thing I'm adjusting is the frequency and it shouldn't be faster than 0.11 Hz. At first I thought it might be an under sampling issue but I get the same results when upsampling the time series to any degree.
Any idea what I'm missing here?
The "frequency" of cos(f(t)) is not f(t). It's the derivative of f(t).
You have:
y1(t) = A*cos(2πf1t) + A
y2(t) = cos(2πy1(t))
If the frequency you want is Acos(2πf1t) + A, then you need to integrate that to get the argument to cos:
y1(t) = A*sin(2πf1t)/2πf1 + At
y2(t) = cos(2πy1(t))
In R:
# length in seconds
track_length <- 356
upsample <- 10 # upsample the signal
# LFO rates (Hz)
rate1 <- 0.02
rate2_range <- list(0.00, 2)
# make integral of LFO1
x1 <- 1:(track_length*upsample)/upsample
amp <- (rate2_range[[2]] - rate2_range[[1]])/2
y1 <- amp*sin(2*pi*rate1*x1)/(2*pi*rate1) + amp*x1
plot(x1, y1, type='l')
# make plot of LFO2
x2 <- x1
y2 <- cos(2*pi*y1 / upsample)
plot(x2, y2, type='l')
You are not restricting the data by amp as you did at the first plot. So it is normal to see cos output altering around -1 and 1.You need to restrict the formula by the max(y1) and min(y1).
So the codes below,
y2 <- vector()
amp <- (max(y1) - min(y1))/2
for(i in 1:length(y1)) {
y2[i] <- amp * cos(2*pi* y1[i] * x2) + amp
}
plot(x2, y2, type='l',col="blue")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
gives this plot,
Related
I have a raster time-series with values from 1 to 36 representing 10 days (dekads) timesteps and NA values.
I need to calculate the average and the standard deviation, taking into account that dekads are circular (36 is last dekad of the year, 1 is the first ones).
Here below is the code for the average (it seems working) but I am not able to write a code for the standard deviation.
Can you please check if the code for the average calculation produces the right outputs and help me in writing the ones for the standard deviation.
Many thanks
require(raster)
r <- raster(ncol=50, nrow=50)
s <- stack(lapply(1:length(r), function(x) setValues(r, values = sample(x = c(0:36),size = ncell(r), replace = T))))
# 0 is set to NA
s[s==0]<-NA
# function
conv <- 2*pi/36 #SET HERE THE time steps
fun1 <- function(m,na.rm=T){
x1 = Arg(mean(exp(conv*(m-1)*1i),na.rm=na.rm))
x2 = x1/conv
x3 = (x2 + 36) %% 36
return(x3)
}
# MEAN calculation
s_avg <- calc(s,fun1)
s_avg <- round(s_avg,0)
s_avg <- s_avg + 1
s_avg [s_avg==37] <- 1
s_avg
plot(s_avg)
suppose that we have a pde that describes the evolution of a variable y(t,x) over time t and space x, and I would like to plot its evolution on a three dimensional diagram (t,x,y). With deSolve I can solve the pde, but I have no idea about how to obtain this kind of diagram.
The example in the deSolve package instruction is the following, where y is aphids, t=0,...,200 and x=1,...,60:
library(deSolve)
Aphid <- function(t, APHIDS, parameters) {
deltax <- c (0.5, rep(1, numboxes - 1), 0.5)
Flux <- -D * diff(c(0, APHIDS, 0)) / deltax
dAPHIDS <- -diff(Flux) / delx + APHIDS * r
list(dAPHIDS )
}
D <- 0.3 # m2/day diffusion rate
r <- 0.01 # /day net growth rate
delx <- 1 # m thickness of boxes
numboxes <- 60
Distance <- seq(from = 0.5, by = delx, length.out = numboxes)
APHIDS <- rep(0, times = numboxes)
APHIDS[30:31] <- 1
state <- c(APHIDS = APHIDS) # initialise state variables
times <-seq(0, 200, by = 1)
out <- ode.1D(state, times, Aphid, parms = 0, nspec = 1, names = "Aphid")
"out" produces a matrix containing all the data that we need, t, y(x1), y(x2), ... y(x60). How can I produce a surface plot to show the evolution and variability of y in (t,x)?
The ways change a bit depending on using package. But you can do it with little cost because out[,-1] is an ideal matrix form to draw surface. I showed two examples using rgl and plot3D package.
out2 <- out[,-1]
AphID <- 1:ncol(out2)
library(rgl)
persp3d(times, AphID, out2, col="gray50", zlab="y")
# If you want to change color with value of Z-axis
# persp3d(times, AphID, out2, zlab="y", col=topo.colors(256)[cut(c(out2), 256)])
library(plot3D)
mat <- mesh(times, AphID)
surf3D(mat$x, mat$y, out2, bty="f", ticktype="detailed", xlab="times", ylab="AphID", zlab="y")
I have this code
N <- 1000
beta1 = runif(N, -1,1);
beta2 = runif(N, -1,1);
x1 = seq(-500, 500, 0.01);
and for each i evaluated from 1 to N, I want to plot this function
z = beta1[i] + beta2[i]*x1;
pr = 1/(1+exp(-z));
plot (x1,pr);
at the end I would expect 1000 curve of pr vs x1.
for that I've tried this
for (i in 1:N){
z[i]= res[i,1] + res[i,2]*x1
pr[i] = 1/(1+exp(-z[i]));
plot(x1,pr[i])
}
But it gave list of 50 warnings and it didn't worked out.
Any helps?
This is a great time for some matrix multiplication to simplify and speed up calculation. Your biggest problem was that plot opens a new plot every time it's called. I assume you want all the lines plotted on the same graph.
N <- 1000
beta1 = runif(N, -1, 1)
beta2 = runif(N, -1, 1)
# I changed this to by = 1
# for plotting purposes you really done need 100k points per line
x1 = seq(-500, 500, 1)
z = cbind(1, x1) %*% rbind(beta1, beta2)
pr = 1 / (1 + exp(-z))
# this is the bug step you were missing
# initialize an empty plot with sufficient range
plot(range(x1), range(pr), type = "n")
# then just add to it in the for loop
for (i in 1:N) {
lines(x1, pr[, i])
}
I am interested to build a R function that I can use to test the limits of the Taylor series approximation. I am aware that there is limits to what I am doing, but it's exactly those limits I wish to investigate.
I have two normally distributed random variables x and y. x has a mean of 7 and a standard deviation (sd) of 1. y has a mean of 5 and a sd of 4.
me.x <- 4; sd.x <- 1
me.y <- 5; sd.y <- 4
I know how to estimate the mean ratio of y/x, like this
# E(y/x) = E(y)/E(x) - Cov(y,x)/E(x)^2 + Var(x)*E(y)/E(x)^3
me.y/me.x - 0/me.x^2 + sd.x*me.y/me.x^3
[1] 1.328125
I am however stuck on how to estimate the Standard Deviation of the ratio? I realize I have to use a Taylor expansion, but not how to use it.
Doing a simple simulation I get
x <- rnorm(10^4, mean = 4, sd = 1); y <- rnorm(10^4, mean = 5, sd = 4)
sd(y/x)
[1] 2.027593
mean(y/x)[1]
1.362142
There is an analytical expression for the PDF of the ratio of two gaussians, done
by David Hinkley (e.g. see Wikipedia). So we could compute all momentums, means etc. I typed it and apparently it clearly doesn't have finite second momentum, thus it doesn't have finite standard deviation. Note, I've denoted your Y gaussian as my X, and your X as my Y (formulas assume X/Y). I've got mean value of ratio pretty close to the what you've got from simulation, but last integral is infinite, sorry. You could sample more and more values, but from sampling std.dev is growing as well, as noted by #G.Grothendieck
library(ggplot2)
m.x <- 5; s.x <- 4
m.y <- 4; s.y <- 1
a <- function(x) {
sqrt( (x/s.x)^2 + (1.0/s.y)^2 )
}
b <- function(x) {
(m.x*x)/s.x^2 + m.y/s.y^2
}
c <- (m.x/s.x)^2 + (m.y/s.y)^2
d <- function(x) {
u <- b(x)^2 - c*a(x)^2
l <- 2.0*a(x)^2
exp( u / l )
}
# PDF for the ratio of the two different gaussians
PDF <- function(x) {
r <- b(x)/a(x)
q <- pnorm(r) - pnorm(-r)
(r*d(x)/a(x)^2) * (1.0/(sqrt(2.0*pi)*s.x*s.y)) * q + exp(-0.5*c)/(pi*s.x*s.y*a(x)^2)
}
# normalization
nn <- integrate(PDF, -Inf, Inf)
nn <- nn[["value"]]
# plot PDF
p <- ggplot(data = data.frame(x = 0), mapping = aes(x = x))
p <- p + stat_function(fun = function(x) PDF(x)/nn) + xlim(-2.0, 6.0)
print(p)
# first momentum
m1 <- integrate(function(x) x*PDF(x), -Inf, Inf)
m1 <- m1[["value"]]
# mean
print(m1/nn)
# some sampling
set.seed(32345)
n <- 10^7L
x <- rnorm(n, mean = m.x, sd = s.x); y <- rnorm(n, mean = m.y, sd = s.y)
print(mean(x/y))
print(sd(x/y))
# second momentum - Infinite!
m2 <- integrate(function(x) x*x*PDF(x), -Inf, Inf)
Thus, it is impossible to test any Taylor expansion for std.dev.
With the cautions suggested by #G.Grothendieck in mind: a useful mnemonic for products and quotients of independent X and Y variables is
CV^2(X/Y) = CV^2(X*Y) = CV^2(X) + CV^2(Y)
where CV is the coefficient of variation (sd(X)/mean(X)), so CV^2 is Var/mean^2. In other words
Var(Y/X)/(m(Y/X))^2 = Var(X)/m(X)^2 + Var(Y)/m(Y)^2
or rearranging
sd(Y/X) = sqrt[ Var(X)*m(Y/X)^2/m(X)^2 + Var(Y)*m(Y/X)^2/m(Y)^2 ]
For random variables with the mean well away from zero, this is a reasonable approximation.
set.seed(101)
y <- rnorm(1000,mean=5)
x <- rnorm(1000,mean=10)
myx <- mean(y/x)
sqrt(var(x)*myx^2/mean(x)^2 + var(y)*myx^2/mean(y)^2) ## 0.110412
sd(y/x) ## 0.1122373
Using your example is considerably worse because the CV of Y is close to 1 -- I initially thought it looked OK, but now I see that it's biased as well as not capturing the variability very well (I'm also plugging in the expected values of the mean and SD rather than their simulated values, but for such a large sample that should be a minor part of the error.)
me.x <- 4; sd.x <- 1
me.y <- 5; sd.y <- 4
myx <- me.y/me.x - 0/me.x^2 + sd.x*me.y/me.x^3
x <- rnorm(1e4,me.x,sd.x); y <- rnorm(1e4,me.y,sd.y)
c(myx,mean(y/x))
sdyx <- sqrt(sd.x^2*myx^2/me.x^2 + sd.y^2*myx^2/me.y^2)
c(sdyx,sd(y/x))
## 1.113172 1.197855
rvals <- replicate(1000,
sd(rnorm(1e4,me.y,sd.y)/rnorm(1e4,me.x,sd.x)))
hist(log(rvals),col="gray",breaks=100)
abline(v=log(sdyx),col="red",lwd=2)
min(rvals) ## 1.182698
All the canned delta-method approaches to computing the variance of Y/X use the point estimate for Y/X (i.e. m(Y/X) = mY/mX), rather than the second-order approximation you used above. Constructing higher-order forms for both the mean and the variance should be straightforward if possibly tedious (a computer algebra system might help ...)
mvec <- c(x = me.x, y = me.y)
V <- diag(c(sd.x, sd.y)^2)
car::deltaMethod(mvec, "y/x", V)
## Estimate SE
## y/x 1.25 1.047691
library(emdbook)
sqrt(deltavar(y/x,meanval=mvec,Sigma=V)) ## 1.047691
sqrt(sd.x^2*(me.y/me.x)^2/me.x^2 + sd.y^2*(me.y/me.x)^2/me.y^2) ## 1.047691
For what it's worth, I took the code in #SeverinPappadeux's answer and made it into a function gratio(mx,my,sx,sy). For the Cauchy case (gratio(0,0,1,1)) it gets confused and reports a mean of 0 (which should be NA/divergent) but correctly reports the variance/std dev as divergent. For the parameters specified by the OP (gratio(5,4,4,1)) it gives mean=1.352176, sd=NA as above. For the first parameters I tried above (gratio(10,5,1,1)) it gives mean=0.5051581, sd=0.1141726.
These numerical experiments strongly suggest to me that the ratio of Gaussians sometimes has a well-defined variance, but I don't know when (time for another question on Math StackOverflow or CrossValidated?)
Such approximations are unlikely to be useful since the distribution may not have a finite standard deviation. Look at how unstable it is:
set.seed(123)
n <- 10^6
X <- rnorm(n, me.x, sd.x)
Y <- rnorm(n, me.y, sd.y)
sd(head(Y/X, 10^3))
## [1] 1.151261
sd(head(Y/X, 10^4))
## [1] 1.298028
sd(head(Y/X, 10^5))
## [1] 1.527188
sd(Y/X)
## [1] 1.863168
Contrast that with what happens when we try the same thing with a normal random variable:
sd(head(Y, 10^3))
## [1] 3.928038
sd(head(Y, 10^4))
## [1] 3.986802
sd(head(Y, 10^5))
## [1] 3.984113
sd(Y)
## [1] 3.999024
Note: If you were in a different situation, e.g. the denominator has compact support, then you could do this:
library(car)
m <- c(x = me.x, y = me.y)
v <- diag(c(sd.x, sd.y)^2)
deltaMethod(m, "y/x", v)
I want to go through the betas <- sapply(1 : nosim, function(i) makelms(x1, x2, x3)) on the rgp1 function of the code included in the image. I placed two breakpoints because just the one at the top didn't do the job; however, even with the stop at betas when I press Next on the Console top menu, it moves right past the rgp1 function to the rgp2 function, skipping the line I want to debug. Here is the sequence:
How can I make the debugger go through the sapply line of code without skipping it? I tried clicking "Step into the current function call" (the {} icon) without success.
The code, which belongs to the {swirl} package is:
makelms <- function(x1, x2, x3){
# Simulate a dependent variable, y, as x1
# plus a normally distributed error of mean 0 and
# standard deviation .3.
y <- x1 + rnorm(length(x1), sd = .3)
# Find the coefficient of x1 in 3 nested linear
# models, the first including only the predictor x1,
# the second x1 and x2, the third x1, x2, and x3.
c(coef(lm(y ~ x1))[2],
coef(lm(y ~ x1 + x2))[2],
coef(lm(y ~ x1 + x2 + x3))[2])
}
# Regressor generation process 1.
rgp1 <- function(){
print("Processing. Please wait.")
# number of samples per simulation
n <- 100
# number of simulations
nosim <- 1000
# set seed for reproducibility
set.seed(4321)
# Point A
x1 <- rnorm(n)
x2 <- rnorm(n)
x3 <- rnorm(n)
# Point B
betas <- sapply(1 : nosim, function(i)makelms(x1, x2, x3))
round(apply(betas, 1, var), 5)
}
# Regressor generation process 2.
rgp2 <- function(){
print("Processing. Please wait.")
# number of samples per simulation
n <- 100
# number of simulations
nosim <- 1000
# set seed for reproducibility
set.seed(4321)
# Point C
x1 <- rnorm(n)
x2 <- x1/sqrt(2) + rnorm(n) /sqrt(2)
x3 <- x1 * 0.95 + rnorm(n) * sqrt(1 - 0.95^2)
# Point D
betas <- sapply(1 : nosim, function(i)makelms(x1, x2, x3))
round(apply(betas, 1, var), 5)
}
I tried the following:
debug(rgp1)
rgp1
and it went through all the steps without getting into the sapply part, which is what I really wanted to debug.
I also tried inserting browser() in several locations, as well as debugonce() without success.