R/BootWPTOS.R

Defines functions BootWPTOS

Documented in BootWPTOS

BootWPTOS <-
function(x, levs, indices, filter.number=1, family="DaubExPhase", Bsims=200, lapplyfn=lapply, ret.all=FALSE, s.method="phase"){

#
# Get the name of the data object, x, to be tested
#

DNAME <- deparse(substitute(x))

#
# Check for any illegal values
#

if (any(is.na(x)) || any(is.nan(x)) || any(is.infinite(x)))
	stop("NA/NaN/Inf found in x")

#
# Compute the wavelet packet test statistic on the actual data
#

TS <- WPts(x=x, levs=levs, indices=indices, filter.number=filter.number, family=family)


#
# Create a function to run the bootstrap
#

bsfn <- function(dummy, x, levs, indices, filter.number, family, s.method) {

	# Note: nothing is done with the dummy argument
	#
	# Compute surrogate of time series x
	#
	xs <- as.numeric(surrogate(x, method=s.method))

	if (any(is.na(x)) || any(is.nan(x)) || any(is.infinite(x)))
		stop("NA/NaN/Inf found (in bsfn)")

	#
	# Compute test statistic on surrogate series
	#

	TS <- WPts(x=xs, levs=levs, indices=indices,
		filter.number=filter.number, family=family)
	return(TS)
	}

#
# Create a list where every entry is equal to the single number: Bsims-1
#

dummy.ip <- vector("list", Bsims - 1)

#
# Apply the bootstrap function to every entry in the dummy list
# Note, the bootstrap function takes the object x forms a surrogate
# applies test statistic to the surrogate and returns the test statistic. 
#

ans <- lapplyfn(dummy.ip, bsfn, x=x, levs=levs, indices=indices,
	filter.number=filter.number, family=family, s.method=s.method)

#
# Convert the answer list to a vector
#

ans <- unlist(ans)

#
# Append the value of the test statistic on the data to all the bootstrap vals
#

TS <- c(TS, ans)

#
# Work out the bootstrap p-value
#

p.value <- sum(TS[1] < TS[-1])/Bsims

#
# For debugging purposes return all the test statistics and the computed
# p-value in a list
#

if (ret.all==TRUE)	{
	l <- list(TS=TS, p.value=p.value)
	return(l)
	}

#
# Otherwise return the information in the form of a standard hypothesis
# test object.
#

	
htest.obj <- list(statistic = TS[1], p.value = p.value,
	method = "WPBootTOS test of stationarity", 
        data.name = DNAME, Bootvals = TS)

class(htest.obj) <- c("BootTOS", "htest")
return(htest.obj)
}

Try the BootWPTOS package in your browser

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

BootWPTOS documentation built on May 29, 2017, 11:45 a.m.