Badge update

R/input_fun.R

@@ -4,19 +4,26 @@
 #' @return A matrix of imports
 #' @param x the input matrix
 input_fun <- function(x) {
-  input.vector <-
-    as.vector(colSums(x[c(grep(
-      rownames(x),
-      pattern = "Import|CO2",
+
+  col.j <-
+    grep(
+      colnames(x),
+      pattern = "Input|Import|Export|CO2",
       value = TRUE,
-      invert = FALSE
-    )), c(
-      grep(
-        colnames(x),
-        pattern = "Import|Export|CO2",
-        value = TRUE,
-        invert = TRUE,
-        ignore.case = TRUE
-      )
-    )], na.rm = FALSE))
+      invert = FALSE,
+      ignore.case = TRUE
+    )
+
+  # Make data.frame in case R drop a rowname somewhere
+  x <- as.data.frame(x)
+  # Subset input compartments from row.i (Imports + CO2 for primary producer GPP)
+  input.vec <- x[rownames(x) %in% c("*Import*", "CO2"), ]
+
+  # Subset all internal compartments from col.j
+  input.vec <- input.vec[, !colnames(input.vec) %in% col.j]
+
+  # Sum all inputs (in case of multiple rows)
+  input.vec <- as.vector(colSums(input.vec, na.rm = FALSE))
+
+return(input.vec)
 }

R/matrix_def.R

@@ -13,13 +13,14 @@ matrix_def <- function(x, mat.type) {
       mat[rowSums(is.na(mat)) != ncol(mat), ] # Drop rows where all are NA
 
     if (length(match) == 1) {
-      mat <- mat[!mat[, 1] %in% c(0, "0", NA), , drop = FALSE]
+      mat2 <- mat[!mat[, 1] %in% c(0, "0", NA), , drop = FALSE]
     }
 
     if (length(match) == 2) {
-      mat <- mat[!mat[, 1] %in% c(0, "0", NA) |
+      mat2 <- mat[!mat[, 1] %in% c(0, "0", NA) |
         !mat[, 2] %in% c(0, "0", NA), , drop = FALSE]
     }
     return(mat)
   }
 }
+

R/net_data_external_list.R

@@ -8,16 +8,23 @@ net_data_external_list <- function(x, respiration,
                                    respiration_element) {
   # Define all with Imports
   import.mat <- matrix_def(x, mat.type = "Import")
-  im <- rownames(import.mat)
+  if(nrow(import.mat) > 0) {
+    im <- rownames(import.mat)
+    imports <- paste0(im, "Import")
+  } else {
+    imports <- as.vector(paste0(""))
+  }
 
-  # Define all with exports
+  # Define all compartments with exports
   ex.mat <- matrix_def(x, mat.type = "Export")
-  ex <- rownames(ex.mat)
-
-  exports <- paste0(ex, "Export")
-  imports <- paste0(im, "Import")
-
+  if(nrow(ex.mat) > 0) {
+    ex <- rownames(ex.mat)
+    exports <- paste0(ex, "Export")
+  } else {
+    exports <- as.vector(paste0(""))
+  }
 
+ # Define Respiration compartment (CO2) if required
   if (respiration == TRUE) {
     if (!is.null(respiration_element)) {
       resp.vec <- as.vector(paste0(toupper(respiration_element)))
@@ -34,5 +41,7 @@ net_data_external_list <- function(x, respiration,
       sort(imports),
       sort(exports)
     )
+
+  returnme <- returnme[nzchar(returnme)] # remove empty strings
   return(returnme)
 }

R/net_data_inex_flows.R

@@ -4,34 +4,49 @@
 #' @return Vector of boundary flows - import and export flows.
 
 net_data_inex_flows <- function(x) {
-  ex.mat2 <- matrix_def(x, mat.type = "Export")
-  in.mat2 <- matrix_def(x, mat.type = "Import")
 
-  x <- c(
-    "! Import flows",
-    "",
-    sort(
-      paste0(
-        rownames(in.mat2),
-        "_IM: ",
-        rownames(in.mat2),
-        "Import",
-        " -> ",
-        rownames(in.mat2)
+  # Define import flows, where applicable
+  import.mat <- matrix_def(x, mat.type = "Import")
+
+  # Check whether the import matrix has any data or not before translating
+  if(nrow(import.mat) > 0) {
+    y <- c(
+      "! Import flows",
+      "",
+        paste0(
+          rownames(import.mat),
+          "_IM: ",
+          rownames(import.mat),
+          "Import",
+          " -> ",
+          rownames(import.mat)
+        )
       )
-    ),
-    "",
-    "! Export flows",
-    "",
-    paste0(
-      rownames(ex.mat2),
-      "_EX: ",
-      rownames(ex.mat2),
-      " -> ",
-      rownames(ex.mat2),
-      "Export"
-    ),
-    ""
-  )
-  return(x)
+
+  } else {
+    y <- as.vector(paste0("! No import flows")) # If no import data, no flows are defined
+  }
+
+  # Define export flows, where applicable
+  ex.mat <- matrix_def(x, mat.type = "Export")
+  if(nrow(ex.mat) > 0) {
+    z <- c("",
+           "! Export flows",
+           "",
+             paste0(
+             rownames(ex.mat),
+             "_EX: ",
+             rownames(ex.mat),
+             " -> ",
+             rownames(ex.mat),
+             "Export"
+           ),
+           "")
+  } else {
+    exports <- as.vector(paste0("! No export flows"))
+  }
+
+  a <- c(y, z)
+
+  return(a)
 }

R/output_fun.R

@@ -4,7 +4,7 @@
 #' @return A vector of outputs (imports, exports, plus respiration)
 #'
 output_fun <- function(x) {
-  # Create output vector function
+  # Create output vector
   row.i <-
     grep(
       rownames(x),

R/search_cols.R

@@ -12,21 +12,21 @@ search_cols <- function(x, col.match) {
       as.vector(colnames(x)),
       pattern = paste0(
         c(
-          "Import", "Input", "^+In+$", "^+IN+$", "IN_", "IM_", "^+IM+$", "^+Im+$"
+          "*Import*", "Input*", "^+In+$", "^+IN+$", "IN_", "IM_", "^+IM+$", "^+Im+$"
         ),
         collapse = "|"
       ),
       value = TRUE,
       invert = FALSE,
-      ignore.case = FALSE
+      ignore.case = TRUE
     )
     return(x)
   }
 
   if (col.match == "Export") {
     x <- grep(
       colnames(x),
-      pattern = paste0(c("Export", "Exports", "Ex", "EX", "EX_"),
+      pattern = paste0(c("Export*", "Ex", "EX", "EX_"),
         collapse = "|"
       ),
       value = TRUE,

README.Rmd

@@ -20,6 +20,7 @@ devtools::load_all(".")
 # Automated workflow for incorporation and evaluation of data uncertainty in ecological networks with __autoLIMR__
 
 <!-- badges: start -->
+[![Published in](https://img.shields.io/badge/Ecological_Informatics-green?style=plastic&label=Published%20in&link=https%3A%2F%2Fdoi.org%2F10.1016%2Fj.ecoinf.2023.102375)](https://doi.org/10.1016/j.ecoinf.2023.102375)
 [![R-CMD-check](https://github.com/gemmagerber/autoLIMR/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/gemmagerber/autoLIMR/actions/workflows/R-CMD-check.yaml)
 [![Codecov test coverage](https://codecov.io/gh/gemmagerber/autoLIMR/branch/main/graph/badge.svg)](https://app.codecov.io/gh/gemmagerber/autoLIMR?branch=main)
 [![test-coverage](https://github.com/gemmagerber/autoLIMR/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/gemmagerber/autoLIMR/actions/workflows/test-coverage.yaml)