Merge pull request #17 from inbo/fix

Fix

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: n2kanalysis
 Title: Generic Functions to Analyse Data from the Natura 2000 Monitoring
-Version: 0.2.4.2
-Date: 2017-12-03
+Version: 0.2.4.3
+Date: 2018-01-17
 Authors@R: c(person("Thierry", "Onkelinx", email = "[email protected]", role = c("aut", "cre")))
 Description: All generic functions for the analysis. The full analysis is
     defined in the analysis package of each monitoring scheme.
@@ -18,7 +18,7 @@ Suggests:
 Imports:
     assertthat,
     aws.s3,
-    digest (>= 0.6.12),
+    digest (>= 0.6.14),
     dplyr,
     INLA,
     lme4,

R/fit_model_n2kAggregate.R

@@ -16,7 +16,7 @@ setMethod(
     }
 
     # status: "waiting"
-    if (status(x) == "waiting") {
+    if (status(x) == "waiting" | is.null(x@RawImputed)) {
       parent <- get_parents(x, base = dots$base, project = dots$project)
       if (length(parent) == 0) {
         stop("Parent analysis not found")

R/fit_model_n2kInlaNbinomial.R

@@ -48,19 +48,28 @@ setMethod(
         }
       }
     }
-    model <- try(
+    model <- try({
+      if (!is.null(dots$timeout)) {
+        setTimeLimit(cpu = dots$timeout, elapsed = dots$timeout)
+      }
       INLA::inla(
         formula = model.formula,
         family = "nbinomial",
         data = data,
         lincomb = lc,
-        control.compute = list(dic = TRUE, waic = TRUE, cpo = TRUE),
+        control.compute = list(
+          dic = TRUE, waic = TRUE, cpo = TRUE, config = TRUE
+        ),
         control.predictor = list(compute = TRUE, link = link),
         control.fixed = list(prec.intercept = 1)
       )
-    )
-    if ("try-error" %in% class(model)) {
-      status(x) <- "error"
+    })
+    if (inherits(model, "try-error")) {
+      if (grepl("reached .* time limit", model)) {
+        status(x) <- "time-out"
+      } else {
+        status(x) <- "error"
+      }
       return(x)
     }
     if (x@ImputationSize == 0) {

R/fit_model_n2kModelImputed.R

@@ -16,7 +16,7 @@ setMethod(
     }
 
     # status: "waiting"
-    if (status(x) == "waiting") {
+    if (status(x) == "waiting" | is.null(x@AggregatedImputed)) {
       parent <- get_parents(x, base = dots$base, project = dots$project)
       if (length(parent) == 0) {
         stop("Parent analysis not found")

R/n2kAnalysisMetadata_class.R

@@ -147,7 +147,7 @@ outside imported range."
 
     ok.status <- c(
       "new", "working", "waiting", "error", "converged", "false_convergence",
-      "unstable", "insufficient_data"
+      "unstable", "insufficient_data", "time-out"
     )
     if (!all(object@AnalysisMetadata$Status %in% ok.status)) {
       stop(

tests/testthat/helper_test_data.R

@@ -5,10 +5,10 @@
 #' @importFrom dplyr %>% mutate_ n row_number
 #' @importFrom stats model.matrix rnbinom rnorm runif
 test_data <- function(datasource.id = sha1(letters), missing = 0){
-  assert_that(is.string(datasource.id))
-  assert_that(is.number(missing))
-  assert_that(missing >= 0)
-  assert_that(missing <= 1)
+  assertthat::assert_that(assertthat::is.string(datasource.id))
+  assertthat::assert_that(assertthat::is.number(missing))
+  assertthat::assert_that(missing >= 0)
+  assertthat::assert_that(missing <= 1)
 
   set.seed(999)
   n.e <- 10
@@ -43,7 +43,7 @@ test_data <- function(datasource.id = sha1(letters), missing = 0){
     as.vector()
   eta <- mm.fixed %*% fixed + mm.random %*% random #nolint
   dataset <- dataset %>%
-    mutate_(
+    dplyr::mutate_(
       Count = ~ifelse(
         rbinom(n(), size = 1, prob = missing) == 1,
         NA,

tests/testthat/test_caa_fit_model.R

@@ -200,6 +200,8 @@ describe("fit_model() on INLA nbinomial based objects", {
     imputation.size = 10,
     data = dataset
   )
+  timeout <- fit_model(object, timeout = 0.1)
+  expect_identical(status(timeout), "time-out")
   object.fit <- fit_model(object)
   object.lc.fit <- fit_model(object.lc)
   object.lc.list.fit <- fit_model(object.lc.list)