diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/demean.R | 70 | ||||
| -rw-r--r-- | R/detrend.R | 48 |
2 files changed, 26 insertions, 92 deletions
diff --git a/R/demean.R b/R/demean.R deleted file mode 100644 index 7759b08..0000000 --- a/R/demean.R +++ /dev/null @@ -1,70 +0,0 @@ -#' Mean-Center the data -#' -#' Mean Centers the input and output matrices. -#' -#' @param data an object of class \code{idframe} -#' -#' @return -#' A list containing the following elements -#' -#' \tabular{ll}{ -#' \code{fitted.values} \tab \code{idframe} object with mean-centered variables \cr -#' \code{output.mean} \tab \code{vector} containing means for each output variable \cr -#' \code{input.mean} \tab \code{vector} containing means for each input variable -#' } -#' -#' @examples -#' data(cstr) -#' fit.mean <- demean(cstr) -#' cstr_demean <- predict(fit.mean) -#' -#' @seealso \code{\link{predict.demean}}, \code{\link[stats]{colMeans}} -#' @export -demean <- function(data){ - - data_demean <- data - output.mean <- colMeans(data$output) - input.mean <- colMeans(data$input) - - - data_demean$output <- data$output - output.mean - data_demean$input <- data$input - input.mean - - est <- list(fitted.values=data_demean,output.mean = output.mean, - input.mean = input.mean) - - class(est) <- "demean" - return(est) -} - -#' Predict the centered values -#' -#' Center an \code{idframe} object based on the training center means -#' -#' @param object an object of class \code{idframe} -#' @param newdata An optional idframe object in which to look for variables with which -#' to predict. If ommited, the original idframe object is used -#' -#' @return an \code{idframe} object -#' -#' @examples -#' ## Examples for train and test sets -#' data(cstr) -#' splitList <- dataPartition(cstr,p=0.6) -#' train <- splitList$estimation # training set -#' test <- splitList$validation # testing set -#' fit.mean <- demean(train) -#' train_demean <- predict(fit.mean) -#' test_demean <- predict(fit.mean,newdata=test) -#' @export -predict.demean <- function(object,newdata=NULL,...){ - - if(is.null(newdata)){ - data <- fitted(object) - } else{ - data <- newdata - data$output <- data$output - object$output.mean - data$input <- data$input - object$input.mean - } - return(data) -} diff --git a/R/detrend.R b/R/detrend.R index 987c559..0fc6fd8 100644 --- a/R/detrend.R +++ b/R/detrend.R @@ -1,40 +1,53 @@ #' Remove linear trends #' -#' Removes the linear trends in the input and output matrices. +#' Removes the mean value or linear trends in each of the input and output matrices. #' #' @param data an object of class \code{idframe} +#' @param type trend type - "constant" or "linear". (Default: \code{"linear"}) #' #' @return #' A list containing the following elements #' #' \tabular{ll}{ #' \code{fitted.values} \tab \code{idframe} object with detrended variables \cr -#' \code{output.trend} \tab \code{list} containing trend fits for each output variable \cr -#' \code{input.trend} \tab \code{list} containing trend fits for each input variable +#' \code{output.trend} \tab \code{list} containing trend fits for each output +#' variable \cr +#' \code{input.trend} \tab \code{list} containing trend fits for each input +#' variable #' } #' #' @examples #' data(cstr) -#' fit <- detrend.idframe(cstr) -#' cstr_detrend <- predict(fit) +#' fit <- detrend(cstr) +#' Zdetrend <- predict(fit) #' -#' @seealso \code{\link{predict.detrend.idframe}}, \code{\link[stats]{lm}} +#' @seealso \code{\link{predict.detrend}}, \code{\link[stats]{lm}} #' @export -detrend.idframe <- function(data){ +detrend <- function(data,type=c("constant","linear")[2]){ - data_detrend <- data + if(!(type %in% c("constant","linear"))){ + stop("Error: Invalid trend type") + } + + reg <- time(data$output[,1]) + + if(type=="linear"){ + formula <- X ~ reg + } else { + formula <- X ~ 1 + offset(0*reg) + } + data_detrend <- data out <- data$output;output_trend <- list() - t <- time(out[,1]) for(i in 1:ncol(out)){ - output_trend[[i]] <- lm(out[,i]~t) + output_trend[[i]] <- lm(formula,X=out[,i]) out[,i] <- fitted(output_trend[[i]]) } input <- data$input;input_trend <- list() for(i in 1:ncol(input)){ - input_trend[[i]] <- lm(input[,i]~t) + input_trend[[i]] <- lm(formula,X=input[,i]) input[,i] <- fitted(input_trend[[i]]) } @@ -43,7 +56,7 @@ detrend.idframe <- function(data){ est <- list(fitted.values=data_detrend,output.trend = output_trend, input.trend = input_trend) - class(est) <- "detrend.idframe" + class(est) <- "detrend" return(est) } @@ -57,17 +70,8 @@ detrend.idframe <- function(data){ #' #' @return an \code{idframe} object #' -#' @examples -#' ## Examples for train and test sets -#' data(cstr) -#' splitList <- dataPartition(cstr,p=0.6) -#' train <- splitList$estimation # training set -#' test <- splitList$validation # testing set -#' fit <- detrend.idframe(train) -#' train_detrend <- predict(fit) -#' test_detrend <- predict(fit,newdata=test) #' @export -predict.detrend.idframe <- function(object,newdata=NULL,...){ +predict.detrend <- function(object,newdata=NULL,...){ if(is.null(newdata)){ data <- fitted(object) |