Define function outside and treat NULL case

R/createBindingConstraint.R

@@ -786,17 +786,9 @@ createBindingConstraintBulk <- function(constraints,
 
   # check matrix number of columns by group
   # In all_dim_group, group is column V1, number of columns is column V2
-  all_dim_group <- do.call("rbind", 
-                           c(lapply(constraints, function(x){
-                               operator_symbol <- switch_to_list_name_operator_870(operator = x[["operator"]])
-                               dim_matrix <- lapply(x[["values"]][which(names(x[["values"]]) %in% operator_symbol)], dim)
-                               data.table(rep(x[["group"]], length(dim_matrix)), sapply(dim_matrix, "[[", 2))
-                               }
-                            ), 
-                             fill = TRUE
-    )
-  )
-
+  matrix_dimension_by_constraint <- lapply(constraints, FUN = .compute_matrix_dimension_constraint)
+  all_dim_group <- do.call("rbind", c(matrix_dimension_by_constraint, fill = TRUE))
+
   # If each matrix is NULL, there is no second dimension in the table
   if (dim(all_dim_group)[2] < 2) {
     return()
@@ -851,3 +843,22 @@ switch_to_list_name_operator_870 <- function(operator) {
 
   return(operator_symbol)
 }
+
+# Compute the dimension of a matrix (if operatior is not "both") or 2 (if operatior is "both") in a constraint
+.compute_matrix_dimension_constraint <- function(constraint){
+
+  assertthat::assert_that(inherits(constraint, "list"))
+  assertthat::assert_that(all(c("group", "operator", "values") %in% names(constraint)))
+
+  res <- data.table()
+
+  operator_symbol <- switch_to_list_name_operator_870(operator = constraint[["operator"]])
+  dim_matrix <- lapply(constraint[["values"]][which(names(constraint[["values"]]) %in% operator_symbol)], dim)
+  dim_matrix <- dim_matrix[!sapply(dim_matrix, is.null)]
+  nb_matrix <- length(dim_matrix)
+  if (nb_matrix > 0) {
+    res <- data.table(rep(constraint[["group"]], nb_matrix), sapply(dim_matrix, "[[", 2))
+  }
+
+  return(res)
+}

tests/testthat/test-createBindingConstraint.R

@@ -902,6 +902,43 @@ test_that("Control of matrix dimension is not dependent of the order in the list
     createBindingConstraintBulk(constraints = lst_cstr, opts = simOptions()), 
     regexp = "Problem dimension with group"
   )
+
+  val_cstr1 <- list("gt" = NULL,
+                    "lt" = matrix(data = rep(555, 8760 * 3), ncol = 3),
+                    "eq" = matrix(data = rep(0, 8760 * 1), ncol = 1)
+                    )
+  val_cstr2 <- list("lt" = matrix(data = rep(0, 8760 * 1), ncol = 1),
+                    "eq" = matrix(data = rep(0, 8760 * 1), ncol = 1),
+                    "gt" = matrix(data = rep(777, 8760 * 5), ncol = 5)
+                    )
+  lst_cstr <- list(
+    list(
+      name = "cstr1", 
+      id = "cstr1",
+      values = val_cstr1, 
+      enabled = TRUE, 
+      timeStep = "hourly",
+      operator = "both",
+      coefficients = list("at%fr" = 1),
+      group= "group_bulk_123",
+      overwrite = TRUE
+      ),
+    list(
+      name = "cstr2", 
+      id = "cstr2",
+      values = val_cstr2, 
+      enabled = TRUE, 
+      timeStep = "hourly",
+      operator = "greater",
+      coefficients = list("at%fr" = 1),
+      group= "group_bulk_123",
+      overwrite = TRUE
+      )
+  )
+  expect_error(
+    createBindingConstraintBulk(constraints = lst_cstr, opts = simOptions()), 
+    regexp = "Problem dimension with group"
+  )
 
 })