version 0.1.0

DESCRIPTION

@@ -0,0 +1,16 @@
+Package: nardl
+Type: Package
+Title: Nonlinear Cointegrating Autoregressive Distributed Lag Model
+Version: 0.1.0
+Author: Taha Zaghdoudi
+Maintainer: Taha Zaghdoudi <zedtaha@gmail.com>
+Description: Computes the nonlinear cointegrating autoregressive distributed lag model with p lags of the dependent variables and q lags of independent variables proposed by (Shin, Yu & Greenwood-Nimmo, 2014 <doi:10.1007/978-1-4899-8008-3_9>).
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 5.0.1
+Imports: stats, methods, car
+NeedsCompilation: no
+Packaged: 2017-07-04 14:04:01 UTC; Asus
+Repository: CRAN
+Date/Publication: 2017-07-04 20:24:08 UTC

MD5

@@ -0,0 +1,11 @@
+101e2999e00ac625957f128ea1ec0e79 *DESCRIPTION
+9745ca564d5fa2a3f882aa1717263ca4 *NAMESPACE
+dee95d089104f6fe6908603eb92b3399 *R/boundstest.R
+c4bae9ddd6cdb8e30c1d0bc4645d97e3 *R/modsel.R
+0499c92d944a88c7488611c6dc535912 *R/nardl.R
+24ac6af7df6fc51a6d99fd56ae211f9e *data/fod.rda
+0e92051aae4edec892125fb1a107d934 *man/Nardl-package.Rd
+8f2959858f1eb6c82be0272d5a10dd50 *man/fod.Rd
+070ee5c94eceaeabd610e1e1e9601240 *man/nardl.Rd
+193a7f50349e20f8aa2a152c424de819 *man/nardl.formula.Rd
+8c1769e9c7572426e25e2e09ac27a271 *man/summary.nardl.Rd

NAMESPACE

@@ -0,0 +1,18 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(nardl,formula)
+S3method(summary,nardl)
+export(nardl)
+importFrom(car,linearHypothesis)
+importFrom(methods,is)
+importFrom(stats,as.formula)
+importFrom(stats,drop1)
+importFrom(stats,lm)
+importFrom(stats,model.frame)
+importFrom(stats,model.matrix)
+importFrom(stats,model.response)
+importFrom(stats,na.omit)
+importFrom(stats,pchisq)
+importFrom(stats,printCoefmat)
+importFrom(stats,pt)
+importFrom(stats,update)

R/boundstest.R

@@ -0,0 +1,120 @@
+bounds.test <- function(case,k,Fstat ){
+
+  #DEBUG <- TRUE
+  tables="pss"
+  append=FALSE
+  file=NULL
+
+  val <- NULL
+  val <- rbind(val,	c(2.44,3.28,3.15,4.11,3.88,4.92,4.81,6.02)	)
+  val <- rbind(val,	c(2.17,3.19,2.72,3.83,3.22,4.5,3.88,5.3)	)
+  val <- rbind(val,	c(2.01,3.1,2.45,3.63,2.87,4.16,3.42,4.84)	)
+  val <- rbind(val,	c(1.9,3.01,2.26,3.48,2.62,3.9,3.07,4.44)	)
+  val <- rbind(val,	c(1.81,2.93,2.14,3.34,2.44,3.71,2.82,4.21)	)
+  val <- rbind(val,	c(1.75,2.87,2.04,3.24,2.32,3.59,2.66,4.05)	)
+  val <- rbind(val,	c(1.7,2.83,1.97,3.18,2.22,3.49,2.54,3.91)	)
+  val <- rbind(val,	c(1.66,2.79,1.91,3.11,2.15,3.4,2.45,3.79)	)
+  val <- rbind(val,	c(1.63,2.75,1.86,3.05,2.08,3.33,2.34,3.68)	)
+  val <- rbind(val,	c(1.6,2.72,1.82,2.99,2.02,3.27,2.26,3.6)	)
+  case1 <- data.frame( k=1:10, value=matrix(val,nrow=10,ncol=8))
+  colnames(case1)=c("K","90.0","90.1","95.0","95.1","97.0","97.1","99.0","99.1")
+
+  val <- NULL
+  val <- rbind(val,	c(3.02,3.51,3.62,4.16,4.18,4.79,4.94,5.58)	)
+  val <- rbind(val,	c(2.63,3.35,3.1,3.87,3.55,4.38,4.13,5)	)
+  val <- rbind(val,	c(2.37,3.2,2.79,3.67,3.15,4.08,3.65,4.66)	)
+  val <- rbind(val,	c(2.2,3.09,2.56,3.49,2.88,3.87,3.29,4.37)	)
+  val <- rbind(val,	c(2.08,3,2.39,3.38,2.7,3.73,3.06,4.15)	)
+  val <- rbind(val,	c(1.99,2.94,2.27,3.28,2.55,3.61,2.88,3.99)	)
+  val <- rbind(val,	c(1.92,2.89,2.17,3.21,2.43,3.51,2.73,3.9)	)
+  val <- rbind(val,	c(1.85,2.85,2.11,3.15,2.33,3.42,2.62,3.77)	)
+  val <- rbind(val,	c(1.8,2.8,2.04,3.08,2.24,3.35,2.5,3.68)	)
+  val <- rbind(val,	c(1.76,2.77,1.98,3.04,2.18,3.28,2.41,3.61)	)
+  case2 <- data.frame( k=1:10, value=matrix(val,nrow=10,ncol=8))
+  colnames(case2)=c("K","90.0","90.1","95.0","95.1","97.0","97.1","99.0","99.1")
+
+  val <- NULL
+  val <- rbind(val,	c(4.04,4.78,4.94,5.73,5.77,6.68,6.84,7.84)	)
+  val <- rbind(val,	c(3.17,4.14,3.79,4.85,4.41,5.52,5.15,6.36)	)
+  val <- rbind(val,	c(2.72,3.77,3.23,4.35,3.69,4.89,4.29,5.61)	)
+  val <- rbind(val,	c(2.45,3.52,2.86,4.01,3.25,4.49,3.74,5.06)	)
+  val <- rbind(val,	c(2.26,3.35,2.62,3.79,2.96,4.18,3.41,4.68)	)
+  val <- rbind(val,	c(2.12,3.23,2.45,3.61,2.75,3.99,3.15,4.43)	)
+  val <- rbind(val,	c(2.03,3.13,2.32,3.5,2.6,3.84,2.96,4.26)	)
+  val <- rbind(val,	c(1.95,3.06,2.22,3.39,2.48,3.7,2.79,4.1)	)
+  val <- rbind(val,	c(1.88,2.99,2.14,3.3,2.37,3.6,2.65,3.97)	)
+  val <- rbind(val,	c(1.83,2.94,2.06,3.24,2.28,3.5,2.54,3.86)	)
+  case3 <- data.frame( k=1:10, value=matrix(val,nrow=10,ncol=8))
+  colnames(case3)=c("K","90.0","90.1","95.0","95.1","97.0","97.1","99.0","99.1")
+
+  val <- NULL
+  val <- rbind(val,	c(4.05,4.49,4.68,5.15,5.3,5.83,6.1,6.73)	)
+  val <- rbind(val,	c(3.38,4.02,3.88,4.61,4.37,5.16,4.99,5.85)	)
+  val <- rbind(val,	c(2.97,3.74,3.38,4.23,3.8,4.68,4.3,5.23)	)
+  val <- rbind(val,	c(2.68,3.53,3.05,3.97,3.4,4.36,3.81,4.92)	)
+  val <- rbind(val,	c(2.49,3.38,2.81,3.76,3.11,4.13,3.5,4.63)	)
+  val <- rbind(val,	c(2.33,3.25,2.63,3.62,2.9,3.94,3.27,4.39)	)
+  val <- rbind(val,	c(2.22,3.17,2.5,3.5,2.76,3.81,3.07,4.23)	)
+  val <- rbind(val,	c(2.13,3.09,2.38,3.41,2.62,3.7,2.93,4.06)	)
+  val <- rbind(val,	c(2.05,3.02,2.3,3.33,2.52,3.6,2.79,3.93)	)
+  val <- rbind(val,	c(1.98,2.97,2.21,3.25,2.42,3.52,2.68,3.84)	)
+  case4 <- data.frame( k=1:10, value=matrix(val,nrow=10,ncol=8))
+  colnames(case4)=c("K","90.0","90.1","95.0","95.1","97.0","97.1","99.0","99.1")
+
+  val <- NULL
+  val <- rbind(val,	c(5.59,6.26,6.56,7.3,7.46,8.27,8.74,9.63)	)
+  val <- rbind(val,	c(4.19,5.06,4.87,5.85,5.49,6.59,6.34,7.52)	)
+  val <- rbind(val,	c(3.47,4.45,4.01,5.07,4.52,5.62,5.17,6.36)	)
+  val <- rbind(val,	c(3.03,4.06,3.47,4.57,3.89,5.07,4.4,5.72)	)
+  val <- rbind(val,	c(2.75,3.79,3.12,4.25,3.47,4.67,3.93,5.23)	)
+  val <- rbind(val,	c(2.53,3.59,2.87,4,3.19,4.38,3.6,4.9)	)
+  val <- rbind(val,	c(2.38,3.45,2.69,3.83,2.98,4.16,3.34,4.63)	)
+  val <- rbind(val,	c(2.26,3.34,2.55,3.68,2.82,4.02,3.15,4.43)	)
+  val <- rbind(val,	c(2.16,3.24,2.43,3.56,2.67,3.87,2.97,4.24)	)
+  val <- rbind(val,	c(2.07,3.16,2.33,3.46,2.56,3.76,2.84,4.1)	)
+  case5 <- data.frame( k=1:10, value=matrix(val,nrow=10,ncol=8))
+  colnames(case5)=c("k","90.0","90.1","95.0","95.1","97.0","97.1","99.0","99.1")
+
+  ## -------------------------------------------------
+  # validate
+  match.arg( tables,c("pss") )  # c("pss","narayan")
+  if (tables=="pss")
+    table <- switch( case, case1, case2, case3, case4, case5 )
+  #else
+  #table <- switch( case, n_case1, n_case2, n_case3, n_case4, n_case5 )
+
+  #if (!inherits(obj,"ardl")) stop("Class of the argument must be ardl.")
+
+  #K <- length(obj$variableTerms)
+  if (k<1 || k>10) stop("Number of regressors must be between 1 and 10")
+
+  case_desc <- switch(case, "no intercept, no trend",
+                      "restricted intercert, no trend (not supported)",
+                      "unrestricted intercert, no trend",
+                      "unrestricted intercept, restricted trend (not supported)",
+                      "unrestricted intercept, unrestricted trend")
+
+
+  cat("\nBounds Test:\n")
+  #cat(deparse(formula(obj)),"\n")
+  cat("\nPSS case",case," (",case_desc,")")
+  cat("\nRegressors (K)",k," \n\n")
+
+  ## document the null hypothesis or NO LR relation
+  cat("d(y_t) = alpha + pi (y_t-1,x_t)' + phi (d(y_t),d(x_t))' + epsilon_t \n")
+  cat("Null hypothesis (H0): No long-run relation exist, ie H0:pi=0\n\n")
+
+  cat(sprintf("         I(0)   I(1)\n"))
+  cat(sprintf("  10%%   %3.2f  %3.2f\n", table[k,"90.0"],table[k,"90.1"] ))
+  cat(sprintf("   5%%   %3.2f  %3.2f\n", table[k,"95.0"],table[k,"95.1"] ))
+  cat(sprintf(" 2.5%%   %3.2f  %3.2f\n", table[k,"97.0"],table[k,"97.1"] ))
+  cat(sprintf("   1%%   %3.2f  %3.2f\n", table[k,"99.0"],table[k,"99.1"] ))
+  cat("\nF statistic ",Fstat,"\n\n")
+  diagn <- "Existence of a Long Term relation is"
+  if (Fstat>table[k,"95.1"])
+    cat(diagn,"not rejected at 5%")
+  if (Fstat<table[k,"95.0"])
+    cat(diagn,"rejected at 5% (even assumming all regressors I(0))")
+  if (Fstat<=table[k,"95.1"] && Fstat>=table[k,"95.0"])
+    cat(diagn,"rejected at 5% with I(1) regressors but not with I(0) regressors ")
+}

R/modsel.R

@@ -0,0 +1,105 @@
+
+has.interaction <- function(x,terms){
+  #####################################
+  # Automated model selection
+  # Author      : Joris Meys
+  # version     : 0.2
+  # date        : 12/01/09
+  #####################################
+  #CHANGE LOG
+  # 0.2   : check for empty scopevar vector
+  #####################################
+
+  # Function has.interaction checks whether x is part of a term in terms
+  # terms is a vector with names of terms from a model
+  out <- sapply(terms,function(i){
+    sum(1-(strsplit(x,":")[[1]] %in% strsplit(i,":")[[1]]))==0
+  })
+  return(sum(out)>0)
+}
+
+#'@importFrom stats as.formula drop1  na.omit
+#'@importFrom methods is
+model.select <- function(model,keep,sig=0.05,verbose=F){
+  # Function Model.select
+  # model is the lm object of the full model
+  # keep is a list of model terms to keep in the model at all times
+  # sig gives the significance for removal of a variable. Can be 0.1 too (see SPSS)
+  # verbose=T gives the F-tests, dropped var and resulting model after
+  counter=1
+  # check input
+  if(!is(model,"lm")) stop(paste(deparse(substitute(model)),"is not an lm object\n"))
+  # calculate scope for drop1 function
+  terms <- attr(model$terms,"term.labels")
+  if(missing(keep)){ # set scopevars to all terms
+    scopevars <- terms
+  } else{            # select the scopevars if keep is used
+    index <- match(keep,terms)
+    # check if all is specified correctly
+    if(sum(is.na(index))>0){
+      novar <- keep[is.na(index)]
+      warning(paste(
+        c(novar,"cannot be found in the model",
+          "\nThese terms are ignored in the model selection."),
+        collapse=" "))
+      index <- as.vector(na.omit(index))
+    }
+    scopevars <- terms[-index]
+  }
+
+  # Backward model selection :
+
+  while(T){
+    # extract the test statistics from drop.
+    test <- drop1(model, scope=scopevars,test="F")
+
+    if(verbose){
+      cat("-------------STEP ",counter,"-------------\n",
+          "The drop statistics : \n")
+      print(test)
+    }
+
+    pval <- test[,dim(test)[2]]
+
+    names(pval) <- rownames(test)
+    pval <- sort(pval,decreasing=T)
+
+    if(sum(is.na(pval))>0) stop(paste("Model",
+                                      deparse(substitute(model)),"is invalid. Check if all coefficients are estimated."))
+
+    # check if all significant
+    if(pval[1]<sig) break # stops the loop if all remaining vars are sign.
+
+    # select var to drop
+    i=1
+    while(T){
+      dropvar <- names(pval)[i]
+      check.terms <- terms[-match(dropvar,terms)]
+      x <- has.interaction(dropvar,check.terms)
+      if(x){i=i+1;next} else {break}
+    } # end while(T) drop var
+
+    if(pval[i]<sig) break # stops the loop if var to remove is significant
+
+    if(verbose){
+      cat("\n--------\nTerm dropped in step",counter,":",dropvar,"\n--------\n\n")
+    }
+
+    #update terms, scopevars and model
+    scopevars <- scopevars[-match(dropvar,scopevars)]
+    terms <- terms[-match(dropvar,terms)]
+
+    formul <- as.formula(paste(".~.-",dropvar))
+    model <- update(model,formul)
+
+    if(length(scopevars)==0) {
+      warning("All variables are thrown out of the model.\n",
+              "No model could be specified.")
+      return()
+    }
+    counter=counter+1
+  } # end while(T) main loop
+  return(model)
+
+  #list(model=model, fm=formul)
+}