Refactored, renamed variables, updated comments of rm.ridge.R

CHANGELOG.md

@@ -33,6 +33,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - docstrings and documentation files for refactored functions [#160](https://github.com/RECETOX/recetox-aplcms/pull/160)
 - refactored parameter names to keep them more harmonized [#167](https://github.com/RECETOX/recetox-aplcms/pull/167)
 - moved some utility functions to a more suitable locations [#164](https://github.com/RECETOX/recetox-aplcms/pull/164)
+- refactored `rm.ridge.R` [#171](https://github.com/RECETOX/recetox-aplcms/pull/171)
 
 ### Removed
 - `extract_features` and `feature.align` [#154](https://github.com/RECETOX/recetox-aplcms/pull/154)

R/rm.ridge.R

@@ -1,31 +1,57 @@
+#' @description
+#' Computes retention time intervals of a selected retention time range.
+#' @param rt full retention time vector.
+#' @param intensity Intensity vector.
+#' @param rt_range Selected retention time range vector.
+#' @return A list object:
+#' \itemize{
+#'   \item over_rt - upper retention time interval
+#'   \item under_rt - lower retention time interval
+#'   \item within_rt - intermediate retention time interval
+#' }
+#' @export
+compute_rt_intervals <- function(rt, intensity, rt_range){
+    rt_max <- max(rt[rt_range])
+    rt_min <- min(rt[rt_range])
+
+    over_rt <- which(rt > rt_max)
+    under_rt <-  which(rt < rt_min)
+    within_rt <- which(between(rt, rt_min, rt_max))
+
+    rt_range <- new("list")
+    rt_range$over_rt <- over_rt
+    rt_range$under_rt <- under_rt
+    rt_range$within_rt <- within_rt
+    return(rt_range)
+}
+
 #' Removing long ridges at the same m/z.
 #' 
 #' @description
-#' This is an internal function. It substracts a background estimated through kernel smoothing when an EIC continuously 
-#' span more than half the retention time range.
-#' @param x Retention time vector.
-#' @param y2 Intensity vector.
+#' This is an internal function. It substracts a background when an EIC continuously 
+#' span more than half the retention time range. The background is estimated through kernel smoothing.
+#' @param rt Retention time vector.
+#' @param intensity Intensity vector.
 #' @param bw Bandwidth for the kernel smoother. A very wide one is used here.
-#' @return A vector of intensity value is returned.
+#' @return A vector of intensity values at each rt intervals is returned.
 #' @importFrom dplyr between
 #' @export
-rm.ridge <- function(x,y2, bw) {
-    sel<-which(y2<quantile(y2, 0.75))
-    max.x.sel<-max(x[sel])
-    min.x.sel<-min(x[sel])
-
-    in.sel<-which(between(x, min.x.sel, max.x.sel))
-    over.sel<-which(x>max.x.sel)
-    under.sel<-which(x<min.x.sel)
-
-
-    this.s<-ksmooth(x[sel],y2[sel],x.points=x[in.sel],kernel="normal",bandwidth=bw)
-    if(sum(is.na(this.s$y))>0) return(y2)
+rm.ridge <- function(rt, intensity, bw) {
+    this_rt <- which(intensity < quantile(intensity, 0.75))
+
+    rt_intervals <- compute_rt_intervals(rt, intensity, this_rt)
+
+    rt_over <- rt_intervals$over_rt 
+    rt_under <- rt_intervals$under_rt
+    rt_within <- rt_intervals$within_rt
+
+    this.s <- ksmooth(rt[this_rt], intensity[this_rt], x.points = rt[rt_within], kernel = "normal", bandwidth = bw)
+    if(sum(is.na(this.s$y)) > 0) return(intensity)
 
-    y2[in.sel]<-y2[in.sel]-this.s$y
-    y2[over.sel]<-y2[over.sel]-this.s$y[which(this.s$x==max(this.s$x))[1]]
-    y2[under.sel]<-y2[under.sel]-this.s$y[which(this.s$x==min(this.s$x))[1]]
+    intensity[rt_within] <- intensity[rt_within] - this.s$y
+    intensity[rt_over] <- intensity[rt_over] - this.s$y[which(this.s$x == max(this.s$x))[1]]
+    intensity[rt_under] <- intensity[rt_under] - this.s$y[which(this.s$x == min(this.s$x))[1]]
 
-    y2[y2<0]<-0
-    return(y2)
+    intensity[intensity < 0] <- 0
+    return(intensity)
 }