Merge pull request #39 from pedersen-fisheries-lab/fitting-tests

Fitting tests

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: sspm
 Type: Package
 Title: Spatial Surplus Production Model Framework for Northern Shrimp Populations
-Version: 0.7.2
+Version: 0.7.3
 Authors@R: c(
     person("Valentin", "Lucet", email = "valentin.lucet@gmail.com", role = c("aut", "cre")),
     person("Eric", "Pedersen", email = "eric.pedersen@concordia.ca", role = c("aut")))

R/smooths.R

@@ -242,16 +242,35 @@ ICAR <- function(data_frame, boundaries, time, dimension,
 
     if (is.null(bs)) {
 
-      # If no bs specified, go with re, no penalty needed
+      # If no bs specified, go with re
       bs <- "re"
 
-      xt_list <- NULL
+    }
 
-    } else if (bs == "re"){
+    if (bs == "re"){
 
-      xt_list <- NULL
+      if (is.null(xt)) {
+
+        xt_list <- NULL
+
+      } else {
+
+        checkmate::assert_list(xt)
+
+        if (is.null(xt$penalty)) {
+          pen_mat_time <- ICAR_time(time_levels)
+        } else {
+          checkmate::assert_matrix(xt$penalty)
+          pen_mat_time <- xt
+        }
+
+        pen_expression <- rlang::expr(pen_mat_time)
+        vars$pen_mat_time <- pen_mat_time
+        xt_list <- list(xt = list(penalty = pen_expression))
+
+      }
 
-    } else if (bs == "mrf"){ # If mrf specified, provide the matrix
+    } else if (bs == "mrf"){
 
       if (is.null(xt)) {
 
@@ -267,6 +286,7 @@ ICAR <- function(data_frame, boundaries, time, dimension,
           checkmate::assert_matrix(xt$penalty)
           pen_mat_time <- xt
         }
+
       }
 
       # Create symbol and assign to list
@@ -330,7 +350,11 @@ ICAR <- function(data_frame, boundaries, time, dimension,
 
       xt_list <- NULL
 
-    } else if (identical(bs, c("mrf", "mrf"))){ # If mrf specified, provide the matrix
+    } else if (identical(bs, c("mrf", "mrf")) |
+               identical(bs, c(NULL, "mrf")) |
+               identical(bs, c("re", "mrf"))){ # If mrf specified, provide the matrix
+
+      if (identical(bs, c(NULL, "mrf"))) bs <- c("re", "mrf")
 
       if (is.null(xt)) {
 
@@ -370,33 +394,33 @@ ICAR <- function(data_frame, boundaries, time, dimension,
 
     }
 
-    if (is.null(xt)) {
-
-      pen_mat_space <- ICAR_space(patches, space)
-
-      vars$pen_mat_space <- pen_mat_space
-
-    } else {
-
-      # Must be a list of list with correct names
-      checkmate::assert_list(xt)
-      lapply(xt, checkmate::assert_list)
-      checkmate::assert_names(names(xt),
-                              subset.of = c(time, space))
-
-      if (is.null(xt[[space]]$penalty)) {
-        vars$pen_mat_space <- ICAR_space(patches, space)
-      } else {
-        checkmate::assert_matrix(xt[[space]]$penalty)
-        vars$pen_mat_space <- xt[[space]]$penalty
-      }
-
-    }
+    # if (is.null(xt)) {
+    #
+    #   pen_mat_space <- ICAR_space(patches, space)
+    #
+    #   vars$pen_mat_space <- pen_mat_space
+    #
+    # } else {
+    #
+    #   # Must be a list of list with correct names
+    #   checkmate::assert_list(xt)
+    #   lapply(xt, checkmate::assert_list)
+    #   checkmate::assert_names(names(xt),
+    #                           subset.of = c(time, space))
+    #
+    #   if (is.null(xt[[space]]$penalty)) {
+    #     vars$pen_mat_space <- ICAR_space(patches, space)
+    #   } else {
+    #     checkmate::assert_matrix(xt[[space]]$penalty)
+    #     vars$pen_mat_space <- xt[[space]]$penalty
+    #   }
+    #
+    # }
 
     # Create symbol and assign to list
-    pen_expression <- rlang::expr(pen_mat_space)
-    vars$pen_mat_space <- pen_mat_space
-    xt_list <- list(xt = list(penalty = pen_expression))
+    # pen_expression <- rlang::expr(pen_mat_space)
+    # vars$pen_mat_space <- pen_mat_space
+    # xt_list <- list(xt = list(penalty = pen_expression))
 
   }
 

README.Rmd

@@ -133,12 +133,16 @@ spm_points(bounds_voronoi)
 
 ```{r}
 biomass_smooth <- biomass_dataset %>%  
-  spm_smooth(weight_per_km2 ~ sfa + smooth_time(by=sfa) + smooth_space() + 
-               smooth_space_time(k = c(NA, 30)),
+  spm_smooth(weight_per_km2 ~ sfa + smooth_time(by=sfa, xt = list()) + 
+               smooth_space() + 
+               smooth_space_time(bs = c(NULL, "mrf"), 
+                                 k = c(NA, 30)),
              boundaries = bounds_voronoi, 
              family=tw) %>% 
-  spm_smooth(temp_at_bottom ~ smooth_time(by=sfa) + smooth_space() +
-               smooth_space_time(k = c(NA, 30)),
+  spm_smooth(temp_at_bottom ~ smooth_time(by=sfa, xt = list()) + 
+               smooth_space() +
+               smooth_space_time(bs = c(NULL, "mrf"),
+                                 k = c(NA, 30)),
              family=gaussian)
 
 biomass_smooth
@@ -147,7 +151,7 @@ biomass_smooth
 8. The smoothed results for any smoothed variables (listed in "smoothed vars" above) can be easily plotted:
 
 ```{r}
-plot(biomass_smooth, var = "weight_per_km2", log = FALSE, aggregate = T)
+plot(biomass_smooth, var = "weight_per_km2", log = FALSE)
 ```
 You can also make a spatial plot
 
@@ -159,7 +163,7 @@ plot(biomass_smooth, var = "weight_per_km2", use_sf = TRUE)
 
 ```{r}
 predator_smooth <- predator_dataset %>%  
-  spm_smooth(weight_per_km2 ~ smooth_time(k = 3) + smooth_space(),
+  spm_smooth(weight_per_km2 ~ smooth_time() + smooth_space(),
              boundaries = bounds_voronoi,
              drop.unused.levels = F, family=tw, method= "fREML")
 

tests/testthat/test-discretize.R

@@ -25,11 +25,11 @@ test_that("Discretization work as expected", {
   expect_names(names(spm_patches(discretized)),
                must.include = c("sfa", "patch_id", "patch_area"))
 
-  expect_equal(dim(spm_patches(discretized))[1], 35)
+  expect_equal(dim(spm_patches(discretized))[1], 92)
   expect_equal(dim(spm_patches(discretized))[2], 4)
 
   expect_equal(dim(spm_points(discretized))[1], 120)
-  expect_equal(dim(spm_points(discretized))[2], 11)
+  expect_equal(dim(spm_points(discretized))[2], 10)
 
   # ----------------------------------------------------------------------