Ensured that a valid CorMID result is returned also if all int values…

… are NA or not finite.
janlisec · Sep 6, 2023 · 3416656 · 3416656
1 parent df268e2
commit 3416656
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: CorMID
 Title: Correct Mass Isotopologue Distribution Vectors
-Version: 0.1.9
-Date: 2023-07-25
+Version: 0.1.10
+Date: 2023-09-06
 Authors@R: 
     person("Jan", "Lisec", , "jan.lisec@bam.de", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1220-2286"))
 Maintainer: Jan Lisec <jan.lisec@bam.de>

diff --git a/R/CorMID.R b/R/CorMID.R
@@ -89,6 +89,8 @@ CorMID <- function(int=NULL, fml="", r=NULL, penalize=7, mid_fix=NULL, trace_ste
   }
   attr(fml, "nbio") <- min(lim_nbio, attr(fml, "nbio"))
   attr(fml, "nmz") <- attr(fml, "nbio")+diff(range(known_frags))
+  # compute theoretical distribution matrix from formula (assuming 1% 13C abundance)
+  td <- CalcTheoreticalMDV(fml=fml, nbio=attr(fml, "nbio"), nmz=attr(fml, "nmz"))
 
   # QC for r
   # if r is unspecified
@@ -119,11 +121,6 @@ CorMID <- function(int=NULL, fml="", r=NULL, penalize=7, mid_fix=NULL, trace_ste
   }
   if (!all(names(int) %in% names(rawMID))) stop("rawMID specified without names indicating position relative to [M+H].")
   rawMID[names(int)] <- int
-  # ensure that intensity vector is normalized to sum
-  rawMID <- rawMID/sum(rawMID)
-
-  # compute theoretical distribution matrix from formula (assuming 1% 13C abundance)
-  td <- CalcTheoreticalMDV(fml=fml, nbio=attr(fml, "nbio"), nmz=attr(fml, "nmz"))
 
   # QC for mid_fix
   if (!is.null(mid_fix)) {
@@ -193,5 +190,5 @@ print.CorMID <- function(x, ...) {
   cat("  ", paste(names(r), collapse="   "), "\n", sep="")
   cat(sapply(1:length(r), function(i) { formatC(r[i], digits=2, format="f", width=2+nchar(names(r)[i])) }), "\n")
   cat_or_message("[attr] 'err'")
-  cat(formatC(attr(x, "err"), format="g"),"\n\n")
+  cat(ifelse(is.na(attr(x, "err")), NA, formatC(attr(x, "err"), format="g")),"\n\n")
 }
diff --git a/R/FitMID.R b/R/FitMID.R
@@ -22,13 +22,17 @@ FitMID <- function(md=NULL, td=NULL, r=NULL, mid_fix=NULL, prec=0.01, trace_step
 
   # default return value
   if (sum(md)==0) {
-    out <- rep(NA, ifelse(is.null(td), length(md), nrow(td)))
-    if (is.null(td)) names(out) <- row.names(td) else names(out) <- names(md)
+    message("No finite intensity values provided. Return NA vector.")
+    out <- as.numeric(rep(NA, ifelse(is.null(td), length(md), nrow(td))))
+    if (is.null(td)) names(out) <- names(md) else names(out) <- row.names(td)
     attr(out, "err") <- unlist(list("err"=NA))
     if (prod(dim(r))>1) attr(out, "ratio") <- apply(r,2,stats::median)/sum(apply(r,2,stats::median)) else attr(out, "ratio") <- r
     attr(out, "ratio_status") <- ifelse(prod(dim(r))>1 && all(apply(r,2,diff)==0), "fixed", "estimated")
     attr(out, "mid_status") <- ifelse(!is.null(mid_fix), "fixed", "estimated")
     return(out)
+  } else {
+    # ensure that intensity vector is normalized to sum
+    md <- md/sum(md)
   }
 
   # set up r_fixed for internal use