R/simulate_true_curve.R

In shimlab/HMTree: Hidden Markov tree prior for analysis of multiple functional data

#' Simulate a true curve according to different models


simulate_true_curve <-function(curve_str, curve_length, stretch, offset)  {
x <- seq(0, 1, length = curve_length + 1)[1:curve_length]; # set a vector between zero and one
switch(curve_str,
'ppoly'={ # Simulate from a polynomial
lambda_vec <- rep(0, curve_length);
xsv <- (x <= 0.5)
lambda_vec[xsv] <- -16 * x[xsv]^3 + 12 * x[xsv]^2
xsv <- (x > 0.5) & (x <= 0.75)
lambda_vec[xsv] <- (x[xsv] * (16 * x[xsv]^2 - 40 * x[xsv] + 28))/3 - 1.5
xsv <- x > 0.75
lambda_vec[xsv] <- (x[xsv] * (16 * x[xsv]^2 - 32 * x[xsv] + 16))/3
},
'doppler'={ # Doppler curve
lambda_vec <- doppler.f(x);
},
'spike'={ # generate a spike
lambda_vec <- spike.f(x);
},
'mine'={
lambda_vec <- 10*(sin((1:curve_length)/50)+1) + 5*sin((1:curve_length)/5+50) - 0.0001*(1:curve_length)^2; # set true reates
lambda_vec <- rev(abs(lambda_vec)); # control here noise level (lambda-vec is Poisson rate)
lambda_vec <- 0.1 * lambda_vec;
},
'bump'={ # one bump
lambda_vec <- rep(0,curve_length); # create a step difference between groups
lambda_vec[round(2*curve_length/5):round(3*curve_length/5)] <- 20; # wide step spike
},
'hmt'={  # simulate wavelets coefficient from the HMT model, invert wavelets transform and get a true curve
lambda_vec <- rep(0,curve_length);
}
) # end switch on choice of curve to simulate
lambda_vec <- stretch * lambda_vec + offset; # Next, stretch and shift curve
return(lambda_vec);
}