From 3416656d51f58ddd30bc7d49741421e01f908926 Mon Sep 17 00:00:00 2001 From: Lisec Date: Wed, 6 Sep 2023 17:26:18 +0200 Subject: [PATCH] Ensured that a valid CorMID result is returned also if all int values are NA or not finite. --- DESCRIPTION | 4 ++-- R/CorMID.R | 9 +++------ R/FitMID.R | 8 ++++++-- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 35bf192..f43bb67 100644 --- 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 diff --git a/R/CorMID.R b/R/CorMID.R index acce0c1..acbf0ab 100644 --- 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 index fce8bac..9ba7218 100644 --- 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