From 8c86040269be643f10f5782d2c9171de6eaa1a23 Mon Sep 17 00:00:00 2001 From: GERBER Gemma Date: Tue, 5 Nov 2024 15:26:03 +0100 Subject: [PATCH] Badge update --- R/input_fun.R | 35 +++++++++++-------- R/matrix_def.R | 5 +-- R/net_data_external_list.R | 23 ++++++++---- R/net_data_inex_flows.R | 71 +++++++++++++++++++++++--------------- R/output_fun.R | 2 +- R/search_cols.R | 6 ++-- README.Rmd | 1 + 7 files changed, 88 insertions(+), 55 deletions(-) diff --git a/R/input_fun.R b/R/input_fun.R index 4660a56..24098f9 100644 --- a/R/input_fun.R +++ b/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) } diff --git a/R/matrix_def.R b/R/matrix_def.R index d666f35..b9ebc55 100644 --- a/R/matrix_def.R +++ b/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) } } + diff --git a/R/net_data_external_list.R b/R/net_data_external_list.R index c37bc9b..9a04994 100644 --- a/R/net_data_external_list.R +++ b/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) } diff --git a/R/net_data_inex_flows.R b/R/net_data_inex_flows.R index 0e9bcb5..d23888a 100644 --- a/R/net_data_inex_flows.R +++ b/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) } diff --git a/R/output_fun.R b/R/output_fun.R index 3d4c9a2..e957d80 100644 --- a/R/output_fun.R +++ b/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), diff --git a/R/search_cols.R b/R/search_cols.R index 54c1218..54fbaca 100644 --- a/R/search_cols.R +++ b/R/search_cols.R @@ -12,13 +12,13 @@ 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) } @@ -26,7 +26,7 @@ search_cols <- function(x, col.match) { 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, diff --git a/README.Rmd b/README.Rmd index 1420dad..1265773 100644 --- a/README.Rmd +++ b/README.Rmd @@ -20,6 +20,7 @@ devtools::load_all(".") # Automated workflow for incorporation and evaluation of data uncertainty in ecological networks with __autoLIMR__ +[![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)