Nothing
#' Run the Time Series Simulation script.
#'
#' @export
#' @examples
#' \dontrun{timeseriessim()}
timeseressim<-function()
{
### time series script for R.
### by Omar Chavez
### 1.0 - First version as cribbed from prob.R
##' Given a prompt and acceptable inputs, query user for input until they enter an acceptable value.
##' @author Omar Chavez
getvalidinput <- function(prompt, error, validinput = NULL, low=0, high=0)
{
if(is.null(validinput) && low == high) stop("Must either input validinput or both low and high!")
while(TRUE)
{
input <- readline(prompt)
if(input %in% validinput)
{
return(input)
}
if(!is.na(as.numeric(input)))
{
if(low < high && low < high && low <= as.numeric(input) && as.numeric(input) <= high)
{
return(input)
}
}
cat(error)
}
}
options(warn=-1) # make this 0 for testing, -1 for production
options(scipen=4) #Don't give numbers like 1e-4, instead do .0001
cat("Are you ready for some nice graphics to help illustrate stability in time plots?\n")
cat("At each step, type your response and press \"Enter\"\n\n")
while(TRUE)
{
cat("\nHow many data points would you like to simulate?\n")
# getvalidinput is a function that does exactly what it sounds like. See documentation above.
data.size <- getvalidinput("Enter a number between 1 and 10000 or 'q'to Quit: ", "Invalid selection! Choose a number from 1 to 10000!\n",
validinput = 'q', low = 1, high = 1e4);
if(data.size == 'q') { cat("Quitting!\n"); break() }
data.size <- as.numeric(data.size)
stable.unstable <- getvalidinput("\nWould you like to generate stable or unstable plots?\n1) stable plots\n2) unstable plots \nPlease enter your selection or q to quit: ", "Invalid selection! enter1, 2 or q \n", validinput = c('1', '2', 'q'))
if(stable.unstable == 'q') { cat("\nQuitting!\n"); break() }
stable.unstable <- as.numeric(stable.unstable)
#if unstable plot selected get info about mean and variance
if(stable.unstable == 2){
mean = 0
variance = 1
mean.and.variance = getvalidinput("\nWould you like to have \n1) changing mean only? \n2) changing variance only? \n3) both changing mean AND changing variance? \nPlease enter your selection or q to quit: ", "Invalid selection! enter 1, 2, 3 or q.\n",
validinput = c('1', '2', '3', 'q'))
if( mean.and.variance == 'q') { cat("\nQuitting!\n"); break() }
mean.and.variance <- as.numeric(mean.and.variance)
#changing mean
if(mean.and.variance == 1 | mean.and.variance == 3){
mean.selection <- getvalidinput("\nWould you like the mean to \n1) Increase?\n2) Decrease?\n3) Oscillate (fluctuate)? \nPlease enter your selection or q to quit: ", "Invalid selection! enter 1,2,3 or q \n", validinput = c('1', '2', '3', 'q'))
if(mean.selection == 'q') { cat("\nQuitting!\n"); break() }
mean.selection <- as.numeric(mean.selection)
#increasing mean
if(mean.selection == 1){
mean = c(1:data.size)* (3/data.size)
if(mean.and.variance == 1){
description = "increasing mean, constant variance"
}
if(mean.and.variance == 3){
description = "increasing mean"
}
}
#decreasing mean
if(mean.selection == 2){
mean = c(data.size:1)* (3/data.size)
if(mean.and.variance == 1){
description = "decreasing mean, constant variance"
}
if(mean.and.variance == 3){
description = "decreasing mean"
}
}
#oscillating mean
if(mean.selection == 3){
mean = 2 * cos( c(1:data.size)*4*pi/data.size )
if(mean.and.variance == 1){
description = "oscillating (fluctuating) mean, constant variance"
}
if(mean.and.variance == 3){
description = "oscillating (fluctuating) mean"
}
}
}
#changing variance
if(mean.and.variance == 2 | mean.and.variance == 3){
variance.selection <- getvalidinput("\nWould you like the variance to \n1) Increase?\n2) Decrease?\n3) Oscillate (fluctuate)? \nPlease enter your selection or q to quit: ", "Invalid selection! enter 1,2,3 or q \n", validinput = c('1', '2', '3', 'q'))
if(variance.selection == 'q') { cat("\nQuitting!\n"); break() }
variance.selection <- as.numeric(variance.selection)
#increasing variance
if(variance.selection == 1){
variance = c(1:data.size)* (3/data.size)
if(mean.and.variance == 2){
description = "constant mean, increasing variance"
}
if(mean.and.variance == 3){
description = paste(description, ", increasing variance")
}
}
#decreasing variance
if(variance.selection == 2){
variance = c(data.size:1)* (3/data.size)
if(mean.and.variance == 2){
description = "constant mean, decreasing variance"
}
if(mean.and.variance == 3){
description = paste(description, ", decreasing variance")
}
}
#oscillating variance
if(variance.selection == 3){
variance = 2 * cos( c(1:data.size)*4*pi/data.size )
if(mean.and.variance == 2){
description = "constant mean, oscillating (fluctuating) variance"
}
if(mean.and.variance == 3){
description = paste(description, ", oscillating (fluctuating) variance")
}
}
}
}
switch(stable.unstable,
{
#stable plots
series1 = rnorm(data.size)
series2 = rnorm(data.size)
series3 = rnorm(data.size)
series4 = rnorm(data.size)
},
{
#unstable plots
series1 = variance * rnorm(data.size) + mean
series2 = variance * rnorm(data.size) + mean
series3 = variance * rnorm(data.size) + mean
series4 = variance * rnorm(data.size) + mean
}) # end switch
#generate
par(mfrow = c(2,2), omi = c(0,0, .5,0), mar = c(4,4, 9,1))
if(stable.unstable == 1){
plot(series1, type = 'l', main = "Simulation 1")
plot(series2, type = 'l', main = "Simulation 2")
plot(series3, type = 'l', main = "Simulation 3")
plot(series4, type = 'l', main = "Simulation 4")
mtext(paste("Stable Plots"), side = 3, line = -1, cex = 2, outer = TRUE)
mtext("constant mean, constant variance", side = 3, line = -3, cex = 1, outer = TRUE)
}
if(stable.unstable == 2){
plot(series1, type = 'l', main = "Simulation 1")
plot(series2, type = 'l', main = "Simulation 2")
plot(series3, type = 'l', main = "Simulation 3")
plot(series4, type = 'l', main = "Simulation 4")
mtext(paste("Unstable Plots"), side = 3, line = -1, cex = 2, outer = TRUE)
mtext(paste(description), side = 3, line = -3, cex = 1, outer = TRUE)
}
################################################
# #
# option to save plots here #
# #
################################################
saveplots <- getvalidinput("Do you want to save your plot to the desktop? y/n: ", "Enter (y)es or (n)o!\n", validinput=c('y','n', 'q'))
if(saveplots == 'q') { cat("Quitting!\n"); break() }
if(saveplots == 'y')
{
titlename <- readline("Please enter your name for the plot: ")
while(TRUE)
{
if(nchar(titlename) > 0) break()
titlename <- readline("Must enter a name! Enter your name: ")
}
os <- .Platform$OS
td <- gsub(":", ".", as.character(Sys.time()))
td <- gsub(" ", "_", td)
if(os == 'unix') #unix == linux or mac
{
name <- paste("~/Desktop/time_series_Rplot_", td, sep="")
}
if(os == 'windows')
{
name <- strsplit(as.character(Sys.getenv('HOME')), 'Documents')
name <- paste(name, "Desktop\\time_series_Rplot_", td, sep="")
}
name <- paste(name, ".jpg", sep="")
jpeg(name)
#generate plots to save
if(stable.unstable == 1){
par(mfrow = c(2,2), omi = c( 0,0, .25,0), mar = c(4,4, 9,1))
plot(series1, type = 'l', main = "Simulation 1",xlab = "index", ylab = "time series value")
plot(series2, type = 'l', main = "Simulation 2",xlab = "index", ylab = "time series value")
plot(series3, type = 'l', main = "Simulation 3",xlab = "index", ylab = "time series value")
plot(series4, type = 'l', main = "Simulation 4",xlab = "index", ylab = "time series value")
mtext(paste("Stable Plots - ", "constant mean, constant variance"), side = 3, line = -1, cex = 1, outer = TRUE)
mtext(paste("by ",titlename), side = 3, line = -3, cex = 1, outer = TRUE)
}
if(stable.unstable == 2){
par(mfrow = c(2,2), omi = c(0,0, .25,0), mar = c(4,4, 9,1))
plot(series1, type = 'l', main = "Simulation 1",xlab = "index", ylab = "time series value")
plot(series2, type = 'l', main = "Simulation 2",xlab = "index", ylab = "time series value")
plot(series3, type = 'l', main = "Simulation 3",xlab = "index", ylab = "time series value")
plot(series4, type = 'l', main = "Simulation 4",xlab = "index", ylab = "time series value")
mtext(paste("Unstable Plots - ", description), side = 3, line = -1, cex = 1, outer = TRUE)
mtext(paste("by ", titlename), side = 3, line = -3, cex = 1, outer = TRUE)
}
dev.off()
}
################################################
} # end while loop
}
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.