Add context manager

Context manager is added to code to prevent design() from exiting due to division warning that should be ignored.

Author: mingdeyu

R/update.R

@@ -108,9 +108,9 @@ update.dgp <- function(object, X, Y, refit = FALSE, reset = FALSE, verb = TRUE,
     }
     N0 <- constructor_obj_cp$N
     if ( identical(cores,as.integer(1)) ){
-      constructor_obj_cp$train(N, ess_burn, disable)
+      with(pkg.env$np$errstate(divide = 'ignore'), constructor_obj_cp$train(N, ess_burn, disable))
     } else {
-      constructor_obj_cp$ptrain(N, ess_burn, disable, cores)
+      with(pkg.env$np$errstate(divide = 'ignore'), constructor_obj_cp$ptrain(N, ess_burn, disable, cores))
     }
     burnin <- as.integer(N0 + 0.75*N)
   } else {
@@ -185,7 +185,7 @@ update.gp <- function(object, X, Y, refit = FALSE, reset = FALSE, verb = TRUE, .
 
   if ( refit ){
     if ( verb ) message("Re-fitting ...", appendLF = FALSE)
-    constructor_obj_cp$train()
+    with(pkg.env$np$errstate(divide = 'ignore'), constructor_obj_cp$train())
     if ( verb ) message(" done")
   }
 

R/utils.R

@@ -945,7 +945,7 @@ crop <- function(object, crop_id_list, refit_cores, verb) {
             struc$para_path <- matrix(c(struc$scale, struc$length, struc$nugget), nrow = 1, byrow=T)
           }
           obj <- pkg.env$dgpsi$gp(X, Y, struc)
-          obj$train()
+          with(pkg.env$np$errstate(divide = 'ignore'), obj$train())
           res <- list()
           res[['id']] <- object$id
           res[['data']][['X']] <- X
@@ -979,7 +979,7 @@ crop <- function(object, crop_id_list, refit_cores, verb) {
               struc$para_path <- matrix(c(struc$scale, struc$length, struc$nugget), nrow = 1, byrow = T)
             }
             obj <- pkg.env$dgpsi$gp(X, Y[,j,drop=F], struc)
-            obj$train()
+            with(pkg.env$np$errstate(divide = 'ignore'), obj$train())
             res_j <- list()
             res_j[['id']] <- uuid::UUIDgenerate()
             res_j[['data']][['X']] <- X
@@ -1020,9 +1020,9 @@ crop <- function(object, crop_id_list, refit_cores, verb) {
         object$constructor_obj$update_all_layer(all_layer)
         if ( verb ) message(" - Re-fitting ...", appendLF = FALSE)
         if ( identical(refit_cores, as.integer(1)) ){
-          object$constructor_obj$train(as.integer(100), as.integer(10), TRUE)
+          with(pkg.env$np$errstate(divide = 'ignore'), object$constructor_obj$train(as.integer(100), as.integer(10), TRUE))
         } else {
-          object$constructor_obj$ptrain(as.integer(100), as.integer(10), TRUE, refit_cores)
+          with(pkg.env$np$errstate(divide = 'ignore'), object$constructor_obj$ptrain(as.integer(100), as.integer(10), TRUE, refit_cores))
         }
         est_obj <- object$constructor_obj$estimate()
         internal_dims <- object[['specs']][['internal_dims']]
@@ -1058,9 +1058,9 @@ crop <- function(object, crop_id_list, refit_cores, verb) {
   object$constructor_obj$update_all_layer(all_layer)
   if ( verb ) message(" - Re-fitting ...", appendLF = FALSE)
   if ( identical(refit_cores, as.integer(1)) ){
-    object$constructor_obj$train(as.integer(100), as.integer(10), TRUE)
+    with(pkg.env$np$errstate(divide = 'ignore'), object$constructor_obj$train(as.integer(100), as.integer(10), TRUE))
   } else {
-    object$constructor_obj$ptrain(as.integer(100), as.integer(10), TRUE, refit_cores)
+    with(pkg.env$np$errstate(divide = 'ignore'), object$constructor_obj$ptrain(as.integer(100), as.integer(10), TRUE, refit_cores))
   }
   est_obj <- object$constructor_obj$estimate()
   internal_dims <- object[['specs']][['internal_dims']]