I am trying to calculate the area under the curve for every 10ms of a short piece of EEG wave. To first practice this I made a small dataset to run the auc (from package {flux}) function on.
x <- seq(1:10)
y <- c(0:4,5:1)
df <- data.frame(x,y)
attach(df)
plot(x,y)
for (i in 1:10){
x1 <- c(i,(i+1))
y1 <- c(subset(y, x == i),subset(y, x == (i+1)))
auc(x1,y1,thresh = 0)
rm(y1,x1,i)
}
The loop should try to subset two data points from each variable and then run a auc over those data points. However, when running the loop, I get this error:
Error in seq.default(x[1], x[2], length.out = dens) : 'to' must be a finite number
When I run the subset and auc code outside of the loop, it works no problem. Can anyone tell me what's going wrong in the loop?
Thanks for updating the question. It's not because of the control statement (for loop), the error gets thrown precisely when i=10 -- because the length of your x-coords and y-coords vectors are different. Specifically c(10,11) vs c(1). But you have no point at x=11 !
just stop the loop early, at the appropriate time
Related
I am trying to create a function where Monte Carlo Simulation is applied to two of the variables in a DCF Model in R Studio. It supposed to take a first value FCF_0 and applied to it a specific growth FCF_ 0*(1 + growth), which is the first input variable until period 6, each period takes the last FCF to keep growing. After that I would like to discount it as well to get the present value which would be FCFn*(1/((1+WACC)^n)). Where WACC is the second variable to simulate.
So far I have the function to calculate the FCF but with a vector of specifics values of growth, which is the following:
What I am trying so far to create this function is this, but I think is bad.
Could you please help me to understand how to create both simulations and if it is neccesary for me to create two functions or in one function I can do everything? I would expect from the function to give the sum of all present values and each sum would be an element in a vector of 10.000 simulations. I am new at this and even though I have read almost for two weeks, I don't get how to create these simulations.
Thank you very much!
revfunc <- function(hist, growth){
rval <- c()
help <- c(hist)
for(i in growth){
help <- help*(1+i)
rval <- c(rval, help)
}
return(rval)
}
Monte Carlo Simulations
pvffcf_function <- function(fcf0, growth, wacc){
rval1 <- c()
help <- c(fcf0)
pvs <- rval1*(1/((1+wacc)^n))
random_growth <- rnorm(n=10000, mean(fcfgrowth), sd(fcfgrowth))
wacc <- rnorm(n=10000, 0.03804, 0.007711)
pvffcf <- sum(freecashflows)
for(i in growth){
help <- help*(1+i)
rval1 <- c(rval1, help)
}
return(freecashflows)
}
I had previously asked this question trying to get top down forecasted proportions forecast recombination using the hts package. The solution there works great for multilevel hierarchies, however I have found I get an error when I try to use the solution on a two level hierarchy.
library(hts)
# Create the hierarchy
newhts <- hts(htseg1$bts, list(ncol(htseg1$bts)))
# forecast creation adapted from the `combinef()` example
h <- 12
ally <- aggts(newhts)
allf <- matrix(NA, nrow = h, ncol = ncol(ally))
for(i in 1:ncol(ally))
allf[,i] <- forecast(auto.arima(ally[,i]), h = h, PI = FALSE)$mean
allf <- ts(allf, start = 51)
# Earo Wang's solution to my previous question
hts:::TdFp(allf, nodes = htseg1$nodes)
Error in *.default(fcasts[, 1L], prop) : time-series/vector length mismatch
The problem seems to arise because a two level hierarchy skips the last if conditional with the condition if (l.levels > 2L). The last statement of this conditional multiplies includes a piece where prop is multiplied by the time series flist[[k + 1L]], which converts prop into a time series matrix. When this statement is skipped, prop remains a regular matrix causing the error when the time series vector fcasts[, 1L] is multiplied by the matrix prop.
I understand that TdFp is a non exported function and therefore may not be as robust as the other functions in the package, but is there any way around this problem? Since it is a relatively simple case, I can code a solution myself, but since hts::forecast.hts() can handle two level hierarchies for method = "tdfp", I thought there might be a nice clean solution.
I try to solve a set of non-linear systems of equation using the nleqslv function in R. Unfortunately I run into troubles guessing the right initial values to make the function run sucessfully. I have a vector with values between 0 and 1, which are called c(t). They should satisfy the following equation
c(t)=A*(exp(-mt)+exp(-m(1024-t)))+B^2
Using three subsequent values of t I aim to determine the coefficients A,B,m using the following code
library(nleqslv)
C10 <- c(1.000000e+00,9.754920e-01,9.547681e-01,9.359057e-01,9.182586e-01,9.014674e-01)
system_size <- 1024
for(i in 2:5)
{
C <- c(C10[i-1],C10[i],C10[i+1],i-2)
#function
target <- function(Coeffs){
y <- numeric(3)
y[1] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]-1))+exp(-Coeffs[2]*(system_size-(C[4]-1))))+Coeffs[3]^2-C[1]
y[2] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]))+exp(-Coeffs[2]*(system_size-(C[4]))))+Coeffs[3]^2-C[2]
y[3] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]+1))+exp(-Coeffs[2]*(system_size-(C[4]+1))))+Coeffs[3]^2-C[3]
y
}
init <- c(0.001,0.01,0)
sol <- nleqslv(init, target,control=list(btol=.01), method="Broyden")
}
The used initial values reflect what I get when plotting the associated values c(t). Nonetheless the generated output sol gives
chr "Jacobian is ill-conditioned (1/condition=9.0e-18) (see allowSingular option)"
Any idea what is going wrong and how to solve this?
OP edit: Modified Code to have minimal working example: added first few values for C10, adjusted loop and added value for system_size
With your addition of some data for C10 the example runs perfectly ok if one takes into account that the loop should take account of length(C10).
Like this (with some changes; for why see below):
library(nleqslv)
C10 <- c(1.000000e+00,9.754920e-01,9.547681e-01,9.359057e-01,9.182586e-01,9.014674e-01)
system_size <- 1024
target <- function(Coeffs){
y <- numeric(3)
y[1] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]-1))+exp(-Coeffs[2]*(system_size-(C[4]-1))))+Coeffs[3]^2-C[1]
y[2] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]))+exp(-Coeffs[2]*(system_size-(C[4]))))+Coeffs[3]^2-C[2]
y[3] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]+1))+exp(-Coeffs[2]*(system_size-(C[4]+1))))+Coeffs[3]^2-C[3]
y
}
init <- 50*c(0.001,0.01,0)
for(i in 2:min(length(C10)-1,(system_size/2)))
{
C <- c(C10[i-1],C10[i],C10[i+1],i-2)
#function
target <- function(Coeffs){
y <- numeric(3)
y[1] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]-1))+exp(-Coeffs[2]*(system_size-(C[4]-1))))+Coeffs[3]^2-C[1]
y[2] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]))+exp(-Coeffs[2]*(system_size-(C[4]))))+Coeffs[3]^2-C[2]
y[3] <- Coeffs[1]*(exp(-Coeffs[2]*(C[4]+1))+exp(-Coeffs[2]*(system_size-(C[4]+1))))+Coeffs[3]^2-C[3]
y
}
cat("i=",i,"init=",init, "target(init)=",target(init),"\n")
sol <- nleqslv(init, target,control=list(btol=.01), method="Broyden")
print(sol)
}
With your initial starting values the model doesn't solve and gives the error message you mention. I have changed the value of init by increasing the value. And then a solution is found up-to i=5. Larger values with the given C10 won't run since within the loop C10[i+1] is referenced (and it doesn't exist).
I have inserted a cat statement before the call of nleqslv and a print(sol) after the function call so that one can at least see what's going on and if a solution is actually found.
You do not need to specify method="Broyden" since it is the default.
You should test sol$termcd in the for loop end exit if an error occurs.
With scripts like this always print stuff inside the loop!
Mislav was correct: starting values can be totally wrong.
Even if starting values are ok the algorithms used can fail. That's why the package provides function testnslv and searchZeros.
I did some experiments (not shown here) with testnslv and the conclusion is that method="Newton" is a failure. The dogleg global strategies always seem to work. The linesearch strategies don't always work.
I'm using the deSolve package to plot a couple differential equations (read if interested http://www.maa.org/press/periodicals/loci/joma/the-sir-model-for-spread-of-disease-the-differential-equation-model).
My eventual goal is to create an iterative function or process (for loop) to plot how changes in certain parameters (beta and gamma) will affect the solution. The preferred output would be a list that contains all each ode solution for each specified value of beta in the loop. I'm running into issues for integrating a loop into the setup that the deSolve package requires for the ode function.
In the code below, I am trying to plot how the range of values (1 to 2 by increments of 0.1) in parameter beta will affect the plot of the differential equations.
for(k in seq(1,2,by=0.1)){ #range of values for beta
init <- c(S=1-1e-6, I=1e-6, R=0) #initial conditions for odes
time <- seq(0,80,by=1) #time period
parameters <- c(beta=k, gamma=0.15) #parameters in ode
SIR <- function(time,state,parameters){ #function containing equaations
with(as.list(c(state,parameters)),{
dS <- -beta*S*I
dI <- beta*S*I-gamma*I
dR <- gamma*I
return(list(c(dS,dI,dR)))
})
}
ode(y=init,times=time,func=SIR()[beta],parms=parameters[k])}
}
The first error I'm getting states that the argument parameters in the SIR function is missing
Error in as.list(c(init, parameters)) : argument "parameters" is
missing, with no default
I don't understand why this error is being reported when I've assigned parameters in the lines previous.
You might as well define your gradient function (and the other non-changing elements) outside the loop:
SIR <- function(time,state,parameters) {
with(as.list(c(state,parameters)),{
dS <- -beta*S*I
dI <- beta*S*I-gamma*I
dR <- gamma*I
return(list(c(dS,dI,dR)))
})
}
init <- c(S=1-1e-6, I=1e-6, R=0) #initial conditions for odes
time <- seq(0,80,by=1) #time period
Now define the vector of values to try (not necessary but convenient):
betavec <- seq(1,2,by=0.1)
and define a list to hold the results:
res <- vector(length(betavec),mode="list")
library(deSolve)
for (k in seq_along(betavec)){ #range of values for beta
res[[k]] <- ode(y=init,times=time,func=SIR,
parms=c(beta=betavec[k], gamma=0.15))
}
Now you have a list, each element of which contains the results from one run. You can sapply or lapply over this list, e.g. to get a matrix of the last states from each run:
t(sapply(res,tail,1))
Or if you want the results as one long data frame ...
names(res) <- betavec ## to get beta value incorporated in results
dd <- dplyr::bind_rows(lapply(res,as.data.frame),.id="beta")
dd$beta <- as.numeric(dd$beta)
do.call(rbind,...) would work nearly as well as bind_rows(), but bind_rows's .id argument is convenient for adding the beta values to each data frame. You could also leave the results as a list and loop over them while plotting with separate lines() calls, or (e.g.) bind just the infective columns together and use matplot() to plot them all at the same time. This is just a matter of style and idiom.
library(ggplot2); theme_set(theme_bw())
library(viridis)
ggplot(dd,aes(x=time,y=I,colour=beta))+
geom_line(aes(group=beta))+
scale_color_viridis()+
scale_y_log10()
I'm fitting a parametric model to some survival data with time-dependent covariates. The fitting procedure involves solving some ODEs iteratively - one ODE per time-interval per subject, but such that the initial condition for the ODE on the interval at hand is the last value of the solution to the ODE on the preceding interval. In that sense, the ODEs depend on each other.
My problem boils done to this: Right now, I'm solving these ODEs iteratively through a loop, since I need to use the last value of the previous solution as the starting point for the next. The problem is that this looping consumes a lot of time for large datasets. Is there some way in which I can use, say, vapply, or another vectorized function, to do the same thing?
I've been searching the archives, but nothing comes up as a solution to the problem of vectorizing an operation that depends on the previous value.
Here's a code example, that doesn't produce anything statistically meaningful on its own, but illustrates my problem:
require(odeSolve)
param <- c(a=1)
df <- function(t, state, param){
with( as.list(c(state, param)), {dX<-a*X; list(c(dX))} )
}
Data.i <- data.frame( lt=seq(0, 5, length=10)[-10],rt=seq(0, 5, length=10)[2:10], X=rnorm(9) )
Result <- vector(length=10)
Result[1] <- Data.i$X[1]
init <- c(X=Data.i$X[1])
for (k in 1:9){
t.seq <- seq(Data.i$lt[k],Data.i$rt[k],length=10)
sol <- as.numeric(ode(y = init, times = t.seq, func = df, parms = param)[10,-1])
Result[k+1] <- log(sol+X[k+1])
init <- c(X=sol)
}