# R/data_gen_AR.R In synthesis: Generate Synthetic Data from Statistical Models

#### Documented in data.gen.ar1data.gen.ar4data.gen.ar9data.gen.tar1data.gen.tar2

```#' Generate predictor and response data from AR1 model.
#'
#' @param nobs The data length to be generated.
#' @param ndim The number of potential predictors (default is 9).
#'
#' @return A list of 2 elements: a vector of response (x), and a matrix of potential predictors (dp) with each column containing one potential predictor.
#' @export
#' @importFrom stats rnorm pnorm
#'
#' @examples
#' # AR1 model from paper with 9 dummy variables
#' data.ar1<-data.gen.ar1(500)
#' plot.ts(cbind(data.ar1\$x,data.ar1\$dp))
#'
#' # Predictor Identifier
#' NPRED::stepwise.PIC(data.ar1\$x, data.ar1\$dp)

data.gen.ar1 <- function(nobs, ndim = 9) {
nwarm <- 500
n <- nobs + nwarm
x <- matrix(0, n, 1)
for (i in 1:nwarm) {
x[i] <- rnorm(1, mean = 0, sd = 1)
}
dp <- matrix(0, (nobs), ndim)
for (i in (nwarm + 1):n) {
eps <- rnorm(1, mean = 0, sd = 1)
x[i] <- 0.9 * x[i - 1] + 0.866 * eps
}
for (i in 1:ndim) dp[, i] <- x[(n - i - nobs + 1):(n - i)]
x <- x[(n - nobs + 1):n]
data_generated <- list(x = x, dp = dp, true.cpy = c(1))
return(data_generated)
}

#' Generate predictor and response data from AR4 model.
#'
#' @param nobs The data length to be generated.
#' @param ndim The number of potential predictors (default is 9).
#'
#' @return A list of 2 elements: a vector of response (x), and a matrix of potential predictors (dp) with each column containing one potential predictor.
#' @export
#'
#' @examples
#' # AR4 model from paper with total 9 dimensions
#' data.ar4<-data.gen.ar4(500)
#' plot.ts(cbind(data.ar4\$x,data.ar4\$dp))
#'
#'\donttest{
#' # Predictor Identifier
#' NPRED::stepwise.PIC(data.ar4\$x, data.ar4\$dp)
#' }

data.gen.ar4 <- function(nobs, ndim = 9) {
nwarm <- 500
n <- nobs + nwarm
x <- matrix(0, n, 1)
for (i in 1:nwarm) {
x[i] <- rnorm(1, mean = 0, sd = 1)
}
dp <- matrix(0, (nobs), ndim)
for (i in (nwarm + 1):n) {
eps <- rnorm(1, mean = 0, sd = 1)
x[i] <- 0.6 * x[i - 1] - 0.4 * x[i - 4] + eps
}
for (i in 1:ndim) dp[, i] <- x[(n - i - nobs + 1):(n - i)]
x <- x[(n - nobs + 1):n]
data_generated <- list(x = x, dp = dp, true.cpy = c(1, 4))
return(data_generated)
}

#' Generate predictor and response data from AR9 model.
#'
#' @param nobs The data length to be generated.
#' @param ndim The number of potential predictors (default is 9).
#'
#' @return A list of 2 elements: a vector of response (x), and a matrix of potential predictors (dp) with each column containing one potential predictor.
#' @export
#'
#' @examples
#' # AR9 model from paper with total 9 dimensions
#' data.ar9<-data.gen.ar9(500)
#' plot.ts(cbind(data.ar9\$x,data.ar9\$dp))
#'
#'\donttest{
#' # Predictor Identifier
#' NPRED::stepwise.PIC(data.ar9\$x, data.ar9\$dp)
#' }

data.gen.ar9 <- function(nobs, ndim = 9) {
nwarm <- 500
n <- nobs + nwarm
x <- matrix(0, n, 1)
for (i in 1:nwarm) {
x[i] <- rnorm(1, mean = 0, sd = 1)
}
dp <- matrix(0, (nobs), ndim)
for (i in (nwarm + 1):n) {
eps <- rnorm(1, mean = 0, sd = 1)
x[i] <- 0.3 * x[i - 1] - 0.6 * x[i - 4] - 0.5 * x[i - 9] + eps
}
for (i in 1:ndim) dp[, i] <- x[(n - i - nobs + 1):(n - i)]
x <- x[(n - nobs + 1):n]
data_generated <- list(x = x, dp = dp, true.cpy = c(4, 9, 1))
return(data_generated)
}

#' Generate predictor and response data from TAR1 model.
#'
#' @param nobs  The data length to be generated.
#' @param ndim  The number of potential predictors (default is 9).
#' @param noise The white noise in the data
#'
#' @return A list of 2 elements: a vector of response (x), and a matrix of potential predictors (dp) with each column containing one potential predictor.
#' @export
#'
#' @references Sharma, A. (2000). Seasonal to interannual rainfall probabilistic forecasts for improved water supply management: Part 1 - A strategy for system predictor identification. Journal of Hydrology, 239(1-4), 232-239.
#'
#' @examples
#' # TAR1 model from paper with total 9 dimensions
#' data.tar1<-data.gen.tar1(500)
#' plot.ts(cbind(data.tar1\$x,data.tar1\$dp))

data.gen.tar1 <- function(nobs, ndim = 9, noise = 0.1) {
nwarm1 <- nwarm2 <- 250
n <- nobs + nwarm1 + nwarm2
x <- matrix(0, n, 1)
for (i in 1:nwarm1) {
x[i] <- rnorm(1, mean = 0, sd = 1)
}
dp <- matrix(0, (nobs), ndim)
for (i in (nwarm1 + 1):n) {
eps <- rnorm(1, mean = 0, sd = 1)
xi3 <- x[i - 3]
if (xi3 <= 0)
x[i] <- -0.9 * x[i - 3] + noise * eps else x[i] <- 0.4 * x[i - 3] + noise * eps
}
for (i in 1:ndim) dp[, i] <- x[(n - i - nobs + 1):(n - i)]
x <- x[(n - nobs + 1):n]
data_generated <- list(x = x, dp = dp, true.cpy = c(3))
return(data_generated)
}

#' Generate predictor and response data from TAR2 model.
#'
#' @param nobs  The data length to be generated.
#' @param ndim  The number of potential predictors (default is 9).
#' @param noise The white noise in the data
#'
#' @return A list of 2 elements: a vector of response (x), and a matrix of potential predictors (dp) with each column containing one potential predictor.
#' @export
#'
#' @references Sharma, A. (2000). Seasonal to interannual rainfall probabilistic forecasts for improved water supply management: Part 1 - A strategy for system predictor identification. Journal of Hydrology, 239(1-4), 232-239.
#'
#' @examples
#' # TAR2 model from paper with total 9 dimensions
#' data.tar2<-data.gen.tar2(500)
#' plot.ts(cbind(data.tar2\$x,data.tar2\$dp))

data.gen.tar2 <- function(nobs, ndim = 9, noise = 0.1) {
nwarm1 <- nwarm2 <- 250
n <- nobs + nwarm1 + nwarm2
x <- matrix(0, n, 1)
for (i in 1:nwarm1) {
x[i] <- rnorm(1, mean = 0, sd = 1)
}
dp <- matrix(0, (nobs), ndim)
for (i in (nwarm1 + 1):n) {
eps <- rnorm(1, mean = 0, sd = 1)
xi6 <- x[i - 6]
if (xi6 <= 0)
x[i] <- -0.5 * x[i - 6] + 0.5 * x[i - 10] + noise * eps else x[i] <- 0.8 * x[i - 10] + noise * eps
}
for (i in 1:ndim) dp[, i] <- x[(n - i - nobs + 1):(n - i)]
x <- x[(n - nobs + 1):n]
data_generated <- list(x = x, dp = dp, true.cpy = c(10, 6))
return(data_generated)
}
```

## Try the synthesis package in your browser

Any scripts or data that you put into this service are public.

synthesis documentation built on Nov. 27, 2021, 5:07 p.m.