Nothing
#'Generate a time series containing a Visual Charting Pattern.
#'
#'This function lets you generate any pattern you specify in the parameters. For known definitions, either
#'check the examples or the vignettes. This is mainly used to test either your own or this smoothing and recognition
#'function.
#'
#'For an overview of the package capabilities, click here \link{rpatrec}
#'
#'@param start Starting value
#'@param dlength Integer. Length of the signal part of the time series
#'@param tot.spread Integer. Difference between the lowest and highest value of the time series
#'@param presig Integer. Length of the pre-signal part of the time series
#'@param postsig Integer. Length of the post-signal part of the time series
#'@param plength No longer needed, kept for compatability. Set to 0.
#'@param parts Vector of Integers. Must be the same length as \code{sprd}
#' Defines how far the extrema lie apart from another (in percent)
#' PREVIOUSLY: Vector must contain plength + 2 elements, the first element being 0 and the last 100.
#'@param sprd Vector of Integers. Must be the same length as \code{parts}
#' Defines the value of the extrema in percent of \code{tot.spread} in relation to \code{start}.
#' PREVIOUSLY: Vector must contain plength + 2 elements, the first and last elemnt should be 0.
#'
#'@return Time series with (optional) pre- or post signal, and the specified pattern.
#'
#'@examples
#'\dontrun{
#'#create a standard HS pattern:
#'generator()
#'#
#'
#'#create a shifted head and shoulders pattern
#'generator(sprd = c(20,10,90,40,60))
#'#
#'#create a Double Tops pattern
#'generator(plength=3,parts=c(25,50,75),sprd=c(80,40,80))
#'#
#'#create a Rectangle Tops pattern
#'generator(plength=5,parts=c(20,40,50,60,80),sprd=c(80,40,80,40,80))
#'#
#'#create a single peak, 10 data points, max is approximately 10
#'generator(0,10,10,0,0,0,50,100)
#'}
#'
#'@importFrom stats runif
#'@export
#'
#'
generator <- function(start = 0, dlength = 100, tot.spread = 100, presig = 0, postsig = 0,
plength = 0, parts = c(15, 25, 50, 75, 85), sprd = c(50, 25, 100, 25, 50)) {
# generate any pattern
# check errors
inputchecks(list(start, dlength, tot.spread, presig, postsig, plength, parts,
sprd), "generator")
if (parts[1] != 0 && sprd[1] != 0) {
parts <- c(0, parts, 100)
sprd <- c(0, sprd, 0)
}
plength <- length(parts) - 2
sectgen <- function(sectlen, init, ref, spread, acc = 1e-05) {
sector <- vector(length = sectlen)
# print(ref) print(init)
expmin <- ref * (1 - acc)
expmax <- ref * (1 + acc)
# print(expmin)
repeat {
cur <- init
for (j in 1:sectlen) {
sector[j] <- cur
# going down
if (ref < init)
cur <- runif(1, sector[j] - spread, sector[j])
# going up
if (ref > init)
cur <- runif(1, sector[j], spread + sector[j])
}
if (sector[sectlen] > expmin) {
if (sector[sectlen] < expmax)
break
}
}
return(sector)
}
start.const <- start
neg <- start - tot.spread
negative <- FALSE
if (neg <= 0) {
start <- start - neg + 10
negative <- TRUE
}
start.const <- start
# make data
output <- vector(length = dlength)
partitions <- as.integer(round(parts/100 * dlength))
pre_spreads <- sprd/100 ##same
for (i in 1:(plength + 1)) {
reference <- start.const + round(tot.spread * pre_spreads[i + 1])
curspread <- 2 * tot.spread * abs(pre_spreads[i + 1] - pre_spreads[i])/(partitions[i +
1] - partitions[i])
# print(curspread)
output[(partitions[i] + 1):partitions[i + 1]] <- sectgen((partitions[i +
1] - partitions[i]), start, reference, curspread)
start <- output[(partitions[i + 1] - 1)]
}
if (negative == TRUE)
output <- output + neg - 10
if (presig != 0) {
pre <- vector(length = presig)
pre <- rep(output[1], presig)
output <- c(pre, output)
}
if (postsig != 0) {
post <- vector(length = postsig)
post <- rep(output[length(output)], postsig)
output <- c(output, post)
}
return(output)
}
#'
#'Add noise to a time series
#'
#'This function lets you add artificial noise to time series, normally to patterns generated by \link{generator}.
#'Use different types and strengths of noise to test smoothers.
#'
#'For an overview of the package capabilities, click here \link{rpatrec}
#'
#'@param input Time series to which noise will be added
#'@param type String. Defines what type of noise to be added. Acceptable values are:\itemize{
#' \item{\code{white} - white noise with variance \code{final_level}}
#' \item{\code{red} - red noise with variance \code{final_level} (use with caution)}
#'}
#'@param final_level Number or \code{var}.
#' A number sets the standard deviation to a constant value at each point.
#' \code{var} sets the standard deviation to increase proportional to the (absolute value of the) signal at peaks.
#'
#'
#'@return Time series with added noise.
#'
#'@examples
#'\dontrun{
#'#Generate a HS patterns
#'a <- generator()
#'#now add white noise with a standdard deviation of 10
#'b <- noise(a,'white',10)
#'plot(b)
#'}
#'
#'@export
#'@importFrom stats rnorm
#'
noise <- function(input, type, final_level) {
inputchecks(list(input, type, final_level), "noise")
if (type == "var") {
# set scale
up <- max(abs(input))
output <- vector(length = length(input))
# create noise
for (i in 1:length(input)) {
output[i] <- input[i] + rnorm(1, 0, (abs(input[i])/up * final_level))
}
}
if (type == "white") {
output <- input + rnorm(length(input), 0, final_level)
}
if (type == "red") {
noise <- cumsum(rnorm(length(input), 0, final_level))
output <- input + noise
}
return(output)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.