debugging

NEWS.md

@@ -2,7 +2,7 @@
 
 * Added  the `disc_unif`, `mix_bin` and `mix_bin_negbin` arrival options into the `genINAR`function. Solving minor bugs.
 
-* Applying some modifications to the `SMC_Cpp`function for the Generalized Poisson case. In particular, I am trying to figure out how to deal with some limit cases in which the test statistic is not defined, that is when $p_{x{t}-1}$ and/or $p_{x{t}}$ are zero.
+* General debugging and modifications only for the Generalized Poisson case in `SMC_Cpp` function: In particular, I am trying to figure out how to deal with some limit cases in which the test statistic is not defined, that is when $p_{x{t}-1}$ and/or $p_{x{t}}$ are zero.
 
 * [testing] Playing with some solutions for parallel computing in the C++ code.
 

R/INARtest.R

@@ -49,4 +49,66 @@ INARtest <- function(X, type, B = 0){
     return(OUT)
 }
 
+#' Perform Sun-McCabe INAR tests
+#'
+#' @param X vector, thinning parameters. The lenght of this vector defines the number of lags `p` of the INAR(p) process.
+#' @param method character, the distribution to be used in the test. The options are "poi", "negbin" and "genpoi".
+#' @param type character, the type of test to be performed, the alternatives are "parametric or "semiparametric".
+#' @param B integer, the number of bootstrap samples to be generated. The default value is 0, corresponding to no bootstrap samples.
+#' @return A number.
+#'
+#' @details
+#' The function performs the Sun-McCabe (SMC) tests for the INAR(1) model.
+#' It is possible to run an exact (B = 0) or a bootstrap (B > 0) test.
+#' SMC tests are based on Poisson, negative binomial and generalized Poisson
+#' distributions, in all the considered cases, both parametric and semiparametric
+#' methods are available.
+#' It is possible to perform the tests using the original data (B=0) or using
+#' bootstrap samples (B > 0).
+#' @examples
+#' # ....... examples .....
+#' # SMCtest(X = rpois(100,2), type = "semiparametric", B = 0)
+#'
+#' @export
+SMCtest <- function(X, method, type = NA, B = 0){
+    type <- tolower(type)
+    stopifnot(type %in% c("parametric","semiparametric"))
+    stopifnot(method %in% c("poi","negbin","genpoi"))
+
+    B_stat <- NA
+    B_pval <- NA
+
+    # perform exact test
+    smc_est <- SMC_Cpp(X, method)
+    stat <- smc_est$stat
+    pval <- smc_est$pval
+
+    if(B > 0){
+        # perform bootstrap test
+        if(type == "parametric"){
+            # call smc.test
+            smc_boot <- SMC_parBOOT_Cpp(X, method, B)
+        }else if(type == "semiparametric"){
+            # call smc.test
+            smc_boot <- SMC_semiparBOOT_Cpp(X, method, B)
+        }else{
+            stop("Specify a correct test type")
+        }
+        B_stat <- mean(smc_boot)
+        B_pval <- mean(abs(smc_boot) > abs(stat), na.rm = TRUE) # imbroglio, uso: na.rm = TRUE
+    }
+
+    OUT <- list(
+        stat = stat,
+        pval = pval,
+        B_stat = B_stat,
+        B_pval = B_pval
+        )
+
+    # TO DO:
+    # configure OUT to have a nice output in the style of a summary of a test
+
+    return(OUT)
+}
+
 

R/RcppExports.R

@@ -64,7 +64,7 @@ SMC_pitBOOT_Cpp <- function(x, B, method) {
     .Call('_INAr_SMC_pitBOOT_Cpp', PACKAGE = 'INAr', x, B, method)
 }
 
-#' Wrapper function for compution the Sun-McCabe bootstrap score test.
+#' Wrapper function for computing the Sun-McCabe bootstrap score test.
 #' @param X NumericVector
 #' @param arrival int
 #' @param type unsigned int

src/INARboot.cpp

@@ -98,7 +98,7 @@ NumericVector RHO_BOOT_Cpp(NumericVector x, int B){
 //' This is an internal function, it will be excluded in future versions.
 //' @export
 // [[Rcpp::export]]
-NumericVector SMC_Cpp(NumericVector x, unsigned int method){
+List SMC_Cpp(NumericVector x, unsigned int method){
   int n = x.length();
 
   NumericVector out(2);
@@ -133,9 +133,13 @@ NumericVector SMC_Cpp(NumericVector x, unsigned int method){
 
     // check underdispersion
     if(var_x <= mu_x){
-        out[0] = NAN;
-        out[1] = NAN;
-        return out;
+        // out[0] = NAN;
+        // out[1] = NAN;
+        // return out;
+        return List::create(
+            _["stat"]  = NAN,
+            _["pval"]  = NAN
+        );
     }
     // printf("1) %f, %f %f \n",mu_x,var_x,std::abs(var_x-mu_x));
     // printf("2) %f, %f \n",pow(mu_x,2),var_x-mu_x);
@@ -243,7 +247,12 @@ NumericVector SMC_Cpp(NumericVector x, unsigned int method){
     out[0] = stat/sqrt(n);
     out[1] = 1 - R::pnorm(out[0],0.0, 1.0, 1, 0);
   }
-  return out;
+
+  // return out;
+  return List::create(
+      _["stat"]  = out[0],
+      _["pval"]  = out[1]
+  );
 }
 
 

src/RcppExports.cpp

@@ -35,7 +35,7 @@ BEGIN_RCPP
 END_RCPP
 }
 // SMC_Cpp
-NumericVector SMC_Cpp(NumericVector x, unsigned int method);
+List SMC_Cpp(NumericVector x, unsigned int method);
 RcppExport SEXP _INAr_SMC_Cpp(SEXP xSEXP, SEXP methodSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;