Merge pull request #84 from maximskorik/refactor_prof.to.features

Refactor prof.to.features

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(solve,a)
 S3method(solve,sigma)
 export(adaptive.bin)
 export(adjust.time)
@@ -11,12 +12,23 @@ export(combine.seq.3)
 export(compute_boundaries)
 export(compute_bounds)
 export(compute_breaks)
+export(compute_chromatographic_profile)
 export(compute_delta_rt)
 export(compute_densities)
+export(compute_dx)
+export(compute_e_step)
+export(compute_end_bound)
+export(compute_gaussian_peak_shape)
+export(compute_initiation_params)
 export(compute_mass_density)
 export(compute_mass_values)
+export(compute_mu_sc_std)
+export(compute_mz_sd)
+export(compute_scale)
+export(compute_start_bound)
 export(compute_target_times)
 export(cont.index)
+export(draw_chr_normal_peaks)
 export(duplicate.row.remove)
 export(extract_features)
 export(extract_pattern_colnames)
@@ -39,9 +51,14 @@ export(mass.match)
 export(msExtrema)
 export(normix)
 export(normix.bic)
+export(plot_chr_profile)
+export(plot_normix_bic)
+export(plot_peak_summary)
 export(plot_raw_profile_histogram)
 export(predict_mz_break_indices)
 export(prep.uv)
+export(preprocess_bandwidth)
+export(preprocess_profile)
 export(proc.cdf)
 export(prof.to.features)
 export(recover.weaker)
@@ -51,6 +68,7 @@ export(semi.sup)
 export(sort_samples_by_acquisition_number)
 export(two.step.hybrid)
 export(unsupervised)
+export(validate_inputs)
 import(MASS)
 import(arrow)
 import(doParallel)
@@ -64,3 +82,5 @@ import(stringr)
 import(tibble)
 import(tidyr)
 import(tools)
+importFrom(dplyr,arrange)
+importFrom(dplyr,filter)

R/extract_features.R

@@ -79,8 +79,22 @@ extract_features <- function(
     'bigauss.mix',
     'bigauss.esti',
     'rev_cum_sum',
-    'compute_bounds'
+    'compute_bounds',
+    'validate_inputs',
+    'preprocess_bandwidth',
+    'preprocess_profile',
+    'compute_gaussian_peak_shape',
+    'compute_chromatographic_profile',
+    'compute_dx',
+    'compute_initiation_params',
+    'compute_e_step',
+    'compute_start_bound',
+    'compute_end_bound',
+    'compute_bounds',
+    'compute_scale'
   ))
+  snow::clusterEvalQ(cluster, library("dplyr"))
+
 
   snow::parLapply(cluster, filenames, function(filename) {
     profile <- proc.cdf(
@@ -95,7 +109,7 @@ extract_features <- function(
       cache = FALSE
     )
     features <- prof.to.features(
-      a = profile,
+      profile = profile,
       min.bw = min_bandwidth,
       max.bw = max_bandwidth,
       sd.cut = sd_cut,

R/plot.R

@@ -14,6 +14,13 @@ tolerance_plot <- function(x, y, exp_y, selected, main) {
   abline(v = x[selected], col = "blue")
 }
 
+#' @export
+draw_chr_normal_peaks <- function(x, truth) {
+  true.y1 <- dnorm(x[x < truth[1]], mean = truth[1], sd = truth[2]) * truth[2] * truth[4]
+  true.y2 <- dnorm(x[x >= truth[1]], mean = truth[1], sd = truth[3]) * truth[3] * truth[4]
+  lines(x, c(true.y1, true.y2), col = "green")
+}
+
 #' @export
 plot_raw_profile_histogram <- function(raw.prof,
                                        min.pres,
@@ -72,3 +79,39 @@ plot_raw_profile_histogram <- function(raw.prof,
     main = "Group % present signal distribution"
   )
 }
+
+#' @export
+plot_peak_summary <- function(feature_groups, processed_features) {
+  mz_sd <- compute_mz_sd(feature_groups)
+
+  par(mfrow = c(2, 2))
+  plot(c(-1, 1), c(-1, 1), type = "n", xlab = "", ylab = "", main = "", axes = FALSE)
+  text(x = 0, y = 0, "Estimate peak \n area/location", cex = 1.5)
+  hist(mz_sd, xlab = "m/z SD", ylab = "Frequency", main = "m/z SD distribution")
+  hist(c(processed_features[, "sd1"], processed_features[, "sd2"]), xlab = "Retention time SD", ylab = "Frequency", main = "Retention time SD distribution")
+  hist(log10(processed_features[, "area"]), xlab = "peak strength (log scale)", ylab = "Frequency", main = "Peak strength distribution")
+}
+
+#' @export
+plot_chr_profile <- function(chr_profile, bw, fit, m) {
+  plot(chr_profile[, "base_curve"], chr_profile[, "intensity"], cex = .1, main = paste("bw=", bw))
+  sum.fit <- apply(fit, 1, sum)
+  lines(chr_profile[, "base_curve"], sum.fit)
+  abline(v = m)
+  cols <- c("red", "green", "blue", "cyan", "brown", "black", rep("grey", 100))
+  for (i in 1:length(m))
+  {
+    lines(chr_profile[, "base_curve"], fit[, i], col = cols[i])
+  }
+}
+
+#' @export
+plot_normix_bic <- function(x, y, bw, aaa) {
+  plot(x, y, cex = .1, main = paste("bw=", bw))
+  abline(v = aaa[, 1])
+  cols <- c("red", "green", "blue", "cyan", "brown", "black", rep("grey", 100))
+  for (i in 1:nrow(aaa))
+  {
+    lines(x, dnorm(x, mean = aaa[i, 1], sd = aaa[i, 2]) * aaa[i, 3], col = cols[i])
+  }
+}