R/ppr.r

In QWDAP: Quantum Walk-Based Data Analysis and Prediction

#' @title Projection Pursuit Regression
#' @description Projection pursuit regression. This is a nonlinear regression method used to
#' establish the nonlinear relationship between the original time series and the modes
#' generated by quantum walks.
#' @usage qwdap.ppr(in_data, data_range, plotting)
#' @param in_data a 'QWMS' object, which includes the target series and the
#' selected modes which can be obtained from modes selection.
#' @param data_range the range of the train samples.
#' @param plotting whether to plot.
#'
#' @return a 'QWMODEL' object which includes the information of regression analysis.
#' @importFrom stats ppr
#' @importFrom graphics lines legend
#' @export qwdap.ppr
#'
#' @examples
#' data("traffic.n1")
#' res.ppr <- qwdap.ppr(traffic.n1,c(1,500))
#' 
qwdap.ppr<-function(in_data, data_range, plotting = FALSE){
  if(class(in_data)!='QWMS'){
    stop("The 'in_data' is not a 'QWMS' object.")
  }
  if(!is.vector(data_range)||!is.numeric(data_range)||length(data_range)<2){
    stop("The parameter 'data_range' is error.")
  }
  # pre combine
  co_data = cbind(in_data$real, in_data$ctqw)
  co_data <- subset(co_data, select = c(colnames(in_data$real), in_data$variate))
  res<-ppr(co_data[data_range[1]:data_range[2],-1],
           co_data[data_range[1]:data_range[2],1],nterms = length(in_data$variate))
  if(plotting){
    tmp_data = cbind(in_data$real[data_range[1]:data_range[2],],res$fitted.values)
    colnames(tmp_data)=c("Actual series","Fitted series")
    plot(x=c(1:nrow(tmp_data)),y=tmp_data[,1],type = "l",xlab="index",ylab="value",lwd=1)
    lines(x=c(1:nrow(tmp_data)),y=tmp_data[,2],type = "l",col=2,lwd=1)
    legend("topleft", colnames(tmp_data), col = c(1,2),
           lwd = c(1), bg = "grey95", box.col = NA,
           cex = 0.8, inset = c(0.02, 0.03), ncol = 1)
  }
  res<-list(real = in_data$real, ctqw = co_data[,-1], index = in_data$index,
            method = "PPR",model=res)
  res<-structure(res,class="QWMODEL")
  return(res)
}