Commit a89c8b94 authored by daniel.eilertz's avatar daniel.eilertz
Browse files

Merge branch 'dev' of gitlab.gwdg.de:joerg.buescher/automrm into eilertz

parents f651163a 0f2d719d
No preview for this file type
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(initialize_prm) export(initialize_prm)
export(qqq_auto_integrate) export(process_batch)
export(qqq_model_train) export(train_model)
...@@ -62,7 +62,7 @@ for (id in 1:prm$nsmpl) { ...@@ -62,7 +62,7 @@ for (id in 1:prm$nsmpl) {
# fine-adjust rt shift only for really polar # fine-adjust rt shift only for really polar
if (prm$polarmets && !prm$sosomets){ if (prm$polarmets && !prm$sosomets){
if (prm$verbose >=2 ){ if (prm$verbose >=2 ){
pdf(file = "shiftplots.pdf", height = 6, width = 6, family = "Helvetica") pdf(file = file.path(prm$batchdir, "shiftplots.pdf"), height = 6, width = 6, family = "Helvetica")
} }
fitqual <- numeric() fitqual <- numeric()
for (id in 1:prm$nsmpl) { for (id in 1:prm$nsmpl) {
...@@ -340,7 +340,7 @@ for (im in 1:prm$nmet) { ...@@ -340,7 +340,7 @@ for (im in 1:prm$nmet) {
if (prm$verbose >= 1) { if (prm$verbose >= 1) {
# write log of quality scores for training to tsv file # write log of quality scores for training to tsv file
write.table(qslog, file = 'qslog.tsv', sep = '\t', row.names = FALSE) write.table(qslog, file = file.path(prm$batchdir, 'qslog.tsv'), sep = '\t', row.names = FALSE)
# write template for training solution to xlsx file # write template for training solution to xlsx file
wb <- openxlsx::createWorkbook() wb <- openxlsx::createWorkbook()
...@@ -357,7 +357,7 @@ if (prm$verbose >= 1) { ...@@ -357,7 +357,7 @@ if (prm$verbose >= 1) {
openxlsx::writeData(wb, 'Sheet1', prm$unirt[pstartmat[ ,im]] , startCol = nowcol+1, startRow = 4, rowNames = FALSE, colNames = FALSE) openxlsx::writeData(wb, 'Sheet1', prm$unirt[pstartmat[ ,im]] , startCol = nowcol+1, startRow = 4, rowNames = FALSE, colNames = FALSE)
openxlsx::writeData(wb, 'Sheet1', prm$unirt[pendmat[ ,im]] , startCol = nowcol+2, startRow = 4, rowNames = FALSE, colNames = FALSE) openxlsx::writeData(wb, 'Sheet1', prm$unirt[pendmat[ ,im]] , startCol = nowcol+2, startRow = 4, rowNames = FALSE, colNames = FALSE)
} }
openxlsx::saveWorkbook(wb, "manual_peakcheck_template.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb, file.path(prm$batchdir, "manual_peakcheck_template.xlsx"), overwrite = TRUE)
} }
msd # return msd msd # return msd
......
generate_Xy_data_peaks_final <- function(xlsx_path,tsv_path){ generate_Xy_data_peaks_final <- function(xlsx_path,tsv_path){
#xlsx with classification #xlsx with classification
xlsx_td <- openxlsx::read.xlsx(xlsx_path, colNames = FALSE, rowNames = FALSE) xlsx_td <- openxlsx::read.xlsx(xlsx_path, colNames = FALSE, rowNames = FALSE)
#tsv with quality scores #tsv with quality scores
tsv_td <- read.table(file = tsv_path, sep = '\t', stringsAsFactors = FALSE) tsv_td <- read.table(file = tsv_path, sep = '\t', stringsAsFactors = FALSE)
colnames(tsv_td) <- as.character(tsv_td[1, ]) colnames(tsv_td) <- as.character(tsv_td[1, ])
tsv_td <- as.data.frame(tsv_td[-1, ]) tsv_td <- as.data.frame(tsv_td[-1, ])
tsvqscols <- grep('QS_', colnames(tsv_td)) tsvqscols <- grep('QS_', colnames(tsv_td))
pcandcol <- which(colnames(tsv_td) == 'Output_H') pcandcol <- which(colnames(tsv_td) == 'Output_H')
tsvnumcol <- c(tsvqscols, pcandcol) tsvnumcol <- c(tsvqscols, pcandcol)
for (ic in tsvnumcol) { for (ic in tsvnumcol) {
tsv_td[ , ic] <- as.numeric(tsv_td[ , ic]) tsv_td[ , ic] <- as.numeric(tsv_td[ , ic])
} }
#initialize Xy_data #initialize Xy_data
my_data <- as.data.frame(matrix(rep(NA,(ncol(xlsx_td)-2)*(nrow(xlsx_td)-3)*(ncol(tsv_td)+4)),ncol=ncol(tsv_td)+4)) my_data <- as.data.frame(matrix(rep(NA,(ncol(xlsx_td)-2)*(nrow(xlsx_td)-3)*(ncol(tsv_td)+4)),ncol=ncol(tsv_td)+4))
colnames(my_data) <- c("y", colnames(tsv_td)[-c(1,2)], paste0("RF",seq(0,100,25)) ) colnames(my_data) <- c("y", colnames(tsv_td)[-c(1,2)], paste0("RF",seq(0,100,25)) )
metnames <- unique(as.character(xlsx_td[1,]))
metnames <- metnames[!is.na(metnames)]
# parse y from xlsx data # parse y from xlsx data
count <- 1 count <- 1
for (col in 3:ncol(xlsx_td)) { for (im in 1:length(metnames)) {
# col=3 # col=3
met <- xlsx_td[1,col] col <- which(xlsx_td[1, ] == metnames[im] )[1]
for(row in 4:nrow(xlsx_td)){ for (row in 3:nrow(xlsx_td)) {
sample <- substr(xlsx_td[row,1],1,nchar(xlsx_td[row,1])-5) if (nchar(xlsx_td[row,1]) > 6) {
rownames(my_data)[count] <- paste0(met," ",sample) sample <- substr(xlsx_td[row,1], 1, nchar(xlsx_td[row,1])-5)
}
rownames(my_data)[count] <- paste0(metnames[im]," ",sample)
my_data[count,1] <- xlsx_td[row,col] my_data[count,1] <- xlsx_td[row,col]
count <- count + 1 count <- count + 1
} }
} }
# parse quality scores from tsv file # parse quality scores from tsv file
for (row in 1 : nrow(tsv_td)){ for (row in 1 : nrow(tsv_td)){
#row <- 4 #row <- 4
sample_metab <- paste0(tsv_td[row,2]," ", tsv_td[row,1]) sample_metab <- paste0(tsv_td[row,2]," ", tsv_td[row,1])
# Get index of sample*metabolites and scrape qs # Get index of sample*metabolites and scrape qs
row_index <- which(rownames(my_data) == sample_metab) row_index <- which(rownames(my_data) == sample_metab)
qs_scores<- tsv_td[row, tsvqscols ] # 5:ncol(tsv_td)-1] qs_scores<- tsv_td[row, tsvqscols ] # 5:ncol(tsv_td)-1]
# get indices of current metab to aggregate rf hit probabilty # get indices of current metab to aggregate rf hit probabilty
metab_indices <- which(tsv_td[,2] == tsv_td[row,2]) metab_indices <- which(tsv_td[,2] == tsv_td[row,2])
rf_quantiles <- quantile(tsv_td[metab_indices, pcandcol]) rf_quantiles <- quantile(tsv_td[metab_indices, pcandcol])
my_data[row_index,2:ncol(my_data)] <- c(qs_scores, rf_quantiles) my_data[row_index,2:ncol(my_data)] <- c(qs_scores, rf_quantiles)
} }
# Only use subset of mamatrix where peak classification is 2 or 0 (1's are maybe peaks) # Only use subset of mamatrix where peak classification is 2 or 0 (1's are maybe peaks)
#my_data <- my_data[my_data[,1] != 1,] #my_data <- my_data[my_data[,1] != 1,]
#my_data[my_data[,1] == 1,1] <- 0 #my_data[my_data[,1] == 1,1] <- 0
# Set y to factor # Set y to factor
my_data$y <- as.factor(my_data$y) my_data$y <- as.factor(my_data$y)
#Return Xy_data #Return Xy_data
my_data my_data
} }
\ No newline at end of file
...@@ -31,9 +31,6 @@ initialize_prm <- function() { ...@@ -31,9 +31,6 @@ initialize_prm <- function() {
prm$pathprefix <- '/' prm$pathprefix <- '/'
} }
# Set up logging (log to file only when running on server) ------------------------------
prm$log_con <- file("R_messages.log",open="a")
# Set global parameters for peak detection # Set global parameters for peak detection
prm$timerange <- c(0,5) # time range in minutes --> will be re-determined based on first sample further down prm$timerange <- c(0,5) # time range in minutes --> will be re-determined based on first sample further down
prm$samplingfrequency <- 2 # samplingfrequency (time resolution of analysis) in Hz prm$samplingfrequency <- 2 # samplingfrequency (time resolution of analysis) in Hz
......
...@@ -8,8 +8,8 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -8,8 +8,8 @@ peak_detection <- function(metab, smpl, prm) {
cat('Now integrating peaks in from all files. \n Counting files...', file=prm$log_con) cat('Now integrating peaks in from all files. \n Counting files...', file=prm$log_con)
print(' ') print(' ')
qslog_i <- 1 qslog_i <- 1
# initialize varibiables # initialize varibiables
# outer list: metabolites # outer list: metabolites
# inner lists: samples # inner lists: samples
msdelement <- list('x1' = rep(0,prm$nscan) , # quantifier chromatogram msdelement <- list('x1' = rep(0,prm$nscan) , # quantifier chromatogram
...@@ -52,7 +52,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -52,7 +52,7 @@ peak_detection <- function(metab, smpl, prm) {
cat(paste(as.character(id),'-'), file=prm$log_con) cat(paste(as.character(id),'-'), file=prm$log_con)
print(paste0(" Peak detection of file: ", id, ": ", smpl$samplenames[id], ' ')) print(paste0(" Peak detection of file: ", id, ": ", smpl$samplenames[id], ' '))
} }
#loop over metabolites (quantifier ids) #loop over metabolites (quantifier ids)
for(im in 1:prm$nmet){ for(im in 1:prm$nmet){
# im <- 1 # im <- 1
...@@ -62,7 +62,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -62,7 +62,7 @@ peak_detection <- function(metab, smpl, prm) {
if (prm$verbose > 0) { if (prm$verbose > 0) {
cat('\r', paste(" Working on: ", metab[[im]]$name ," - ","ID: ",im, ' ')) cat('\r', paste(" Working on: ", metab[[im]]$name ," - ","ID: ",im, ' '))
} }
# Set default values and continue if metabolite WAS NOT MEASURED in sample # Set default values and continue if metabolite WAS NOT MEASURED in sample
if (!metab[[im]]$measured) { if (!metab[[im]]$measured) {
if (prm$verbose >= 3) { if (prm$verbose >= 3) {
...@@ -77,17 +77,17 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -77,17 +77,17 @@ peak_detection <- function(metab, smpl, prm) {
msd[[im]][[id]]$height13 <- 0 msd[[im]][[id]]$height13 <- 0
msd[[im]][[id]]$RT <- NA msd[[im]][[id]]$RT <- NA
msd[[im]][[id]]$qs <- -1 msd[[im]][[id]]$qs <- -1
next next
} # not measured } # not measured
# start new metabolite parameter set # start new metabolite parameter set
candidates <- list() candidates <- list()
candqs <- numeric() candqs <- numeric()
candrt <- numeric() candrt <- numeric()
anypeak <- FALSE anypeak <- FALSE
x1 <- x2 <- x3 <- rep(0,prm$nscan) x1 <- x2 <- x3 <- rep(0,prm$nscan)
# Get rollmean of quantifier # Get rollmean of quantifier
if (length(smpl$chroms[[id]][[ metab[[im]]$quant$MRM ]] ) > prm$smoothnum ) { if (length(smpl$chroms[[id]][[ metab[[im]]$quant$MRM ]] ) > prm$smoothnum ) {
nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$quant$MRM]]) nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$quant$MRM]])
...@@ -100,7 +100,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -100,7 +100,7 @@ peak_detection <- function(metab, smpl, prm) {
} }
} }
nowdata <- x1 nowdata <- x1
# Get rollmean 12c qualifiers # Get rollmean 12c qualifiers
if (length(smpl$chroms[[id]][[ metab[[im]]$qual12c$MRM[1] ]] ) > prm$smoothnum ) { if (length(smpl$chroms[[id]][[ metab[[im]]$qual12c$MRM[1] ]] ) > prm$smoothnum ) {
nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$qual12c$MRM[1]]]) nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$qual12c$MRM[1]]])
...@@ -111,7 +111,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -111,7 +111,7 @@ peak_detection <- function(metab, smpl, prm) {
nowdata <- cbind(nowdata,x2) nowdata <- cbind(nowdata,x2)
} }
} else { } else {
if (msd[[im]][[id]]$foundchrom[2]) { if (msd[[im]][[id]]$foundchrom[2]) {
print(paste('12C qualifier not found for', metab[[im]]$name, 'in', smpl$samplenames[id], ' ')) print(paste('12C qualifier not found for', metab[[im]]$name, 'in', smpl$samplenames[id], ' '))
} else { } else {
...@@ -120,7 +120,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -120,7 +120,7 @@ peak_detection <- function(metab, smpl, prm) {
} }
} }
} }
# Get 13c qualifier # Get 13c qualifier
if (length(smpl$chroms[[id]][[ metab[[im]]$qual13c$MRM[1] ]] ) > prm$smoothnum ) { if (length(smpl$chroms[[id]][[ metab[[im]]$qual13c$MRM[1] ]] ) > prm$smoothnum ) {
nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$qual13c$MRM[1]]]) nonanpos <- !is.na(smpl$chroms[[id]][[metab[[im]]$qual13c$MRM[1]]])
...@@ -131,7 +131,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -131,7 +131,7 @@ peak_detection <- function(metab, smpl, prm) {
nowdata <- cbind(nowdata,x3) nowdata <- cbind(nowdata,x3)
} }
} else { } else {
if (msd[[im]][[id]]$foundchrom[3]) { if (msd[[im]][[id]]$foundchrom[3]) {
print(paste('13C qualifier not found for', metab[[im]]$name, 'in', smpl$samplenames[id], ' ')) print(paste('13C qualifier not found for', metab[[im]]$name, 'in', smpl$samplenames[id], ' '))
} else { } else {
...@@ -146,31 +146,31 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -146,31 +146,31 @@ peak_detection <- function(metab, smpl, prm) {
msd[[im]][[id]]$x2 <- x2 msd[[im]][[id]]$x2 <- x2
msd[[im]][[id]]$x3 <- x3 msd[[im]][[id]]$x3 <- x3
msd[[im]][[id]]$combidata <- nowdata msd[[im]][[id]]$combidata <- nowdata
# !------- # !-------
# GET PEAK CANDIDATES # GET PEAK CANDIDATES
peak_list <- qqq_mrm_integrate(metab, smpl, prm, msd, id, im) peak_list <- qqq_mrm_integrate(metab, smpl, prm, msd, id, im)
# !------- # !-------
# ToDo: move this for loop to end of qqq_mrm_integrate # ToDo: move this for loop to end of qqq_mrm_integrate
# alternatively: get logic from qqq_mrm_integrate and place here # alternatively: get logic from qqq_mrm_integrate and place here
# #
for (p in 1:length(peak_list)){ for (p in 1:length(peak_list)){
if (!is.list(peak_list[[p]]) ) { if (!is.list(peak_list[[p]]) ) {
candqs[p] <- -1 candqs[p] <- -1
candrt[p] <- -1 candrt[p] <- -1
next next
} }
# To check: maybe no need to write peak_list to msd[[im]][[id]]$peaks # To check: maybe no need to write peak_list to msd[[im]][[id]]$peaks
candqs[p] <- peak_list[[p]]$qs candqs[p] <- peak_list[[p]]$qs
candrt[p] <- peak_list[[p]]$RT candrt[p] <- peak_list[[p]]$RT
anypeak <- TRUE anypeak <- TRUE
} # endfor peaklist } # endfor peaklist
# Check peak candidates qs scores against treshold # Check peak candidates qs scores against treshold
if (prm$verbos >= 2){ if (prm$verbos >= 2){
cat('\r', paste(metab[[im]]$name , " --> Peaks' QS:", paste(sapply(candqs,round,2),collapse=" "))) cat('\r', paste(metab[[im]]$name , " --> Peaks' QS:", paste(sapply(candqs,round,2),collapse=" ")))
...@@ -193,16 +193,16 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -193,16 +193,16 @@ peak_detection <- function(metab, smpl, prm) {
msd[[im]][[id]]$RT <- NA msd[[im]][[id]]$RT <- NA
msd[[im]][[id]]$qs <- -1 msd[[im]][[id]]$qs <- -1
msd[[im]][[id]]$qs <- numeric(length(peak_list$qs_list)) msd[[im]][[id]]$qs <- numeric(length(peak_list$qs_list))
next next
} }
# POLARMETS # POLARMETS
# for polar mets take best peak or if there is no convincing peak # for polar mets take best peak or if there is no convincing peak
if ( (prm$polarmets) || (length(nowgoodpeak) == 0) ) { if ( (prm$polarmets) || (length(nowgoodpeak) == 0) ) {
# Fill matrices of area, height, RT, qs # Fill matrices of area, height, RT, qs
bestpeak <- which(candqs == max(candqs))[1] bestpeak <- which(candqs == max(candqs))[1]
# add bestpeak to metabolite-sample-data # add bestpeak to metabolite-sample-data
msd[[im]][[id]]$bestpeak <- bestpeak # for_cleanup: msd[[im]][[id]]$bestoverallpeak <- msd[[im]][[id]]$bestpeak <- bestpeak # for_cleanup: msd[[im]][[id]]$bestoverallpeak <-
if (prm$sum12c) { if (prm$sum12c) {
...@@ -224,9 +224,9 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -224,9 +224,9 @@ peak_detection <- function(metab, smpl, prm) {
msd[[im]][[id]]$ylim <- peak_list[[bestpeak]]$ylim msd[[im]][[id]]$ylim <- peak_list[[bestpeak]]$ylim
msd[[im]][[id]]$label1 <- peak_list[[bestpeak]]$label1 msd[[im]][[id]]$label1 <- peak_list[[bestpeak]]$label1
msd[[im]][[id]]$label2 <- peak_list[[bestpeak]]$label2 msd[[im]][[id]]$label2 <- peak_list[[bestpeak]]$label2
qsnames <- names( peak_list[[bestpeak]]$qs_list ) qsnames <- names( peak_list[[bestpeak]]$qs_list )
# append qslog info for training (last 2 cols are x12_13c_flags for qs median values) # append qslog info for training (last 2 cols are x12_13c_flags for qs median values)
for(p in 1:length(peak_list)){ for(p in 1:length(peak_list)){
metab_name <- metab[[im]]$name metab_name <- metab[[im]]$name
...@@ -235,7 +235,7 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -235,7 +235,7 @@ peak_detection <- function(metab, smpl, prm) {
peak_RT <- peak_list[[p]]$RT peak_RT <- peak_list[[p]]$RT
qs_scores <- peak_list[[p]]$qs_list qs_scores <- peak_list[[p]]$qs_list
x12_13c_flags <- msd[[im]][[id]]$foundchrom[2:3] x12_13c_flags <- msd[[im]][[id]]$foundchrom[2:3]
if (qslog_i == 1) { if (qslog_i == 1) {
qslog <- c(metab_name,sample_name,peak_id,peak_RT,as.numeric(qs_scores),x12_13c_flags) qslog <- c(metab_name,sample_name,peak_id,peak_RT,as.numeric(qs_scores),x12_13c_flags)
} else { } else {
...@@ -243,24 +243,24 @@ peak_detection <- function(metab, smpl, prm) { ...@@ -243,24 +243,24 @@ peak_detection <- function(metab, smpl, prm) {
} }
qslog_i <- qslog_i + 1 qslog_i <- qslog_i + 1
} }
# Write training data to tsv (quality scores for 1. model) # Write training data to tsv (quality scores for 1. model)
cat('\r', paste(' --> found Metabolite at RT: ', as.character(round(peak_list[[bestpeak]]$RT,2)) ) ) cat('\r', paste(' --> found Metabolite at RT: ', as.character(round(peak_list[[bestpeak]]$RT,2)) ) )
} # -> else for lipids comes here <- } # -> else for lipids comes here <-
} # loop over metabolites } # loop over metabolites
}# loop over samples }# loop over samples
colnames(qslog) = c("Metabolite", "id", "Peak", "RT", qsnames , "12C", "13C") colnames(qslog) = c("Metabolite", "id", "Peak", "RT", qsnames , "12C", "13C")
if (prm$verbose >= 1) { if (prm$verbose >= 1) {
# tsv is saver in case of comma in metabolite or sample name, like fructore 1,6 bisphosphate # tsv is saver in case of comma in metabolite or sample name, like fructore 1,6 bisphosphate
write.table(qslog, file = 'qslog_initial.tsv', sep = '\t', row.names = FALSE) write.table(qslog, file = file.path(prm$batchdir, 'qslog_initial.tsv'), sep = '\t', row.names = FALSE)
} }
msd msd
}# function end }# function end
plot_peaks <- function(metab, smpl, msd, prm) { plot_peaks <- function(metab, smpl, msd, prm) {
# plots of MRMs (quantifier, 12c&13c-qualifier) (n: samples x metabolites) # plots of MRMs (quantifier, 12c&13c-qualifier) (n: samples x metabolites)
# plots peakarea, RT(expected and measured) # plots peakarea, RT(expected and measured)
# adds quality scores to labels (more qs in expertmode) # adds quality scores to labels (more qs in expertmode)
cat('Creating peakoverview.pdf ', file=prm$log_con) cat('Creating peakoverview.pdf ', file=prm$log_con)
print(' ') print(' ')
if(prm$train_path != ""){ if(prm$train_path != ""){
pdf_file <- paste0("peakoverview_", prm$train_path, ".pdf") pdf_file <- paste0("peakoverview_", prm$train_path, ".pdf")
}else{ }else{
pdf_file <- "peakoverview.pdf" pdf_file <- "peakoverview.pdf"
} }
pdf(file = pdf_file, height = 2*prm$nsmpl, width = 5* prm$nmet, family = "Helvetica") pdf(file = file.path(prm$batchdir, pdf_file), height = 2*prm$nsmpl, width = 5* prm$nmet, family = "Helvetica")
par(mai = c(0.5, 0.5, 0.8, 0.5)) par(mai = c(0.5, 0.5, 0.8, 0.5))
layout(matrix(c(1:(prm$nmet*prm$nsmpl)), prm$nsmpl, prm$nmet, byrow = TRUE)) # initiate subplots layout(matrix(c(1:(prm$nmet*prm$nsmpl)), prm$nsmpl, prm$nmet, byrow = TRUE)) # initiate subplots
# Reverse looping and indexing according to Jörg plotting logic (samples first, then metabolites) # Reverse looping and indexing according to Jörg plotting logic (samples first, then metabolites)
for (id in 1:prm$nsmpl){ for (id in 1:prm$nsmpl){
for (im in 1:prm$nmet){ for (im in 1:prm$nmet){
...@@ -25,11 +25,11 @@ plot_peaks <- function(metab, smpl, msd, prm) { ...@@ -25,11 +25,11 @@ plot_peaks <- function(metab, smpl, msd, prm) {
nd <- get_ref_chromatograms(metab, msd, smpl, id, id, im) nd <- get_ref_chromatograms(metab, msd, smpl, id, id, im)
nd$x1 <- nd$x1 - prm$bgoffset nd$x1 <- nd$x1 - prm$bgoffset
nd$x1[nd$x1 < 0] <- 0 nd$x1[nd$x1 < 0] <- 0
nowy <- compressplot(nd$x1) nowy <- compressplot(nd$x1)
nowgoody <- !is.na(nowy) nowgoody <- !is.na(nowy)
textxpos <- min(prm$unirt[nowgoody], na.rm = TRUE) textxpos <- min(prm$unirt[nowgoody], na.rm = TRUE)
if (is.na(msd[[im]][[id]]$peakstart ) || is.na(msd[[im]][[id]]$peakend) ) { if (is.na(msd[[im]][[id]]$peakstart ) || is.na(msd[[im]][[id]]$peakend) ) {
nowgoodplot <- FALSE nowgoodplot <- FALSE
msd[[im]][[id]]$ylim <- 1.1 * max(c(nd$x1, nd$x2, nd$x3), na.rm = TRUE) msd[[im]][[id]]$ylim <- 1.1 * max(c(nd$x1, nd$x2, nd$x3), na.rm = TRUE)
...@@ -37,33 +37,33 @@ plot_peaks <- function(metab, smpl, msd, prm) { ...@@ -37,33 +37,33 @@ plot_peaks <- function(metab, smpl, msd, prm) {
cat('\r', paste('No peak to plot for', metab[[im]]$name, 'in', smpl$samplenames[id],'. ')) cat('\r', paste('No peak to plot for', metab[[im]]$name, 'in', smpl$samplenames[id],'. '))
} }
} }
if (sum(nowgoody) < 2) { if (sum(nowgoody) < 2) {
nowgoodplot <- FALSE nowgoodplot <- FALSE
plot(0) plot(0)
} else { } else {
if (msd[[im]][[id]]$report) { if (msd[[im]][[id]]$report) {
main_col <- "black" main_col <- "black"
} else { } else {
main_col <- "red" main_col <- "red"
} }
if (prm$expertmode) { if (prm$expertmode) {
plot(prm$unirt[nowgoody], nowy[nowgoody] , plot(prm$unirt[nowgoody], nowy[nowgoody] ,
type = 'l', type = 'l',
main = msd[[im]][[id]]$label2, col.main = main_col, main = msd[[im]][[id]]$label2, col.main = main_col,
ylim = msd[[im]][[id]]$ylim, ylim = msd[[im]][[id]]$ylim,
xlab='', ylab='', xlab='', ylab='',
cex.main=0.7) cex.main=0.7)
} else { } else {
plot(prm$unirt[nowgoody], nowy[nowgoody] , plot(prm$unirt[nowgoody], nowy[nowgoody] ,
type = 'l', type = 'l',