version 1.0

DESCRIPTION

@@ -0,0 +1,15 @@
+Package: acrt
+Type: Package
+Title: Autocorrelation Robust Testing
+Version: 1.0
+Date: 2016-12-05
+Author: David Preinerstorfer 
+Maintainer: David Preinerstorfer <david.preinerstorfer@econ.au.dk>
+Description: Functions for testing affine hypotheses on the regression coefficient vector in regression models with autocorrelated errors. 
+License: GPL-2
+Imports: methods, stats, sandwich, Rcpp
+LinkingTo: Rcpp, RcppEigen
+NeedsCompilation: yes
+Packaged: 2016-12-17 11:59:28 UTC; au563869
+Repository: CRAN
+Date/Publication: 2016-12-18 11:22:53

MD5

@@ -0,0 +1,21 @@
+af6e6f368ba1ed3ac63a970738a43199 *DESCRIPTION
+cf1d089a97f33d691c86cd16709b1783 *NAMESPACE
+ee9d9d0abdf17de6b01f624497ee0f97 *R/F.type.test.statistic.R
+ec4bd6b4f0cb9d439130b7a43f434600 *R/auxiliaries.R
+edf3c8c283306974e63aa2be5bc7e1b3 *R/critical.value.R
+52f75a58780b7f07cfd8620873ce3692 *R/size.R
+043c94a6a7f4bb83d2dbd24a8d365dfb *R/zzz.R
+6d9df22999563b54a662a81df6b0ec4b *build/partial.rdb
+97a718f9c3c2049a65aaffbe84b7932f *inst/CITATION
+e3374aa1bcbae69a43d320db998c16cb *man/F.type.test.Rd
+57556a305886edc7f53ece9f22145da2 *man/acrt-package.Rd
+725672923bd545c49b29e3bf2fccc343 *man/critical.value.Rd
+ddcbfe5a50abe12196d00a56eb9ce2fa *man/size.Rd
+9a55ac66f95975a399406cc1b9cc667a *src/Makevars
+1560fdc47e0632efca2abf5423a61e75 *src/Makevars.win.txt
+b7cdb7bf2fc0a559cc9f69c28bb0d2e5 *src/RcppExports.cpp
+7be029c871d221be616c6eb9ee12d2b5 *src/all.cpp
+3b59ea6ceea0c42e68ca1850b081edb1 *src/csart.h
+16006da38f74325e415d9744589185b1 *src/premult.cpp
+f3c2b2b11642f614d26eab87c8aeceae *src/test.statistic.Eicker.cpp
+38582d8931b421a47955ace9292a0068 *src/test.statistic.cpp

NAMESPACE

@@ -0,0 +1,3 @@
+useDynLib(acrt)
+import(methods, stats, sandwich, Rcpp)
+export(F.type.test.statistic, critical.value, size)

R/F.type.test.statistic.R

@@ -0,0 +1,57 @@
+#               
+#    Copyright (C) 2016  David Preinerstorfer
+#    david.preinerstorfer@econ.au.dk
+#
+#    This file is a part of acrt.
+#
+#    acrt is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details. A copy may be obtained at
+#    http://www.r-project.org/Licenses/
+
+F.type.test.statistic <- function(y, R, r, X, bandwidth, ker, Eicker = FALSE, 
+                                  cores = 1){
+
+#transform y to a matrix in case it is a vector
+
+if(is.vector(y) == TRUE){
+y <- as.matrix(y, nrow = length(y))
+} 
+
+#input checks
+
+check.X.R.order(X, R, 0)
+check.y(y, X)
+check.r(r, R)
+check.bandwidth(bandwidth)
+check.ker(ker)
+check.Eicker(Eicker)
+check.cores(cores)
+
+#computation of input to c++ functions
+
+qrX <- qr(X)
+umat <- qr.resid(qrX, y) 
+Rbmat <- R %*% qr.coef(qrX, y) - matrix(r, byrow = F, nrow = dim(R)[1],
+                                                      ncol = dim(y)[2])
+Wmat <- wm(dim(X)[1], bandwidth, ker)
+Bmat <- Bfactor.matrix(qrX, R)
+
+#call c++ functions 
+
+if(Eicker){
+test.val <-
+.Call('acrt_ctestE', PACKAGE = 'acrt', umat, Rbmat, Wmat, Bmat, cores)
+} else {
+test.val <- 
+.Call('acrt_ctest', PACKAGE = 'acrt', umat, Rbmat, Wmat, Bmat, cores)
+}
+return(list("test.val" = test.val))
+}      
+

R/auxiliaries.R

@@ -0,0 +1,212 @@
+#               
+#    Copyright (C) 2016  David Preinerstorfer
+#    david.preinerstorfer@econ.au.dk
+#
+#    This file contains the internal auxiliary functions:
+#    Bfactor.matrix; gen.start; wm; and several functions for input checking
+#    
+#    This file is a part of acrt.
+#
+#    acrt is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details. A copy may be obtained at
+#    http://www.r-project.org/Licenses/
+
+#Compute the matrix R(X'X)^(-1)X' given the qr decomposition of a design matrix
+#(n times k with rank k) and a restriction matrix R (q times k)
+
+Bfactor.matrix <- function(qrX, R){
+factor.tmp <- qr.R(qrX)
+factor.tmp <- backsolve(factor.tmp, diag(dim(factor.tmp)[1]))
+Bfactor <- R %*% factor.tmp %*% t(qr.Q(qrX))
+return(Bfactor)
+}
+
+#Draw uniformly from the stationarity region of AR(ar.order) processes 
+#parameterized by its partial autocovariance function; 
+#Based on results in: MC Jones, Applied Statistics, 1987. 
+
+gen.start <- function(ar.order){
+v <- 1:ar.order
+s1 <- floor(.5 * (v + 1))
+s2 <- floor(.5 * v) + 1
+s.val <- c()
+for(i in 1:ar.order){
+s.val <- c(s.val, rbeta(1, s1[i], s2[i]))
+}
+return(2*s.val - 1)
+}
+
+#Generate an n x n dimensional weights matrix from a kernel function
+#and a bandwidth parameter using the kweights function from the sandwich package
+#by A. Zeileis (Achim Zeileis (2004). Econometric Computing with HC and HAC 
+#Covariance Matrix Estimators. Journal of Statistical Software 11(10), 1-17.)
+
+wm <- function(n, bandwidth, ker = "Bartlett"){
+toeplitz(sandwich::kweights(0:(n-1)/bandwidth, ker))
+}
+
+#input checks
+
+check.alpha <- function(alpha){
+if( !is.numeric(alpha) | alpha <= 0 | alpha >= 1 ) {
+ stop("Invalid 'alpha' value - 'alpha' must be in the interval (0,1)")
+}
+}
+
+check.bandwidth <- function(bandwidth){
+if( !is.numeric(bandwidth) | bandwidth <= 0) {
+ stop("Invalid 'bandwidth' value - 'bandwidth' must be a real number > 0")
+}
+}
+
+check.Eicker <- function(Eicker){
+if( !is.logical(Eicker) ) {
+ stop("Invalid 'Eicker' value - must be logical")
+}
+}
+
+check.X.R.order <- function(X, R, ar.order.max){
+
+if( !is.matrix(X) ){
+ stop("Invalid 'X' value - must be a matrix")
+}
+
+if( !is.matrix(R) ) {
+ stop("Invalid 'R' value - must be a matrix")
+}
+
+if( dim(X)[2] >= dim(X)[1] ){
+ stop("Number of columns of 'X' is not smaller than its number of rows")
+}
+
+if( dim(X)[2] == 0 ){
+ stop("Number of rows of 'X' must be greater than 0")
+}
+
+if( dim(X)[2] != dim(R)[2] ) {
+ stop("Matrices 'X' and 'R' have different number of columns")
+}
+
+if( qr(X)$rank < dim(X)[2] ) {
+ stop("The matrix 'X' is numerically of rank < k")
+}
+
+if( qr(R)$rank < dim(R)[1] ) {
+ stop("The matrix 'R' is numerically of rank < q")
+}
+
+if( ar.order.max%%1 != 0 | ar.order.max < 0 ){
+ stop("Invalid 'ar.order.max' value - 'ar.order.max' must be an integer >= 0")
+}
+
+}
+
+check.N.M <- function(N0, N1, N2, Mp, M1, M2){
+
+if( N0%%1 != 0 | N0 < 0 ){
+ stop("Invalid 'N0' value - 'N0' must be a positive integer")
+}
+
+if( N1%%1 != 0 | N1 < 0 ){
+ stop("Invalid 'N1' value - 'N1' must be a positive integer")
+}
+
+if( N2%%1 != 0 | N2 < 0 ){
+ stop("Invalid 'N2' value - 'N2' must be a positive integer")
+}
+
+if( Mp%%1 != 0 | Mp < 0 ){
+ stop("Invalid 'Mp' value - 'Mp' must be a positive integer")
+}
+
+if( M1%%1 != 0 | M1 < 0 ){
+ stop("Invalid 'M1' value - 'M1' must be a positive integer")
+}
+
+if( M2%%1 != 0 | M2 < 0 ){
+ stop("Invalid 'M2' value - 'M2' must be a positive integer")
+}
+
+if( N0 > N1 ) {
+ warning("'N1' should be greater than 'N0'")
+}
+
+if( N1 > N2 ) {
+ warning("'N2' should be greater than 'N1'")
+}
+
+if( M1 > Mp ) {
+ stop("Invalid 'M1' value - 'M1' can not be greater than 'Mp'")
+}
+
+if( M2 > M1 ) {
+ stop("Invalid 'M2' value - 'M2' can not be greater than 'M1'")
+}
+
+}
+
+check.cores <- function(cores){
+if( cores%%1 != 0 | cores <= 0) {
+ stop("Invalid 'cores' value - 'cores' must be a positive integer")
+} 
+}
+
+check.margin <- function(margin, ar.order.max){
+if( !is.vector(margin) | length(margin) != ar.order.max |  min(margin) <= 0 | 
+max(margin) > 1 ) {
+ stop("Invalid 'margin' value - 'margin' must be a vector of the same length as
+ 'ar.order.max' and with coordinates greater than 0 and not exceeding 1")
+} 
+}
+
+check.C <- function(C){
+if( !is.numeric(C) | length(C)!=1 | C <= 0) {
+ stop("Invalid 'C' value - 'C' must be a positive real number")
+}
+}
+
+check.y <- function(y, X){
+if( !is.numeric(y) | !is.matrix(y) | dim(y)[2] == 0 | dim(y)[1] != dim(X)[1]){
+ stop("Invalid 'y' value - 'y' must either be a real vector of length 
+ dim(X)[1], or a real matrix with dim(X)[1] rows with more than 0 columns")
+}
+}
+
+check.r <- function(r, R){
+if( !is.vector(r) | !is.numeric(r)){
+ stop("Invalid 'r' value - 'r' must be a real vector") 
+}
+
+if( length(r) != dim(R)[1] ){
+ stop("Invalid 'r' dimension - the length of 'r' must coincide with the 
+ number of rows of the matrix 'R'") 
+}
+
+}
+
+check.ker <- function(ker){
+if( !(ker %in% c("Bartlett", "Parzen", "Quadratic Spectral")) ){
+ stop("Invalid 'ker' value - 'ker' must be one of the following kernels:
+ 'Bartlett', 'Parzen', 'Quadratic Spectral'") 
+} 
+}
+
+check.method <- function(opt.method.1, opt.method.2){
+if( !(opt.method.1 %in% c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN")) ){
+ stop("Invalid optimization method in Stage 1 - opt.method.1 must be one of
+ the following methods: 'Nelder-Mead', 'BFGS', 'CG, 'L-BFGS_B', 'SANN'.")
+}
+
+if( !opt.method.2 %in% c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN") ){
+ stop("Invalid optimization method in Stage 2 - opt.method.2 must be one of
+ the following methods: 'Nelder-Mead', 'BFGS', 'CG, 'L-BFGS_B', 'SANN'.")
+}
+
+}