Mercurial > repos > recetox > recetox_aplcms_unsupervised

comparison main.R @ 10:6057540f65a9 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"planemo upload for repository https://github.com/RECETOX/galaxytools/tree/master/tools/recetox_aplcms commit 46f606d8d234807e603b55eb2791f76663b551ee"
author recetox
date Thu, 21 Oct 2021 15:03:18 +0000
parents d06ec5e6721c
children 006736cab495
comparison
equal deleted inserted replaced
9:b18c2d014b28 10:6057540f65a9
1 library(recetox.aplcms) 1 library(recetox.aplcms)
2 library(dplyr)
2 3
3 save_extracted_features <- function(df, filename) { 4 save_extracted_features <- function(df, filename) {
4 df <- as.data.frame(df) 5 df <- as.data.frame(df)
5 columns <- c("mz", "pos", "sd1", "sd2", "area") 6 columns <- c("mz", "pos", "sd1", "sd2", "area")
6 arrow::write_parquet(df[columns], filename) 7 arrow::write_parquet(df[columns], filename)
7 } 8 }
8 9
9 save_feature_sample_table <- function(df, filename) { 10 save_aligned_feature_table <- function(df, filename) {
10 columns <- c("feature", "mz", "rt", "sample", "sample_rt", "sample_intensity") 11 columns <- c("feature", "mz", "rt", "sample", "sample_rt", "sample_intensity")
11 arrow::write_parquet(df[columns], filename) 12 arrow::write_parquet(df[columns], filename)
13 }
14
15 save_recovered_feature_table <- function(df, filename, out_format) {
16 columns <- c("feature", "mz", "rt", "sample", "sample_rt", "sample_intensity")
17 if (out_format == "recetox") {
18 peak_table <- df[columns]
19 recetox_peak_table <- rcx_aplcms_to_rcx_xmsannotator(peak_table)
20 arrow::write_parquet(recetox_peak_table, filename)
21 } else {
22 arrow::write_parquet(df[columns], filename)
23 }
24 }
25
26 rcx_aplcms_to_rcx_xmsannotator <- function(peak_table) {
27 col_base <- c("feature", "mz", "rt")
28 output_table <- peak_table %>% distinct(across(any_of(col_base)))
29
30 for (level in levels(peak_table$sample)) {
31 subdata <- peak_table %>%
32 filter(sample == level) %>%
33 select(any_of(c(col_base, "sample_intensity"))) %>%
34 rename(!!level := "sample_intensity")
35 output_table <- inner_join(output_table, subdata, by = col_base)
36 }
37 output_table <- output_table %>% rename(peak = feature)
38 return(output_table)
12 } 39 }
13 40
14 known_table_columns <- function() { 41 known_table_columns <- function() {
15 c("chemical_formula", "HMDB_ID", "KEGG_compound_ID", "mass", "ion.type", 42 c("chemical_formula", "HMDB_ID", "KEGG_compound_ID", "mass", "ion.type",
16 "m.z", "Number_profiles_processed", "Percent_found", "mz_min", "mz_max", 43 "m.z", "Number_profiles_processed", "Percent_found", "mz_min", "mz_max",
45 filenames <- file.path("corrected", filenames) 72 filenames <- file.path("corrected", filenames)
46 dir.create("corrected") 73 dir.create("corrected")
47 mapply(save_extracted_features, dfs, filenames) 74 mapply(save_extracted_features, dfs, filenames)
48 } 75 }
49 76
50 unsupervised_main <- function(sample_files, aligned_file, recovered_file, ...) { 77 unsupervised_main <- function(sample_files, aligned_file, recovered_file, out_format, ...) {
51 sample_files <- sort_samples_by_acquisition_number(sample_files) 78 sample_files <- sort_samples_by_acquisition_number(sample_files)
52 79
53 res <- unsupervised(filenames = sample_files, ...) 80 res <- unsupervised(filenames = sample_files, ...)
54 81
55 save_all_extracted_features(res$extracted_features, sample_files) 82 save_all_extracted_features(res$extracted_features, sample_files)
56 save_all_corrected_features(res$corrected_features, sample_files) 83 save_all_corrected_features(res$corrected_features, sample_files)
57 84
58 save_feature_sample_table(res$aligned_feature_sample_table, aligned_file) 85 save_aligned_feature_table(res$aligned_feature_sample_table, aligned_file)
59 save_feature_sample_table(res$recovered_feature_sample_table, recovered_file) 86 save_recovered_feature_table(res$recovered_feature_sample_table, recovered_file, out_format)
60 } 87 }
61 88
62 hybrid_main <- function(sample_files, known_table_file, updated_known_table_file, pairing_file, aligned_file, recovered_file, ...) { 89 hybrid_main <- function(sample_files, known_table_file, updated_known_table_file, pairing_file, aligned_file, recovered_file, out_format, ...) {
63 sample_files <- sort_samples_by_acquisition_number(sample_files) 90 sample_files <- sort_samples_by_acquisition_number(sample_files)
64 91
65 known <- read_known_table(known_table_file) 92 known <- read_known_table(known_table_file)
66 res <- hybrid(filenames = sample_files, known_table = known, ...) 93 res <- hybrid(filenames = sample_files, known_table = known, ...)
67 94
69 save_pairing(res$features_known_table_pairing, pairing_file) 96 save_pairing(res$features_known_table_pairing, pairing_file)
70 97
71 save_all_extracted_features(res$extracted_features, sample_files) 98 save_all_extracted_features(res$extracted_features, sample_files)
72 save_all_corrected_features(res$corrected_features, sample_files) 99 save_all_corrected_features(res$corrected_features, sample_files)
73 100
74 save_feature_sample_table(res$aligned_feature_sample_table, aligned_file) 101 save_aligned_feature_table(res$aligned_feature_sample_table, aligned_file)
75 save_feature_sample_table(res$recovered_feature_sample_table, recovered_file) 102 save_recovered_feature_table(res$recovered_feature_sample_table, recovered_file, out_format)
76 } 103 }