#mrbin - Collection of R functions for processing and analyzing metabolomics data.
#Written by Matthias Klein, The Ohio State University
#
#Package: mrbin
#Title: Magnetic Resonance Binning, Integration and Normalization
#Authors@R:
# person(given = "Matthias",
# family = "Klein",
# role = c("aut", "cre"),
# email = "klein.663@osu.edu",
# comment = c(ORCID = "0000-0001-7455-5381"))
#Description: This package is a collection of functions for processing and
# analyzing metabolomics data. The mrbin function converts 1D or 2D nuclear
# magnetic resonance data into a matrix of values
# suitable for further data analysis and performs basic processing steps in a
# reproducible way. Negative values, a common issue in these data, are replaced
# by positive values. All used parameters are stored in a readable text file
# and can be restored from that file to enable exact reproduction of the data
# at a later time.
#License: GPL-3
#' @importFrom grDevices colorRamp heat.colors rainbow rgb devAskNewPage dev.copy dev.off pdf
#' @importFrom graphics axis contour hist legend lines par plot text boxplot points rect polygon box
#' @importFrom stats heatmap median prcomp quantile sd
#' @importFrom utils flush.console select.list write.csv
NULL
#' A function executed when attaching this package
#'
#' This function displays a welcome message.
#' @param libname Library name
#' @param pkgname Package name
#' @return {None}
#' @keywords internal
#' @noRd
#' @examples
#' \donttest{ .onAttach() }
.onAttach <- function(libname, pkgname){
packageStartupMessage("mrbin 1.7.3\nFor instructions and examples, please type: vignette('mrbin')")
}
#' A function executed when loading this package
#'
#' This function resets the parameter variables.
#' @param libname Library name
#' @param pkgname Package name
#' @return {None}
#' @keywords internal
#' @noRd
#' @examples
#' \donttest{ .onLoad() }
.onLoad <- function(libname, pkgname){
assign("mrbin.env",new.env(emptyenv()),parent.env(environment()))
resetEnv()
}
#' A function returning predicted values for use with the fia function.
#'
#' This function predicts group membership and returns a numeric vector with results.
#' @param model A predictive model. Make sure to have loaded all required packages before starting this function
#' @param dataSet A matrix or dataframe containing data, depending on what your predict function requires. Columns=features, rows=samples
#' @param functionNamePredict The name of the prediction function. This only needs to be changed if the prediction function is not called predict
#' @param parameterNameObject The name of the parameter for passing the model to the prediction function
#' @param parameterNameData The name of the parameter for passing the data to the prediction function
#' @param firstLevel Numeric value of first level or group. Usually 1 but for glm such as in the example this needs to be 0.
#' @param dataFrameFlag Logical value indicating whether the data object is a data frame rather than a matrix.
#' @param ... Optional, additional parameters that will be passed to the prediction function.
#' @return A numeric (integer) vector of predicted group memberships.
#' @export
#' @examples
#' #First, define group membership and create the example feature data
#' group<-factor(c(rep("Group1",4),rep("Group2",5)))
#' names(group)<-paste("Sample",1:9,sep="")
#' dataset<-data.frame(
#' Feature1=c(5.1,5.0,6.0,2.9,4.8,4.6,4.9,3.8,5.1),
#' Feature2=c(2.6,4.0,3.2,1.2,3.1,2.1,4.5,6.1,1.3),
#' Feature3=c(3.1,6.1,5.8,5.1,3.8,6.1,3.4,4.0,4.4),
#' Feature4=c(5.3,5.2,3.1,2.7,3.2,2.8,5.9,5.8,3.1),
#' Feature5=c(3.2,4.4,4.8,4.9,6.0,3.6,6.1,3.9,3.5)
#' )
#' rownames(dataset)<-names(group)
#' #train a model - here we use a logit model instead of ANN as a demonstration
#' mod<-glm(group~Feature1+Feature2+Feature3+Feature4+Feature5,
#' data=data.frame(group=group,dataset),family="binomial")
#' predictWrapper(model=mod,dataSet=dataset,firstLevel=0,type="response")
predictWrapper<-function(model,dataSet,functionNamePredict="predict",firstLevel=1,
parameterNameObject="object",parameterNameData="x",dataFrameFlag=FALSE,...){
if(dataFrameFlag) dataSet<-data.frame(dataSet)
predParam<-c(list(model,dataSet),...)
names(predParam)[1]<-parameterNameObject
names(predParam)[2]<-parameterNameData
predictionsTMP<-do.call(functionNamePredict,predParam)
if(is.matrix(predictionsTMP)){#tensorflow ANN output is matrix
predictionsFinal<-apply(predictionsTMP,1,which.max)
} else {
predictionsFinal<-round(predictionsTMP)
}
predictionsFinal<-predictionsFinal+1-firstLevel
return(predictionsFinal)
}
#' A function identifying features of importance.
#'
#' This function finds features that can change the outcomes of a model's prediction.
#' Example: fia=1.00 means single compound found in all but 0 percent of samples.
#' fia=2.45 indicates this compound is found in pairs in all but 45 percent of tested samples
#' A function named predict needs to be present for this to work. If the function name
#' of the prediction function is different, the function name has to be provided in
#' the parameter functionNamePredict.
#' @param model A predictive model. Make sure to have loaded all required packages before starting this function
#' @param dataSet An object containing data, columns=features, rows=samples. This should be either a matrix or a dataframe, depending on which of these two the specific prediction function requires
#' @param factors A factor vector with group membership of each sample in the data set. Order of levels must correspond to the number predicted by the model
#' @param nSeed Number of times that the test will be repeated, selecting different random features
#' @param numberOfSamples Number of samples that will be randomly chosen from each group
#' @param maxFeatures Maximum number of features that will be tested. Larger numbers will be split into child nodes without testing to increase speed
#' @param innerLoop Number of repeated loops to test additional child nodes
#' @param verbose A logical vector to turn messages on or off
#' @param maxNumberAllTests Combinations of features of this length or shorter will not be split in half to create two children, but into multiple children with one feature left out each. This is done make sure no combination is missed.
#' @param firstLevel Numeric value of first level or group. Usually 1 but for glm such as in the example this needs to be 0.
#' @param saveMemory Save memory by performing only two predictions per step, which will be much slower. If you are using keras, use parameter kerasClearMemory=2 instead to free more memory and be a lot faster. FALSE to turn off.
#' @param kerasClearMemory Save memory by clearing model from memory and reloading the model between chunks of predictions. Will only work when using package keras. 0=off, 1=medium (reload between repeat with different seeds), 2=maximum memory savings (reload after each run for a single sample). This will write a model file to the working directory.
#' @param functionNamePredict The name of the prediction function. This only needs to be changed if the prediction function is not called predict
#' @param parameterNameObject The name of the parameter for passing the model to the prediction function
#' @param parameterNameData The name of the parameter for passing the data to the prediction function
#' @param ... Optional, additional parameters that will be passed to the prediction function.
#' @return A list of results: scoresSummary A vector of fia scores for the whole dataset; scores contains vectors of fia scores for each predicted group; scoresIndividual A list of fia scores for each individual sample; fiaListPerSample A list of important combinations of features for each predicted sample; fiaMatrix A list of fia scores for each predicted group.
#' @export
#' @examples
#' #First, define group membership and create the example feature data
#' group<-factor(c(rep("Group1",4),rep("Group2",5)))
#' names(group)<-paste("Sample",1:9,sep="")
#' dataset<-data.frame(
#' Feature1=c(5.1,5.0,6.0,2.9,4.8,4.6,4.9,3.8,5.1),
#' Feature2=c(2.6,4.0,3.2,1.2,3.1,2.1,4.5,6.1,1.3),
#' Feature3=c(3.1,6.1,5.8,5.1,3.8,6.1,3.4,4.0,4.4),
#' Feature4=c(5.3,5.2,3.1,2.7,3.2,2.8,5.9,5.8,3.1),
#' Feature5=c(3.2,4.4,4.8,4.9,6.0,3.6,6.1,3.9,3.5),
#' Feature6=c(6.8,6.7,7.2,7.0,7.3,7.1,7.2,6.9,6.8)
#' )
#' rownames(dataset)<-names(group)
#' #train a model - here we use a logit model instead of ANN as a demonstration
#' mod<-glm(group~Feature1+Feature2+Feature3+Feature4+Feature5+Feature6,
#' data=data.frame(group=group,dataset),family="binomial")
#' fiaresults<-fia(model=mod,dataSet=dataset,factors=group,parameterNameData="newdata",
#' firstLevel=0,type="response")
#' fiaresults$scores
fia<-function(model,dataSet,factors,nSeed=6,numberOfSamples=100,
maxFeatures=10000,innerLoop=300,verbose=TRUE,maxNumberAllTests=5,firstLevel=1,
saveMemory=FALSE,kerasClearMemory=0,functionNamePredict="predict",
parameterNameObject="object",parameterNameData="x",...){
digitDict<-c(1:9,0,letters,LETTERS)#replace number>9 with single digit characters
seedList=(1:nSeed-1)*100
if(is.factor(factors)){
#factors<-droplevels(factors)#this could change the order compared to the ANN
} else {
factors<-factor(factors)
}
dataFrameFlag<-FALSE
if(is.data.frame(dataSet)){
dataSet<-as.matrix(dataSet)
dataFrameFlag<-TRUE
}
if(kerasClearMemory>0){
keras::save_model_tf(object=model,filepath="fiaTMP",overwrite = TRUE,
include_optimizer = TRUE,signatures = NULL, options = NULL)
}
factorsDict<-1:nlevels(factors)-1#-1 is necessary for tensorflow, otherwise usually not
names(factorsDict)<-levels(factors)
lVector<-apply(dataSet,2,quantile,.01)
hVector<-apply(dataSet,2,quantile,.99)
predTMP<-predictWrapper(model=model,dataSet=dataSet,firstLevel=firstLevel,
functionNamePredict=functionNamePredict,parameterNameObject=parameterNameObject,
parameterNameData=parameterNameData,dataFrameFlag=dataFrameFlag,verbose=0
,...
)
predAll<-names(factorsDict)[predTMP]
#Create a sample list
sampleList<-matrix(NA,nrow=nlevels(factors),ncol=min(c(numberOfSamples,
nrow(dataSet))))
sampleList2<-sampleList
for(j in 1:nlevels(factors)){#pick a subset of all samples for testing
set.seed(1) #select samples that are predicted correctly
samplesTMP<-factors==levels(factors)[j]&factors==predAll
if(sum(samplesTMP)==0) message("No samples were present or correctly predicted for ",levels(factors)[j])
repSampleList<-sample(which(samplesTMP),min(c(numberOfSamples,sum(samplesTMP))))
sampleList[j,1:length(repSampleList)]<-repSampleList
sampleList2[j,1:length(repSampleList)]<- rep(levels(factors)[j],length(repSampleList))
}
sampleVector<-as.vector(sampleList2)
names(sampleVector)<-as.vector(sampleList)
sampleVector<-sampleVector[!is.na(sampleVector)]
samplesPositive<-vector("list",length(sampleVector))
names(samplesPositive) <- names(sampleVector)
for(i in 1:length(samplesPositive)){
samplesPositive[[i]]<-list()
}
#for each sample, save single important features
if(verbose){
message("Testing single features\n0% ",appendLF = FALSE)
flush.console()
}
stepSizePercent<-20
steps<-1
#save memory by doing this for each starting seed:
#create matrix prefilled with Nfeatures (first digit of FIA). save here length
#of each saved pair, if lower than previous value
fiaMatrixNew<-matrix(ncol(dataSet),ncol=ncol(dataSet),nrow=length(sampleVector))#nrow=nlevels(factors))
colnames(fiaMatrixNew)<-colnames(dataSet)
rownames(fiaMatrixNew)<-names(sampleVector)#levels(factors)
irepSample<-1
for (irepSample in 1:length(sampleVector)){ #loop over all selected samples
repSample<-names(sampleVector)[irepSample]
dataTMP<-dataSet[rep(as.numeric(repSample),2*ncol(dataSet)),,drop=FALSE]
dataTMP[cbind(1:ncol(dataSet),1:ncol(dataSet))]<-
lVector[1:ncol(dataSet)] #replace value by low value
dataTMP[cbind(ncol(dataSet)+1:ncol(dataSet),1:ncol(dataSet))]<-
hVector[1:ncol(dataSet)] #replace value by high value
predTMP<-predictWrapper(model=model,dataSet=dataTMP,firstLevel=firstLevel,
functionNamePredict=functionNamePredict,parameterNameObject=parameterNameObject,
parameterNameData=parameterNameData,dataFrameFlag=dataFrameFlag
,verbose=0,...
)
pred<-names(factorsDict)[predTMP]
iSingle<-1
for(iSingle in 1:ncol(dataSet)){
if(sum(!pred[c(iSingle,iSingle+ncol(dataSet))]==
sampleVector[repSample])>0){#check low and high levels
samplesPositive[[repSample]]<-c(
samplesPositive[[repSample]],colnames(dataSet)[iSingle])
fiaMatrixNew[repSample,iSingle]<-1
}
}
if(irepSample/length(sampleVector)>=steps*stepSizePercent/100){
if(verbose){
message(steps*stepSizePercent,"% ",appendLF = FALSE)
flush.console()
if(irepSample==length(sampleVector) ) message("\n",appendLF = FALSE)
}
steps<-steps+1
}
}
if(verbose){
message("Testing combinations of features\n0% ",appendLF = FALSE)
flush.console()
}
stepSizePercent<-20
steps<-1
steps2<-1
for(iSeed2 in 1:length(seedList)){ #repeat for different starting seeds
iSeed<-seedList[iSeed2]
fiaListL<-list()
irepSample<-1#debug
for (irepSample in 1:length(sampleVector)){ #loop over all selected samples
repSample<-names(sampleVector)[irepSample]
i2<-1
i3<-"1."#. means do not test
fiaResults <- vector("list", ceiling(log2(ncol(dataSet)))+10)
for(iTMP in 1:length(fiaResults)){
fiaResults[[iTMP]] <- list()
}
#remove positive single hits
positiveSingleTMP<-setdiff(colnames(dataSet),
samplesPositive[[repSample]])
if(length(positiveSingleTMP)>0) fiaResults[[i2]][[i3]]<-positiveSingleTMP
for(iInnerLoop in 1:innerLoop){
seedInnerLoop<-(iInnerLoop-1)*1000
if(length(fiaResults)>0){
for(i2 in 1:length(fiaResults)){
if(length(fiaResults[[i2]])>0){
i3TMP<-names(fiaResults[[i2]])#to avoid skipping after deleting entries
if(!saveMemory){
if(i2==1|length(fiaResults[[i2]][[1]])>=maxFeatures){
pred2=rep("",2*length(fiaResults[[i2]]))
} else {
dataTMP<-dataSet[rep(as.numeric(repSample),2*length(fiaResults[[i2]])),,drop=FALSE]
for(iPredTMP in 1:length(fiaResults[[i2]])){
dataTMP[iPredTMP,fiaResults[[i2]][[iPredTMP]]]<-
lVector[fiaResults[[i2]][[iPredTMP]]] #replace value by low value
dataTMP[length(fiaResults[[i2]])+iPredTMP,fiaResults[[i2]][[iPredTMP]]]<-
hVector[fiaResults[[i2]][[iPredTMP]]] #replace value by high value
}
predTMP<-predictWrapper(model=model,dataSet=dataTMP,firstLevel=firstLevel,
functionNamePredict=functionNamePredict,
parameterNameObject=parameterNameObject,
parameterNameData=parameterNameData,dataFrameFlag=dataFrameFlag,verbose=0
,...
)
pred2<-names(factorsDict)[predTMP]
rm(predTMP)
}
}
#i3b<-1
for(i3b in 1:length(i3TMP)){
i3<-i3TMP[i3b]
if(saveMemory){
if(i2==1|length(fiaResults[[i2]][[i3]])>=maxFeatures){
pred<-"" #first step(s) assumed to be positive
} else {
dataTMP<-dataSet[c(as.numeric(repSample),as.numeric(repSample)),,drop=FALSE]
dataTMP[1,fiaResults[[i2]][[i3]]]<-lVector[fiaResults[[i2]][[i3]]] #replace value i by low value
dataTMP[2,fiaResults[[i2]][[i3]]]<-hVector[fiaResults[[i2]][[i3]]] #replace value i by high value
predTMP<-predictWrapper(model=model,dataSet=dataTMP,firstLevel=firstLevel,
functionNamePredict=functionNamePredict,
parameterNameObject=parameterNameObject,
parameterNameData=parameterNameData,dataFrameFlag=dataFrameFlag
,verbose=0,...
)
pred<-names(factorsDict)[predTMP]
rm(predTMP)
}
} else {
pred<-pred2[c(i3b,length(i3TMP)+i3b)]
}
parentNameTMP<-substr(i3,1,nchar(i3)-2)
if(sum(!pred==sampleVector[repSample])==0){#correct prediction
#if all children were checked and the parent is still there,
#this means the parent is positive while all children are negative.
#in this case the parent will be saved to the list and then deleted
if(which(digitDict==substr(i3,nchar(i3)-1,nchar(i3)-1))==
(length(fiaResults[[i2]][[i3]])+1)){#this indicates that all children have been tested
if(i2>1){#save parent
if(!is.null(fiaResults[[i2-1]][[parentNameTMP]])){
for(ifiaMatrixNew in 1:length(fiaResults[[i2-1]][[parentNameTMP]])){#check all features
if(length(fiaResults[[i2-1]][[parentNameTMP]])<fiaMatrixNew[repSample,fiaResults[[i2-1]][[parentNameTMP]][ifiaMatrixNew]]){
fiaMatrixNew[repSample,fiaResults[[i2-1]][[parentNameTMP]][[ifiaMatrixNew]]]<-length(fiaResults[[i2-1]][[parentNameTMP]])
}
}
fiaResults[[i2-1]][[parentNameTMP]]<-NULL
}
}
}
fiaResults[[i2]][[i3]]<-NULL
} else {#incorrect prediction, i.e. positive result
if(i2>1){#delete parent
fiaResults[[i2-1]][[parentNameTMP]]<-NULL
}
#split into two children by selecting half of features
if(length(fiaResults[[i2]][[i3]])>maxNumberAllTests){
set.seed(i2+iSeed+seedInnerLoop)
fiaResults[[i2+1]][[paste(i3,"1-",sep="",collapse="")]]<-
sort(sample(fiaResults[[i2]][[i3]],ceiling(length(
fiaResults[[i2]][[i3]])/2)),decreasing=TRUE)
fiaResults[[i2+1]][[paste(i3,"2-",sep="",collapse="")]]<-
(setdiff(fiaResults[[i2]][[i3]],fiaResults[[i2+1]][[
paste(i3,"1-",sep="",collapse="")]]))
} else {#split low numbers manually by leaving one out each
iLowNumbers<-length(fiaResults[[i2]][[i3]])
for(iLowNumbers2 in 1:iLowNumbers){
fiaResults[[i2+1]][[paste(i3,digitDict[iLowNumbers2]
,"-",sep="",collapse="")]]<-
fiaResults[[i2]][[i3]][setdiff(
1:iLowNumbers,iLowNumbers2)]
}
}
}
}
}
}
}
}
samplesTestedAdditionalTMP<-unlist(
fiaResults[which(lapply(fiaResults,length)>0)],recursive=FALSE)
if(length(samplesTestedAdditionalTMP)>0){
for(ifiaList in 1:length(samplesTestedAdditionalTMP)){
for(ifiaMatrixNew in 1:length(samplesTestedAdditionalTMP[[ifiaList]])){#check all features
if(length(samplesTestedAdditionalTMP[ifiaList])<fiaMatrixNew[repSample,samplesTestedAdditionalTMP[[ifiaList]][[ifiaMatrixNew]]]){
fiaMatrixNew[repSample,samplesTestedAdditionalTMP[[ifiaList]][[ifiaMatrixNew]]]<-length(samplesTestedAdditionalTMP[[ifiaList]])
}
}
}
rm(samplesTestedAdditionalTMP)
}
if(steps2/(length(seedList)*length(sampleVector))>=steps*stepSizePercent/100){
if(verbose){
message(steps*stepSizePercent,"% ",appendLF = FALSE)
flush.console()
if(steps2>=(length(seedList)*length(sampleVector))){
if(steps*stepSizePercent<100) message("100% ",appendLF = FALSE)
message("\n",appendLF=FALSE)
flush.console()
}
}
steps<-steps+1
}
steps2<-steps2+1
gc()
if(kerasClearMemory==2){
keras::k_clear_session()
keras::load_model_tf(filepath="fiaTMP",custom_objects=NULL, compile=TRUE)
}
}
if(kerasClearMemory>0){
keras::k_clear_session()
keras::load_model_tf(filepath="fiaTMP",custom_objects=NULL, compile=TRUE)
}
}
#calculate fia scores for the whole data set
fiaMatrix<-fiaMatrixNew
fiaMatrixTMP<-fiaMatrix
fiaAllTMP<-apply(fiaMatrixTMP,2,min,na.rm=TRUE)
fiaAll<-sort(fiaAllTMP+(1-apply(fiaMatrixTMP==matrix(rep(fiaAllTMP,nrow(fiaMatrixTMP)),
nrow=nrow(fiaMatrixTMP),byrow=TRUE),2,sum,na.rm=TRUE)/nrow(fiaMatrixTMP)))
#fia scores per group
scores<-vector("list",nlevels(factors))
names(scores)<-levels(factors)
for(iScores in 1:length(scores)){
if(sum(sampleVector[rownames(fiaMatrix)]==names(scores)[iScores])>0){
fiaMatrixTMP<-fiaMatrix[sampleVector[rownames(fiaMatrix)]==names(scores)[
iScores],,drop=FALSE]
fiaAllTMP<-apply(fiaMatrixTMP,2,min,na.rm=TRUE)
scores[[iScores]]<-sort(fiaAllTMP+(1-apply(fiaMatrixTMP==matrix(rep(
fiaAllTMP,nrow(fiaMatrixTMP)),
nrow=nrow(fiaMatrixTMP),byrow=TRUE),2,sum,na.rm=TRUE)/nrow(fiaMatrixTMP)))
}
}
#fia scores per sample
scoresIndividual<-vector("list",nrow(fiaMatrix))
names(scoresIndividual)<-rownames(fiaMatrix)
for(iScores in 1:length(scoresIndividual)){
fiaMatrixTMP<-fiaMatrix[iScores,,drop=FALSE]
fiaAllTMP<-apply(fiaMatrixTMP,2,min,na.rm=TRUE)
scoresIndividual[[iScores]]<-sort(fiaAllTMP+(1-apply(fiaMatrixTMP==matrix(rep(
fiaAllTMP,nrow(fiaMatrixTMP)),
nrow=nrow(fiaMatrixTMP),byrow=TRUE),2,sum,na.rm=TRUE)/nrow(fiaMatrixTMP)))
}
return(list(
scores=scores,
scoresSummary=fiaAll,
scoresIndividual=scoresIndividual,
fiaMatrix=fiaMatrix))
}
#' A function replacing negative values.
#'
#' This function replaces (column-wise) negative values by a small positive
#' number. The number is calculated as an affine transformation to the range of
#' the lowest positive number to 0,01*the lowest positive number (of this
#' column). Ranks stay unchanged. Positive numbers are not altered.
#' If sample-wise noise levels are available, the median noise level of samples
#' with negative values is calculated and replaces the lowest positive number in
#' case it is smaller. If no noise data is available, the 1% percentile of all
#' positive values in the data set is used as an estimate.
#' It is recommended to us this function AFTER noise removal and other data
#' clean-up methods, as it may alter (reduce) the noise level.
#' @param NMRdata A matrix or mrbin object containing NMR data. For matrix: columns=frequencies,rows=samples
#' @param noiseLevels A vector (can be omitted if NMRdata is an mrbin object)
#' @param verbose Should a summary be displayed if NMRdata is an mrbin object
#' @param errorsAsWarnings If TRUE, errors will be turned into warnings. Should be used with care, as errors indicate undocumented changes to the data.
#' @return An invisible matrix or mrbin object containing NMR data without negative values.
#' @export
#' @examples
#' resetEnv()
#' Example<-mrbin(silent=TRUE,
#' parameters=list(verbose=TRUE,dimension="1D",PQNScaling="No",
#' binwidth1D=0.005,signal_to_noise1D=1,PCA="No",binRegion=c(9.5,7.5,10,156),
#' saveFiles="No",referenceScaling="No",noiseRemoval="No",
#' fixNegatives="No",logTrafo="No",noiseThreshold=.05,
#' NMRfolders=c(system.file("extdata/2/10/pdata/10",package="mrbin"),
#' system.file("extdata/3/10/pdata/10",package="mrbin"))
#' ))
#' sum(Example$bins<=0)
#' exampleNMRpositive<-atnv(NMRdata=Example$bins, noiseLevels=Example$parameters$noise_level_adjusted)
#' sum(exampleNMRpositive<=0)
atnv<-function(NMRdata,noiseLevels=NULL,verbose=TRUE,errorsAsWarnings=FALSE){
NMRdata2<-NMRdata
if(methods::is(NMRdata,"mrbin")){
transformations="Atnv transformed"
if(transformations %in% NMRdata$transformations){
if(!errorsAsWarnings) stop("Data has been atnv transformed previously, this could corrupt the data.")
warning("Data has been atnv transformed previously, this could corrupt the data.")
}
if("Log transformed" %in% NMRdata$transformations){
if(!errorsAsWarnings) stop("Data has been log transformed previously, this would corrupt the data.")
warning("Data has been log transformed previously, this would corrupt the data.")
}
NMRdataTMP <- NMRdata$bins
noiseLevels <- apply(NMRdata$parameters$noise_level,1,median)
} else {
NMRdataTMP<-NMRdata
}
if(is.null(noiseLevels)){
noiseTMP<-sort(NMRdataTMP[NMRdataTMP>0])[ceiling(.01*length(NMRdataTMP[
NMRdataTMP>0]))]
}
for(i in 1:ncol(NMRdataTMP)){
negatives<-NMRdataTMP[,i]<=0
if(sum(negatives)>0){
if(!is.null(noiseLevels)){#If noise levels are available, restrict range to below noise
noiseTMP<-stats::median(noiseLevels[negatives])
}
minTMP<-min(NMRdataTMP[negatives,i])#select lowest bin
if(sum(!negatives)>0){
maxTMP<-min(noiseTMP,min(NMRdataTMP[!negatives,i]))#select lowest bin above 0
} else {
maxTMP<-noiseTMP
}
NMRdataTMP[negatives,i]<-(NMRdataTMP[negatives,i]+(maxTMP-minTMP))/
(maxTMP-minTMP)*(maxTMP*.99)+
maxTMP*.01
}
}
if(methods::is(NMRdata,"mrbin")){
if(nrow(NMRdata$bins)==1){
NMRdata$bins<-matrix(NMRdataTMP,nrow=1)
rownames(NMRdata$bins)<-rownames(NMRdataTMP)
colnames(NMRdata$bins)<-colnames(NMRdataTMP)
} else {
NMRdata$bins<-NMRdataTMP
}
} else {
NMRdata<-NMRdataTMP
}
if(methods::is(NMRdata,"mrbin")){
NMRdata2<-editmrbin(mrbinObject=NMRdata2,functionName="mrbin::atnv",
versionNumber=as.character(utils::packageVersion("mrbin")),
bins=NMRdata$bins, parameters=NMRdata$parameters,transformations=transformations,
verbose=verbose)
NMRdata<-NMRdata2
}
invisible(NMRdata)
#}
}
#' A parameter resetting function
#'
#' This function resets the parameter variables.
#' @return {None}
#' @export
#' @examples
#' resetEnv()
resetEnv<-function(){
if(!exists("mrbin.env", mode="environment")) .onLoad()
#assign("bins",NULL,mrbin.env)
#assign("paramChangeFlag",FALSE,mrbin.env)
assign("mrbinTMP",list(
#mrbinversion=as.character(utils::packageVersion("mrbin")),
#binsRaw=NULL,
medians=NULL,
noise_level_TMP=NULL,
noise_level_Raw_TMP=NULL,
meanNumberOfPointsPerBin=NULL,
meanNumberOfPointsPerBin_TMP=NULL,
#PCA=NULL,
binTMP=NULL,
binNames=NULL,
nbins1=NULL,
nbins2=NULL,
nbins=NULL,
currentFolder=NULL,
currentSpectrum=NULL,
currentSpectrumOriginal=NULL,
currentSpectrumName=NULL,
currentSpectrumFolderName=NULL,
currentSpectrumEXPNO=NULL,
currentSpectrumFolderName_EXPNO=NULL,
currentSpectrumTitle=NULL,
i=1,
additionalPlots1D=NULL,
additionalPlots1DMetadata=NULL,
additionalPlots2D=NULL,
additionalPlots2DMetadata=NULL,
spectrumListPlotTMP=NULL,
timeEstimate=0,
scaleFactorTMP1=NULL,
scaleFactorTMP2=NULL,
scaleFactorTMP3=NULL
),mrbin.env)
assign("requiredParam",c(
"dimension","binMethod","specialBinList","binRegion","referenceScaling",
"removeSolvent","solventRegion","removeAreas","removeAreaList",
"sumBins","sumBinList",
"noiseRemoval","noiseThreshold","dilutionCorrection","PQNScaling",
"fixNegatives","logTrafo","unitVarianceScaling","PQNminimumFeatures",
"PQNIgnoreSugarArea","PQNsugarArea","saveFiles","useAsNames","outputFileName",
"PCAtitlelength","PCA","tryParallel","NMRfolders"
),mrbin.env)
assign("requiredParam1D",c(
"binwidth1D","reference1D","signal_to_noise1D","noiseRange1d",
mrbin.env$requiredParam
),mrbin.env)
assign("requiredParam2D",c(
"binwidth2D","binheight","reference2D","signal_to_noise2D","cropHSQC",
"noiseRange2d","croptopRight","croptopLeft","cropbottomRight","cropbottomLeft",
mrbin.env$requiredParam
),mrbin.env)
assign("requiredMetadata",c(
"projectTitle","projectIdentifier","projectDescription","projectAuthors",
"projectApprovals","sampleType","organism","solvent","pH","dilutionFactors",
"factors","metaData","metaboliteIdentities"
),mrbin.env)
assign("mrbin", createmrbin(),mrbin.env)
assign("parameters_copy",mrbin.env$mrbin$parameters,mrbin.env)
assign("mrbinplot",list(
lowestContour=.01,
plotRegion=NULL,
intensityScale=1,
intensityScale2D=1,
intensityOffset=0,
nContours=30,#60
heatmap=FALSE),mrbin.env)
}
#' A function setting the parameters and performing binning and data processing
#'
#' This function guides the user through the set-up of parameters, starts binning
#' and performs the chosen data processing steps.
#' If a list of parameters is provided and silent is set to TRUE, no user input
#' is requested and binning and data processing are performed silently.
#' @param parameters Optional: A list of parameters, see examples for details. If omitted, the user will be asked through a series of question to set the parameters.
#' @param metadata Optional: A list of metadata. If omitted, the user can add metadata after generating bin data.
#' @param silent If TRUE, the user will be asked no questions and binning and data analysis will run according to the current parameters. Defaults to FALSE.
#' @param setDefault If TRUE, all current parameters will be replaced by the default parameters (before loading any provided parameters sets). Defaults to FALSE.
#' @return An invisible object of type "mrbin" containing bins (data after processing), parameters, and factors
#' @export
#' @examples
#' # Set parameters in command line.
#' mrbinResults<-mrbin(silent=TRUE,setDefault=TRUE,parameters=list(
#' dimension="1D",binwidth1D=0.01,tryParallel=FALSE,
#' signal_to_noise1D=25,noiseThreshold=0.75,
#' NMRfolders=c(
#' system.file("extdata/1/10/pdata/10",package="mrbin"),
#' system.file("extdata/2/10/pdata/10",package="mrbin"),
#' system.file("extdata/3/10/pdata/10",package="mrbin"))
#' ))
mrbin<-function(silent=FALSE,setDefault=FALSE,parameters=NULL,metadata=NULL){
if(!exists("mrbin.env", mode="environment")) .onLoad()
if(setDefault) resetEnv()
if(!is.null(parameters)) setParam(parameters=parameters)
if(!is.null(metadata)) setParam(metadata=metadata)
if(!is.null(mrbin.env$mrbin$parameters$Factors)){
mrbin.env$mrbin$metadata$factors<-mrbin.env$mrbin$parameters$Factors #for backward compatibility
mrbin.env$mrbin$parameters$Factors<-NULL
}
stopTMP<-FALSE
selectionRepeat<-""
#if(silent){
startmrbin<-"Start binning now"
#}
restart<-TRUE
while(restart){#for restarting during data review
restart<-FALSE
mrbin.env$mrbin$parameters$warningMessages<-NULL
if(!silent){
if(Sys.info()['sysname']=='Darwin'){#On Apple or Mac computer, display a hint for installing Quartz
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: If you see text lists instead of dialog boxes, please install xquartz \nfrom https://www.xquartz.org")
utils::flush.console()
}
}
selectStep<--3
lastStepDone<-FALSE
while(!lastStepDone&!stopTMP){
if(selectStep==-3){#Show hints
if(!mrbin.env$mrbin$parameters$verbose){
selectTMPNo<-"Do not show verbose hints and results"
selectTMPYes<-"Show verbose hints and results (recommended)"
selection<-utils::select.list(c(selectTMPYes,selectTMPNo),preselect=selectTMPYes,
title="Show verbose hints?",graphics=TRUE)
if(length(selection)==0|selection=="") stopTMP<-TRUE
if(!stopTMP){
if(selection==selectTMPYes) mrbin.env$mrbin$parameters$verbose<-TRUE
if(selection==selectTMPNo) mrbin.env$mrbin$parameters$verbose<-FALSE
}
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==-2){#Use parallel
if(!mrbin.env$mrbin$parameters$tryParallel){
selectTMPNo<-"Do not use parallel computing"
selectTMPYes<-"Use parallel package for speed"
selection<-utils::select.list(c(selectTMPYes,selectTMPNo),preselect=selectTMPYes,
title="Try parallel computing for speed?",graphics=TRUE)
if(length(selection)==0|selection=="") stopTMP<-TRUE
if(!stopTMP){
if(selection==selectTMPYes) mrbin.env$mrbin$parameters$tryParallel<-TRUE
if(selection==selectTMPNo) mrbin.env$mrbin$parameters$tryParallel<-FALSE
}
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==-1){#Show previews or not
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="No"){
selectTMPNo<-"Do not show previews (e.g. for slow hardware)"
selectTMPYes<-"Show spectrum previews (recommended)"
selection<-utils::select.list(c(selectTMPYes,selectTMPNo#,"Go back"
),preselect=selectTMPYes,
title="Show spectrum previews?",graphics=TRUE)
if(length(selection)==0|selection=="") stopTMP<-TRUE
if(!stopTMP){
if(selection==selectTMPYes) mrbin.env$mrbin$parameters$showSpectrumPreview<-"Yes"
if(selection==selectTMPNo) mrbin.env$mrbin$parameters$showSpectrumPreview<-"No"
}
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==0){#Set parameters
selectionNewTMP<-NULL
if(!is.null(mrbin.env$mrbin$parameters$NMRfolders)) selectionNewTMP<-c(
selectionNewTMP,"Use current parameters without changes")
selectionNewTMP<-c(selectionNewTMP,"Review parameters","Reload from file")
selectionRepeat<-utils::select.list(c(selectionNewTMP),preselect="Review parameters",
title="Edit parameters or use existing?",graphics=TRUE)
if(length(selectionRepeat)==0|selectionRepeat=="") stopTMP<-TRUE
if(selectionRepeat=="Reload from file"&!stopTMP){
recreatemrbin()
selectionRepeat2<-utils::select.list(c("Edit parameters","Use parameters from file without changes",
"Go back"),
preselect="Edit parameters",
title="Edit parameters or use as is?",graphics=TRUE)
if(length(selectionRepeat2)==0|selectionRepeat=="") stopTMP<-TRUE
if(selectionRepeat2=="Review parameters"&!stopTMP) selectionRepeat<-"Review parameters"
if(selectionRepeat2=="Use parameters from file without changes"&!stopTMP) selectionRepeat<-"Use current parameters"
}
if(!stopTMP&selectionRepeat=="Go back") selectStep<-selectStep-2
if(!stopTMP) selectStep<-selectStep+1
}
if(selectionRepeat=="Use current parameters without changes"&!stopTMP){
selectStep<-14
lastStepDone<-TRUE
}
if(selectionRepeat=="Review parameters"&!stopTMP){
if(selectStep==1){#1D or 2D data?
dimension<-utils::select.list(c("1D","2D","Go back"),
preselect=mrbin.env$mrbin$parameters$dimension,
title="1D or 2D spectra?",graphics=TRUE)
if(length(dimension)==0|dimension=="") stopTMP<-TRUE
if(!stopTMP&!dimension=="Go back"){
if(dimension%in%c("1D","2D")){
mrbin.env$mrbin$parameters$dimension<-dimension
if(dimension=="1D") dimlength<-2
if(dimension=="2D") dimlength<-4
}
}
if(!stopTMP&dimension=="Go back") selectStep<-selectStep-2
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==2){#Select folders
if(!stopTMP){
addFoldersTMP<-""
if(length(mrbin.env$mrbin$parameters$NMRfolders)>0){
selectionFoldersYes<-paste("Keep current list (",length(mrbin.env$mrbin$parameters$NMRfolders),
" spectra)",sep="")
selectionFolders<-utils::select.list(c("Create new spectra list",selectionFoldersYes,
"Add or remove spectra from current list","Go back"),
preselect=selectionFoldersYes,
title="Use current spectra list?",graphics=TRUE)
if(length(selectionFolders)==0|selectionFolders=="") stopTMP<-TRUE
if(!stopTMP){
if(selectionFolders=="Create new spectra list"){
selectionFolders<-selectFolders()
if(selectionFolders=="stop") stopTMP<-TRUE
}
}
if(!stopTMP){
if(selectionFolders=="Add or remove spectra from current list"){
removeSpectrum()
addFoldersTMP<-utils::select.list(c("Add spectra to list","Keep list",
"Go back"),
preselect="Keep list",
title="Add spectra to list?",graphics=TRUE)
if(length(addFoldersTMP)==0|addFoldersTMP=="") stopTMP<-TRUE
if(!stopTMP){
if(addFoldersTMP=="Add spectra to list"){
selectionFolders<-selectFolders(keep=TRUE)
if(selectionFolders=="stop") stopTMP<-TRUE
}
}
}
}
} else {
selectionFolders<-selectFolders()
if(selectionFolders=="stop") stopTMP<-TRUE
#if(selectionFolders=="") stopTMP<-TRUE
}
}
if(!stopTMP){
if((selectionFolders=="Go back"|addFoldersTMP=="Go back")){
selectStep<-selectStep-2
} else {
if(length(mrbin.env$mrbin$parameters$NMRfolders)<1) selectStep<-selectStep-1
}
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==3){
if(!stopTMP){#load spectra for previews
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Review spectra to spot quality issues")
utils::flush.console()
}
previewTMP<-utils::select.list(c("Review spectra","Do not review spectra","Go back"),
preselect="Review spectra",
,title ="Review spectra?",graphics=TRUE)
if(length(previewTMP)==0|previewTMP=="") stopTMP<-TRUE
if(!stopTMP){
if(!previewTMP=="Go back"){
if(previewTMP=="Review spectra"){
ipreviewTMP<-1
while(ipreviewTMP <=length(mrbin.env$mrbin$parameters$NMRfolders)){
mrbin.env$mrbinTMP$currentFolder<-mrbin.env$mrbin$parameters$NMRfolders[ipreviewTMP]
readNMR2()
plotTitleTMP<-mrbin.env$mrbinTMP$currentFolder
if(nchar(plotTitleTMP)>56) plotTitleTMP<-paste("...",substr(
plotTitleTMP,nchar(plotTitleTMP)-52,nchar(plotTitleTMP)),sep="")
plotNMR(plotTitle=plotTitleTMP,region="all",manualScale=FALSE)
previewTMP2List<-NULL
if(ipreviewTMP<length(mrbin.env$mrbin$parameters$NMRfolders)){
nextTMP<-"Show next spectrum"
} else {
nextTMP<-"Continue"
}
previewTMP2List<-c(previewTMP2List,nextTMP)
if(ipreviewTMP>1) previewTMP2List<-c(previewTMP2List,"Show previous spectrum")
previewTMP2List<-c(previewTMP2List,"Skip review")
previewTMP2<-utils::select.list(previewTMP2List,
preselect=nextTMP,
,title =paste("Spectrum ",ipreviewTMP," quality okay?",sep=""),graphics=TRUE)
if(length(previewTMP2)==0|previewTMP2==""){
ipreviewTMP<-length(mrbin.env$mrbin$parameters$NMRfolders)+1
} else {
if(previewTMP2==nextTMP) ipreviewTMP<-ipreviewTMP+1
if(previewTMP2=="Show previous spectrum") ipreviewTMP<-ipreviewTMP-1
if(previewTMP2=="Skip review") ipreviewTMP<-length(mrbin.env$mrbin$parameters$NMRfolders)+1
}
}
}
} else {
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
}
if(selectStep==4){
if(!stopTMP){#load spectra for previews
if(mrbin.env$mrbin$parameters$verbose){
message("Loading spectrum preview...")
utils::flush.console()
}
mrbin.env$mrbinTMP$currentFolder<-mrbin.env$mrbin$parameters$NMRfolders[1]
mrbin.env$mrbinTMP$timeEstimate<-max(.001,system.time(readNMR2())[1])
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes"|mrbin.env$mrbin$parameters$PCA=="Yes"){
#if(mrbin.env$mrbin$parameters$dimension=="2D"){
# #Set values below noise to zero, noise estimated from 90% percentile
# if(sum(mrbin.env$mrbinTMP$currentSpectrumOriginal>(3.5*sort(
# mrbin.env$mrbinTMP$currentSpectrumOriginal)[floor(length(
# mrbin.env$mrbinTMP$currentSpectrumOriginal)*.9)]))>300){
# mrbin.env$mrbinTMP$currentSpectrumOriginal[
# mrbin.env$mrbinTMP$currentSpectrumOriginal<=(3.5*sort(
# mrbin.env$mrbinTMP$currentSpectrumOriginal)[floor(length(
# mrbin.env$mrbinTMP$currentSpectrumOriginal)*.9)])]<-1e-8
# } else {
# mrbin.env$mrbinTMP$currentSpectrumOriginal[
# mrbin.env$mrbinTMP$currentSpectrumOriginal<(sort(
# mrbin.env$mrbinTMP$currentSpectrumOriginal,decreasing=TRUE)[300])]<-1e-8
# }
#}
mrbin.env$mrbinTMP$additionalPlots1D<-NULL
mrbin.env$mrbinTMP$additionalPlots1DMetadata<-NULL
mrbin.env$mrbinTMP$additionalPlots2D<-NULL
mrbin.env$mrbinTMP$additionalPlots2DMetadata<-NULL
#Find 3 more spectra: 33 percentile, 66 percentile, last spectrum
mrbin.env$mrbinTMP$spectrumListPlotTMP<-setdiff(unique(c(
ceiling(length(mrbin.env$mrbin$parameters$NMRfolders)*.33),
ceiling(length(mrbin.env$mrbin$parameters$NMRfolders)*.66),
length(mrbin.env$mrbin$parameters$NMRfolders))),1)
if(length(mrbin.env$mrbinTMP$spectrumListPlotTMP)>0){
#for 2D load and plot less spectra to save time
if(mrbin.env$mrbin$parameters$dimension=="2D"){
mrbin.env$mrbinTMP$spectrumListPlotTMP<-mrbin.env$mrbinTMP$spectrumListPlotTMP[1:
min(mrbin.env$mrbin$parameters$maxPreviewPlots2D-1,length(mrbin.env$mrbinTMP$spectrumListPlotTMP))]
}
for(ispectrumListPlotTMP in 1:length(mrbin.env$mrbinTMP$spectrumListPlotTMP)){
addToPlot(folder=mrbin.env$mrbin$parameters$NMRfolders[
mrbin.env$mrbinTMP$spectrumListPlotTMP[ispectrumListPlotTMP]],
dimension=mrbin.env$mrbin$parameters$dimension,
NMRvendor=mrbin.env$mrbin$parameters$NMRvendor,
useAsNames=mrbin.env$mrbin$parameters$useAsNames)
}
#if(mrbin.env$mrbin$parameters$dimension=="2D"){
# for(iReducePlotsTMP in 1:length(mrbin.env$mrbinTMP$additionalPlots2D)){
# #Set values below noise to zero, noise estimated from 90% percentile
# if(sum(mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP]>(3.5*sort(
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP])[floor(length(
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP])*.9)]))>300){
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP][
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP]<=(3.5*sort(
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP])[floor(length(
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP])*.9)])]<-1e-8
# } else {
## mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP][
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP]<(sort(
# mrbin.env$mrbinTMP$additionalPlots2D[iReducePlotsTMP],decreasing=TRUE)[300])]<-1e-8
# }
# }
#}
}
}
}
if(!stopTMP){#Use rectangular bins or use special bin list, e.g. for lipids
binMethodpreSelect<-mrbin.env$mrbin$parameters$binMethod
userDefBinTMP<-"User defined bin list, e.g. for lipid analysis"
if(binMethodpreSelect=="Custom bin list") binMethodpreSelect<-userDefBinTMP
binMethod<-utils::select.list(c("Rectangular bins",userDefBinTMP,"Go back"),
preselect=binMethodpreSelect,
,title ="Binning method: ",graphics=TRUE)
if(length(binMethod)==0|binMethod=="") stopTMP<-TRUE
if(!stopTMP){
if(!binMethod=="Go back"){
if(binMethod==userDefBinTMP) binMethod<-"Custom bin list"
mrbin.env$mrbin$parameters$binMethod<-binMethod
#Bin region
adjRegion<-""
if(mrbin.env$mrbin$parameters$binMethod=="Rectangular bins"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Include all visible peaks, excluding reference")
utils::flush.console()
}
accept<-FALSE
while(!accept&!stopTMP){
binRegionText<-paste(paste(c("left=","ppm, right=","ppm, top=","ppm, bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$binRegion[1:dimlength],collapse="",sep=""),"ppm",sep="")
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes"){
par(mfrow=c(1,1),mar=c(5.1,4.1,4.1,2.1))
plotMultiNMR(region="all",
rectangleRegions=matrix(mrbin.env$mrbin$parameters$binRegion,ncol=4),
color="black",manualScale=FALSE,maxPlots=2,
plotTitle=paste("Bin region\n",binRegionText,
sep=""))
}
adjRegion<-utils::select.list(c(paste("Keep: ",binRegionText,collapse=""),
"Change..."),preselect=paste("Use ",binRegionText,collapse=""),
title ="Bin region [ppm]: ",graphics=TRUE)
if(length(adjRegion)==0|adjRegion=="") stopTMP<-TRUE
if(!stopTMP){
if(adjRegion=="Change..."&!stopTMP){
regionTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$binRegion[1],": ",sep=""))
if(!regionTMP==""){
mrbin.env$mrbin$parameters$binRegion[1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$binRegion[2],": ",sep=""))
if(!regionTMP==""){
mrbin.env$mrbin$parameters$binRegion[2]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$dimension=="2D"){
regionTMP<-readline(prompt=paste("New top border, press enter to keep ",
mrbin.env$mrbin$parameters$binRegion[3],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$binRegion[3]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$binRegion[4],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$binRegion[4]<-as.numeric(regionTMP)
}
}
} else {
accept<-TRUE
}
}
}
}
} else {
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
}
if(selectStep==5){ #Define bin width and height
adjbinRegion<-""
addbinRegion<-""
if(mrbin.env$mrbin$parameters$dimension=="1D"&!stopTMP&mrbin.env$mrbin$parameters$binMethod=="Rectangular bins"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Should be broader than a single peak and include some margin. Gray\ncrosses indicate data point locations")
utils::flush.console()
}
accept<-FALSE
widthAdjust<-""
while(!accept&!stopTMP&!widthAdjust=="Go back"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes"){
par(mfrow=c(1,1),mar=c(5.1,4.1,4.1,2.1))
plotMultiNMR(region=mrbin.env$mrbin$parameters$previewRegion1D,
rectangleRegions=matrix(c((mrbin.env$mrbin$parameters$previewRegion1D[1]+
mrbin.env$mrbin$parameters$previewRegion1D[2])/2+as.numeric(mrbin.env$mrbin$parameters$binwidth1D)/2,
(mrbin.env$mrbin$parameters$previewRegion1D[1]+
mrbin.env$mrbin$parameters$previewRegion1D[2])/2-as.numeric(mrbin.env$mrbin$parameters$binwidth1D)/2,
21,21+1),ncol=4),
color="black", showGrid=TRUE,maxPlots=2,
manualScale=FALSE,
plotTitle=paste("Bin size\nwidth=",mrbin.env$mrbin$parameters$binwidth1D,"ppm",
sep=""),restrictToRange=TRUE)
}
binWidthTitle<-paste("Keep: width=",mrbin.env$mrbin$parameters$binwidth1D,"ppm",sep="")
widthAdjust<-utils::select.list(c(binWidthTitle,"Change...",
"Show different part of spectrum...","Go back"),
preselect=binWidthTitle,
title ="Bin width [ppm]: ",graphics=TRUE)
if(length(widthAdjust)==0|widthAdjust=="") stopTMP<-TRUE
if(widthAdjust=="Show different part of spectrum..."){
widthTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion1D[1],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion1D[1]<-as.numeric(widthTMP)
}
widthTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion1D[2],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion1D[2]<-as.numeric(widthTMP)
}
}
if(widthAdjust=="Change..."){
widthTMP<-readline(prompt=paste("New 1D bin width, press enter to keep ",
mrbin.env$mrbin$parameters$binwidth1D,": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$binwidth1D<-as.numeric(widthTMP)
}
}
if(widthAdjust==binWidthTitle) accept<-TRUE
}
if(widthAdjust=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
if(mrbin.env$mrbin$parameters$dimension=="2D"&!stopTMP&mrbin.env$mrbin$parameters$binMethod=="Rectangular bins"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Should be broader than a single peak and include some margin. Gray\ncrosses indicate data point locations")
utils::flush.console()
}
accept<-FALSE
widthAdjust<-""
while(!accept&!stopTMP&!widthAdjust=="Go back"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region=
mrbin.env$mrbin$parameters$previewRegion2D,
rectangleRegions=matrix(c((mrbin.env$mrbin$parameters$previewRegion2D[1]+
mrbin.env$mrbin$parameters$previewRegion2D[2])/2+as.numeric(mrbin.env$mrbin$parameters$binwidth2D)/2,
(mrbin.env$mrbin$parameters$previewRegion2D[1]+
mrbin.env$mrbin$parameters$previewRegion2D[2])/2-as.numeric(mrbin.env$mrbin$parameters$binwidth2D)/2,
(mrbin.env$mrbin$parameters$previewRegion2D[3]+
mrbin.env$mrbin$parameters$previewRegion2D[4])/2+as.numeric(mrbin.env$mrbin$parameters$binheight)/2,
(mrbin.env$mrbin$parameters$previewRegion2D[3]+
mrbin.env$mrbin$parameters$previewRegion2D[4])/2-as.numeric(mrbin.env$mrbin$parameters$binheight)/2
),ncol=4),
color="black",manualScale=FALSE, showGrid=TRUE,maxPlots=2,
plotTitle=paste("Bin size\nwidth=",mrbin.env$mrbin$parameters$binwidth2D,
"ppm, height=",mrbin.env$mrbin$parameters$binheight,"ppm",sep=""),
restrictToRange=TRUE)
currentBinSize<-paste("Keep: width=",mrbin.env$mrbin$parameters$binwidth2D,
"ppm, height=",mrbin.env$mrbin$parameters$binheight,"ppm",sep="")
widthAdjust<-utils::select.list(c(currentBinSize,"Change...",
"Show different part of spectrum...","Go back"),
preselect=currentBinSize,
title ="Bin size [ppm]: ",graphics=TRUE)
if(length(widthAdjust)==0|widthAdjust=="") stopTMP<-TRUE
if(widthAdjust==currentBinSize) accept<-TRUE
if(widthAdjust=="Show different part of spectrum..."){
widthTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion2D[1],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion2D[1]<-as.numeric(widthTMP)
}
widthTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion2D[2],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion2D[2]<-as.numeric(widthTMP)
}
widthTMP<-readline(prompt=paste("New top border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion2D[3],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion2D[3]<-as.numeric(widthTMP)
}
widthTMP<-readline(prompt=paste("New bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$previewRegion2D[4],": ",sep=""))
if(!widthTMP==""&!is.na(as.numeric(widthTMP))) {
mrbin.env$mrbin$parameters$previewRegion2D[4]<-as.numeric(widthTMP)
}
}
if(widthAdjust=="Change..."){
widthTMP<-readline(prompt=paste("New 2D bin width, press enter to keep ",
mrbin.env$mrbin$parameters$binwidth2D,": ",sep=""))
if(!widthTMP=="") {
#mrbin.env$paramChangeFlag<-TRUE
mrbin.env$mrbin$parameters$binwidth2D<-as.numeric(widthTMP)
}
heightTMP<-readline(prompt=paste("New 2D bin height, press enter to keep ",
mrbin.env$mrbin$parameters$binheight,": ",sep=""))
if(!heightTMP=="") {
#mrbin.env$paramChangeFlag<-TRUE
mrbin.env$mrbin$parameters$binheight<-as.numeric(heightTMP)
}
}
}
if(widthAdjust=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}#Set custom bin list
if(!stopTMP&mrbin.env$mrbin$parameters$binMethod=="Custom bin list"){
adjbinRegion<-""
if(!is.null(mrbin.env$mrbin$parameters$specialBinList)){
if(nrow(mrbin.env$mrbin$parameters$specialBinList)==0) mrbin.env$mrbin$parameters$specialBinList<-NULL
}
adjbinRegionSelect<-""
adjbinRegionAccept<-""
if(!is.null(mrbin.env$mrbin$parameters$specialBinList)){
if(nrow(mrbin.env$mrbin$parameters$specialBinList)==1){
specialBinList_s<-""
specialBinList_dots<-""
} else {
specialBinList_s<-"s"
specialBinList_dots<-", ..."
}
keepbinRegionText<-paste(paste(c("left=","ppm, right=","ppm, top=","ppm, bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$specialBinList[1:dimlength],collapse="",sep=""),"ppm",sep="")
keepbinRegionYes<-paste("Keep previous bin list (",nrow(mrbin.env$mrbin$parameters$specialBinList),
" bin",specialBinList_s,", ",keepbinRegionText,specialBinList_dots,")",sep="")
editbinRegionYes<-"Edit previous bin list"
preselectbinRegion<-keepbinRegionYes
keepbinRegionIndex<-c(1,2,3,4)
} else {
preselectbinRegion<-"Create new bin list"
keepbinRegionYes<-"Keep previous bin list"
editbinRegionYes<-"Edit previous bin list"
keepbinRegionIndex<-c(1,4)
}
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region="all",
rectangleRegions=mrbin.env$mrbin$parameters$specialBinList,color="black",
manualScale=FALSE,rectangleColors="green",maxPlots=2,
plotTitle=paste("Bin regions\n",sep=""),restrictToRange=TRUE)
adjbinRegionSelect<-utils::select.list(c("Create new bin list",keepbinRegionYes,
editbinRegionYes,"Go back")[keepbinRegionIndex],
preselect=preselectbinRegion,
title="Create new bin list?",graphics=TRUE)
if(length(adjbinRegionSelect)==0|adjbinRegionSelect=="") stopTMP<-TRUE
if(!stopTMP){
if(adjbinRegionSelect=="Create new bin list"){
mrbin.env$mrbin$parameters$specialBinList<-NULL
}
}
if(!stopTMP){
if(adjbinRegionSelect=="Create new bin list"|adjbinRegionSelect==editbinRegionYes){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Should be broader than a single peak and include some margin")
utils::flush.console()
}
if(is.null(mrbin.env$mrbin$parameters$specialBinList)){
mrbin.env$mrbin$parameters$specialBinList<-matrix(ncol=4,nrow=0,dimnames=list(NULL,c("left","right","top","bottom")))
}
ibinRegions <- 1
adjbinRegion<-""
addbinRegion<-""
while(ibinRegions <= (nrow(mrbin.env$mrbin$parameters$specialBinList)+1)&!stopTMP&
!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
if(!stopTMP&!adjbinRegion=="Go back"){
if(ibinRegions>nrow(mrbin.env$mrbin$parameters$specialBinList)){
addbinRegion<-utils::select.list(c("Yes","No","Go back"),preselect="Yes",
title ="Add a new bin?",graphics=TRUE)
if(length(addbinRegion)==0|addbinRegion==""){
stopTMP<-TRUE
addbinRegion<-""
}
if(!stopTMP){
if(addbinRegion=="Yes"){
mrbin.env$mrbin$parameters$specialBinList<-rbind(mrbin.env$mrbin$parameters$specialBinList,c(0,0,0,0))
if(nrow(mrbin.env$mrbin$parameters$specialBinList)==1){
rownames(mrbin.env$mrbin$parameters$specialBinList)<-""
} else {
rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions]<-""
}
}
}
}
if(!stopTMP&!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
mean1<-mean(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1:2])
range1<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1]-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2]
mean2<-mean(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3:4])
range2<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4]-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3]
regionTMP<-c(mean1+3.5*range1,mean1-3.5*range1,mean2-3.5*range2,mean2+3.5*range2)
showGridTMP<-TRUE
if(sum(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,]==0)==4){
regionTMP<-"all"
showGridTMP<-FALSE
}
if(mrbin.env$mrbin$parameters$dimension=="1D"){
if(!range1==0){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region=
regionTMP,
rectangleRegions=matrix(c(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1],
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2],0,2),ncol=4),
color="black", showGrid=showGridTMP,manualScale=FALSE,maxPlots=2,
plotTitle=paste("Custom bins\nleft=",mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
}
if(mrbin.env$mrbin$parameters$dimension=="2D"){
if(!range1==0&!range2==0){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region=regionTMP,
rectangleRegions=matrix(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1:4],ncol=4),
color="black",manualScale=FALSE, showGrid=showGridTMP,maxPlots=2,
plotTitle=paste("Custom bins\nleft=",mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
}
adjbinRegionAccept<-paste(paste(c("Keep left=","ppm, right=","ppm, top=","ppm, bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1:dimlength],collapse="",sep=""),"ppm",sep="")
if(sum(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,]==0)==4){
adjbinRegion<-"Change..."
} else {
if(rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions]==""){
binTitleTMP<-""
} else {
binTitleTMP<-paste(" (\"",rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions],"\")",sep="")
}
adjbinRegion<-utils::select.list(c(adjbinRegionAccept,"Change...","Remove bin","Go back"),
preselect=adjbinRegionAccept,
title =paste("Edit bin ",ibinRegions,binTitleTMP,"?",sep=""),graphics=TRUE)
}
if(length(adjbinRegion)==0|adjbinRegion=="") stopTMP<-TRUE
}
}
if(adjbinRegion=="Change..."&!stopTMP&!adjbinRegion=="Go back"){
if(rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions]==""){
promptTMP<-paste("New bin name, press enter for no name: ",sep="")
} else {
promptTMP<-paste("New bin name, press enter to keep ",
rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions],": ",sep="")
}
nameTMP<-readline(prompt=promptTMP)
if(!nameTMP=="") {
rownames(mrbin.env$mrbin$parameters$specialBinList)[ibinRegions]<-nameTMP
}
regionTMP<-readline(prompt=paste("Bin ",ibinRegions,": left border, press enter to keep ",
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Bin ",ibinRegions,": right border, press enter to keep ",
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1]<mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2]){
TMP<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1]
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,1]<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2]
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,2]<-TMP
}
if(mrbin.env$mrbin$parameters$dimension=="2D"&!stopTMP){
regionTMP<-readline(prompt=paste("Bin ",ibinRegions,": top border, press enter to keep ",
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Bin ",ibinRegions,": bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4]<mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3]){
TMP<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3]
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,3]<-mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4]
mrbin.env$mrbin$parameters$specialBinList[ibinRegions,4]<-TMP
}
}
}
if(adjbinRegion=="Remove bin"&!stopTMP&!adjbinRegion=="Go back"){
mrbin.env$mrbin$parameters$specialBinList<-mrbin.env$mrbin$parameters$specialBinList[-ibinRegions,,drop=FALSE]
}
if(adjbinRegion==adjbinRegionAccept&!stopTMP&!adjbinRegion=="Go back"){
ibinRegions <- ibinRegions+1
}
}
if(nrow(mrbin.env$mrbin$parameters$specialBinList)==0){
mrbin.env$mrbin$parameters$specialBinList<-NULL
adjbinRegion<-"Go back"
}
}
}
if(!stopTMP&!addbinRegion=="Go back"&!adjbinRegion=="Go back"){
if(is.null(mrbin.env$mrbin$parameters$specialBinList)){
addbinRegion<-"Go back"
}
}
if(adjbinRegion=="Go back"|addbinRegion=="Go back"|adjbinRegionSelect=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==6){#Scale to reference
if(!stopTMP){
adjRegion<-""
referenceScaling<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$referenceScaling,
title = "Scale to reference signal?",graphics=TRUE)
if(length(referenceScaling)==0|referenceScaling=="") stopTMP<-TRUE
if(!stopTMP&!referenceScaling=="Go back"){
mrbin.env$mrbin$parameters$referenceScaling<-referenceScaling
if(mrbin.env$mrbin$parameters$referenceScaling=="Yes"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Include reference signal with some margin")
utils::flush.console()
}
if(mrbin.env$mrbin$parameters$dimension=="1D"){
accept<-FALSE
adjRegion<-""
while(!accept&!stopTMP&!adjRegion=="Go back"){
mean1<-mean(mrbin.env$mrbin$parameters$reference1D)
range1<-max(mrbin.env$mrbin$parameters$reference1D)-min(mrbin.env$mrbin$parameters$reference1D)
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=c(mean1+4*range1,mean1-4*range1,-10,10),
rectangleRegions=matrix(c(mrbin.env$mrbin$parameters$reference1D[1],
mrbin.env$mrbin$parameters$reference1D[2],0,2),ncol=4),
color="black",manualScale=FALSE,restrictToRange=TRUE,maxPlots=2,
plotTitle=paste("Reference region\nleft=",mrbin.env$mrbin$parameters$reference1D[1],
"ppm, right=",mrbin.env$mrbin$parameters$reference1D[2],"ppm",sep=""))
RefRegionTitle<-paste("Keep: left=",mrbin.env$mrbin$parameters$reference1D[1],
"ppm, right=",mrbin.env$mrbin$parameters$reference1D[2],"ppm",sep="")
adjRegion<-utils::select.list(c(RefRegionTitle,
"Change...","Go back"),
preselect=RefRegionTitle,title ="Reference region [ppm]: ",graphics=TRUE)
if(length(adjRegion)==0|adjRegion=="") stopTMP<-TRUE
if(adjRegion==RefRegionTitle) accept<-TRUE
if(adjRegion=="Change..."){
regionTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$reference1D[1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference1D[1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$reference1D[2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference1D[2]<-as.numeric(regionTMP)
}
}
}
}
if(mrbin.env$mrbin$parameters$dimension=="2D"){
accept<-FALSE
adjRegion<-""
while(!accept&!stopTMP&!adjRegion=="Go back"){
mean1<-mean(mrbin.env$mrbin$parameters$reference2D[1:2])
range1<-max(mrbin.env$mrbin$parameters$reference2D[1:2])-min(mrbin.env$mrbin$parameters$reference2D[1:2])
mean2<-mean(mrbin.env$mrbin$parameters$reference2D[3:4])
range2<-max(mrbin.env$mrbin$parameters$reference2D[3:4])-min(mrbin.env$mrbin$parameters$reference2D[3:4])
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=c(mean1+4*range1,mean1-4*range1,
mean2-4*range2,mean2+4*range2),
rectangleRegions=matrix(mrbin.env$mrbin$parameters$reference2D,ncol=4),
color="black",manualScale=FALSE,restrictToRange=TRUE,maxPlots=2,
plotTitle=paste("Reference region\nleft=",mrbin.env$mrbin$parameters$reference2D[1],
"ppm, right=",mrbin.env$mrbin$parameters$reference2D[2],
"ppm, top=",mrbin.env$mrbin$parameters$reference2D[3],
"ppm, bottom=",mrbin.env$mrbin$parameters$reference2D[4],"ppm",sep=""))
RefRegionTitle<-paste("Keep: left=",mrbin.env$mrbin$parameters$reference2D[1],
"ppm, right=",mrbin.env$mrbin$parameters$reference2D[2],
"ppm, top=",mrbin.env$mrbin$parameters$reference2D[3],
"ppm, bottom=",mrbin.env$mrbin$parameters$reference2D[4],"ppm",sep="")
adjRegion<-utils::select.list(c(RefRegionTitle,
"Change...","Go back"),
preselect=RefRegionTitle,title ="Reference region [ppm]: ",graphics=TRUE)
if(length(adjRegion)==0|adjRegion=="") stopTMP<-TRUE
if(adjRegion==RefRegionTitle) accept<-TRUE
if(adjRegion=="Change..."){
regionTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$reference2D[1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference2D[1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$reference2D[2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference2D[2]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New top border, press enter to keep ",
mrbin.env$mrbin$parameters$reference2D[3],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference2D[3]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$reference2D[4],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$reference2D[4]<-as.numeric(regionTMP)
}
}
}
}
}
}
if(referenceScaling=="Go back"|adjRegion=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==7){#Remove solvent
if(!stopTMP){
adjRegion<-""
removeSolvent<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$removeSolvent,
title = "Remove solvent area?",graphics=TRUE)
if(length(removeSolvent)==0|removeSolvent=="") stopTMP<-TRUE
if(!stopTMP&!removeSolvent=="Go back"){
mrbin.env$mrbin$parameters$removeSolvent<-removeSolvent
if(mrbin.env$mrbin$parameters$removeSolvent=="Yes"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Include solvent signal and some margin")
utils::flush.console()
}
accept<-FALSE
adjRegion<-""
while(!accept&!stopTMP&!adjRegion=="Go back"){
mean1<-mean(mrbin.env$mrbin$parameters$solventRegion[1:2])
range1<-max(mrbin.env$mrbin$parameters$solventRegion[1:2])-min(mrbin.env$mrbin$parameters$solventRegion[1:2])
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=c(mean1+6*range1,mean1-6*range1,-10,160),rectangleColors="orange",
rectangleRegions=matrix(c(mrbin.env$mrbin$parameters$solventRegion[1],
mrbin.env$mrbin$parameters$solventRegion[2],-1000,1000),ncol=4),
color="black",manualScale=FALSE,restrictToRange=TRUE,maxPlots=2,
plotTitle=paste("Solvent region\nleft=",mrbin.env$mrbin$parameters$solventRegion[1],
"ppm, right=",mrbin.env$mrbin$parameters$solventRegion[2],"ppm",sep=""))
SolventRegionTitle<-paste("Keep: left=",mrbin.env$mrbin$parameters$solventRegion[1],
"ppm, right=",mrbin.env$mrbin$parameters$solventRegion[2],"ppm",sep="")
adjRegion<-utils::select.list(c(SolventRegionTitle,
"Change...","Go back"),
preselect=SolventRegionTitle,title ="Solvent region to be removed: ",graphics=TRUE)
if(length(adjRegion)==0|adjRegion=="") stopTMP<-TRUE
if(adjRegion==SolventRegionTitle) accept=TRUE
if(adjRegion=="Change..."&!stopTMP){
regionTMP<-readline(prompt=paste("New left border, press enter to keep ",
mrbin.env$mrbin$parameters$solventRegion[1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$solventRegion[1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("New right border, press enter to keep ",
mrbin.env$mrbin$parameters$solventRegion[2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$solventRegion[2]<-as.numeric(regionTMP)
}
}
}
}
}
if(removeSolvent=="Go back"|adjRegion=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==8){#Remove additional areas
if(!stopTMP){
removeAreaListTMP<-""
adjbinRegion<-""
addbinRegion<-""
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Remove spectral artifacts and solvent and contaminant signals")
utils::flush.console()
}
removeAreas<-utils::select.list(c("Yes","No","Go back"),preselect=mrbin.env$mrbin$parameters$removeAreas,
title = "Remove additional areas?",graphics=TRUE)
if(length(removeAreas)==0|removeAreas=="") stopTMP<-TRUE
if(!stopTMP&!removeAreas=="Go back"){
mrbin.env$mrbin$parameters$removeAreas<-removeAreas
if(mrbin.env$mrbin$parameters$removeAreas=="Yes"){
addAreasFlag<-TRUE
if(!is.null( mrbin.env$mrbin$parameters$removeAreaList)){
if(nrow(mrbin.env$mrbin$parameters$removeAreaList)==0){
mrbin.env$mrbin$parameters$removeAreaList<-NULL
}
}
if(!is.null(mrbin.env$mrbin$parameters$removeAreaList)){
if(nrow(mrbin.env$mrbin$parameters$removeAreaList)>0){
addAreasFlag<-FALSE
if(nrow(mrbin.env$mrbin$parameters$removeAreaList)==1){
regions_s<-""
regions_dots<-""
}
if(nrow(mrbin.env$mrbin$parameters$removeAreaList)>1){
regions_s<-"s"
regions_dots<-", ..."
}
preselectKeepTMP<-paste("Keep current list (",nrow(mrbin.env$mrbin$parameters$removeAreaList)," region",regions_s,", ",
paste(c("left=","ppm, right=","ppm, top=","ppm ,bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$removeAreaList[1,1:dimlength],
sep="",collapse=""),
"ppm",regions_dots,")",sep="")
preselectKeepTMPYes<-preselectKeepTMP
keepbinRegionIndex<-c(1,2,3,4)
}
} else {
preselectKeepTMP<-"Keep current list"
preselectKeepTMPYes<-"Create new list"
keepbinRegionIndex<-c(1,4)
}
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region="all",
rectangleRegions=mrbin.env$mrbin$parameters$removeAreaList,color="black",
manualScale=FALSE,rectangleColors="orange",maxPlots=2,
plotTitle=paste("Removed areas\n",
sep=""))
removeAreaListTMP<-utils::select.list(c("Create new list",preselectKeepTMP,"Edit current list","Go back")[keepbinRegionIndex],
preselect=preselectKeepTMPYes,
title = "Use previous area list or define new?",graphics=TRUE)
if(length(removeAreaListTMP)==0|removeAreaListTMP=="") stopTMP<-TRUE
if(!removeAreaListTMP==preselectKeepTMP&!stopTMP&!removeAreaListTMP=="Go back"){
addAreasFlag<-TRUE
if(removeAreaListTMP=="Create new list"&!stopTMP){
mrbin.env$mrbin$parameters$removeAreaList<-matrix(ncol=4,nrow=0,dimnames=list(NULL,c("left","right","top","bottom")))
}
}
if(!stopTMP){
if(removeAreaListTMP=="Create new list"|removeAreaListTMP=="Edit current list"){
if(is.null(mrbin.env$mrbin$parameters$removeAreaList)){
mrbin.env$mrbin$parameters$removeAreaList<-matrix(ncol=4,nrow=0,dimnames=list(NULL,c("left","right","top","bottom")))
}
ibinRegions <- 1
adjbinRegion<-""
addbinRegion<-""
adjbinRegionAccept<-""
while(ibinRegions <= (nrow(mrbin.env$mrbin$parameters$removeAreaList)+1)&!stopTMP&
!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
if(!stopTMP&!adjbinRegion=="Go back"){
if(ibinRegions>nrow(mrbin.env$mrbin$parameters$removeAreaList)){
addbinRegion<-utils::select.list(c("Yes","No","Go back"),preselect="No",
title ="Add a new region?",graphics=TRUE)
if(length(addbinRegion)==0|addbinRegion==""){
stopTMP<-TRUE
addbinRegion<-""
}
if(!stopTMP){
if(addbinRegion=="Yes"){
mrbin.env$mrbin$parameters$removeAreaList<-rbind(mrbin.env$mrbin$parameters$removeAreaList,c(0,0,0,0))
}
}
}
if(!stopTMP&!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
mean1<-mean(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1:2])
range1<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1]-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2]
mean2<-mean(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3:4])
range2<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4]-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3]
regionTMP<-c(mean1+4*range1,mean1-4*range1,mean2-4*range2,mean2+4*range2)
if(sum(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,]==0)==4) regionTMP<-"all"
if(mrbin.env$mrbin$parameters$dimension=="1D"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=regionTMP,rectangleColors="orange",
rectangleRegions=matrix(c(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1],
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2],0,2),ncol=4),
color="black",manualScale=FALSE,maxPlots=2,
plotTitle=paste("Remove area\nleft=",mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
if(mrbin.env$mrbin$parameters$dimension=="2D"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=regionTMP,rectangleColors="orange",
rectangleRegions=matrix(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1:4],ncol=4),
color="black",manualScale=FALSE,maxPlots=2,
plotTitle=paste("Remove area\nleft=",mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
adjbinRegionAccept<-paste(paste(c("Keep left=","ppm, right=","ppm, top=","ppm, bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1:dimlength],collapse="",sep=""),"ppm",sep="")
if(sum(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,]==0)==4){
adjbinRegion<-"Change..."
} else {
adjbinRegion<-utils::select.list(c(adjbinRegionAccept,"Change...","Remove entry","Go back"),
preselect=adjbinRegionAccept,
title =paste("Keep region ",ibinRegions,"?",sep=""),graphics=TRUE)
}
if(length(adjbinRegion)==0|adjbinRegion=="") stopTMP<-TRUE
}
}
if(!stopTMP){
if(adjbinRegion=="Change..."&!adjbinRegion=="Go back"){
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": left border, press enter to keep ",
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": right border, press enter to keep ",
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1]<mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2]){
TMP<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1]
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,1]<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2]
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,2]<-TMP
}
if(mrbin.env$mrbin$parameters$dimension=="2D"&!stopTMP){
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": top border, press enter to keep ",
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4]<mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3]){
TMP<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3]
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,3]<-mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4]
mrbin.env$mrbin$parameters$removeAreaList[ibinRegions,4]<-TMP
}
}
}
if(adjbinRegion=="Remove entry"&!stopTMP&!adjbinRegion=="Go back"){
mrbin.env$mrbin$parameters$removeAreaList<-mrbin.env$mrbin$parameters$removeAreaList[-ibinRegions,,drop=FALSE]
}
}
if(!stopTMP){
if(adjbinRegion==adjbinRegionAccept){
ibinRegions <- ibinRegions+1
}
}
}
}
}
}
}
}
if(!is.null(mrbin.env$mrbin$parameters$removeAreaList)){
if(nrow(mrbin.env$mrbin$parameters$removeAreaList)==0){
mrbin.env$mrbin$parameters$removeAreaList<-NULL
adjbinRegion<-"Go back"
}
}
if(adjbinRegion=="Go back"|addbinRegion=="Go back"|removeAreaListTMP=="Go back"|removeAreas=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==9){#Merge bins containing unstable peaks
if(!stopTMP){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Signals that differ in chemical shift from sample to sample")
utils::flush.console()
}
sumBinListTMP<-""
removeAreaListTMP<-""
adjbinRegion<-""
addbinRegion<-""
sumBins<-utils::select.list(c("Merge bins of unstable peaks (e.g. citrate)","No","Go back"),
preselect=mrbin.env$mrbin$parameters$sumBins,
title = "Merge bins of unstable peaks?",graphics=TRUE)
if(length(sumBins)==0|sumBins=="") stopTMP<-TRUE
if(!stopTMP&!sumBins=="Go back"){
if(sumBins=="Merge bins of unstable peaks (e.g. citrate)"){
mrbin.env$mrbin$parameters$sumBins<-"Yes"
} else {
mrbin.env$mrbin$parameters$sumBins<-sumBins
}
if(mrbin.env$mrbin$parameters$sumBins=="Yes"&!stopTMP){
addAreasFlag<-TRUE
if(!is.null( mrbin.env$mrbin$parameters$sumBinList)){
if(nrow(mrbin.env$mrbin$parameters$sumBinList)==0){
mrbin.env$mrbin$parameters$sumBinList<-NULL
}
}
if(!is.null( mrbin.env$mrbin$parameters$sumBinList)){
if(nrow(mrbin.env$mrbin$parameters$sumBinList)>0&!stopTMP){
addAreasFlag<-FALSE
if(nrow(mrbin.env$mrbin$parameters$sumBinList)==1){
regions_s<-""
regions_dots<-""
}
if(nrow(mrbin.env$mrbin$parameters$sumBinList)>1){
regions_s<-"s"
regions_dots<-", ..."
}
preselectKeepTMP<-paste("Keep current list (",nrow(mrbin.env$mrbin$parameters$sumBinList)," region",regions_s,", ",
paste(c("left=","ppm, right=","ppm, top=","ppm ,bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$sumBinList[1,1:dimlength],
sep="",collapse=""),
"ppm",regions_dots,")",sep="")
preselectKeepTMPYes<-preselectKeepTMP
keepbinRegionIndex<-c(1,2,3,4)
}
} else {
preselectKeepTMP<-"Keep current list"
preselectKeepTMPYes<-"Create new list"
keepbinRegionIndex<-c(1,4)
}
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region="all",
rectangleRegions=mrbin.env$mrbin$parameters$sumBinList,color="black",
manualScale=FALSE,rectangleColors="green",maxPlots=2,
plotTitle=paste("Summed areas\n",sep=""),restrictToRange=TRUE)
sumBinListTMP<-utils::select.list(c("Create new list",preselectKeepTMP,"Edit current list","Go back")[keepbinRegionIndex],
preselect=preselectKeepTMPYes,
title = "Use previous area list or define new?",graphics=TRUE)
if(length(sumBinListTMP)==0|sumBinListTMP=="") stopTMP<-TRUE
if(!sumBinListTMP==preselectKeepTMP&!stopTMP&!sumBinListTMP=="Go back"){
addAreasFlag<-TRUE
if(sumBinListTMP=="Create new list"&!stopTMP){
mrbin.env$mrbin$parameters$sumBinList<-matrix(ncol=4,nrow=0,dimnames=list(NULL,c("left","right","top","bottom")))
}
}
if(!stopTMP){
if(sumBinListTMP=="Create new list"|sumBinListTMP=="Edit current list"){
if(is.null(mrbin.env$mrbin$parameters$sumBinList)){
mrbin.env$mrbin$parameters$sumBinList<-matrix(ncol=4,nrow=0,dimnames=list(NULL,c("left","right","top","bottom")))
}
ibinRegions <- 1
adjbinRegion<-""
addbinRegion<-""
adjbinRegionAccept<-""
while(ibinRegions <= (nrow(mrbin.env$mrbin$parameters$sumBinList)+1)&!stopTMP&
!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
if(!stopTMP&!adjbinRegion=="Go back"){
if(ibinRegions>nrow(mrbin.env$mrbin$parameters$sumBinList)){
addbinRegion<-utils::select.list(c("Yes","No","Go back"),preselect="No",
title ="Add a new region?",graphics=TRUE)
if(length(addbinRegion)==0|addbinRegion==""){
stopTMP<-TRUE
addbinRegion<-""
}
if(!stopTMP){
if(addbinRegion=="Yes"){
mrbin.env$mrbin$parameters$sumBinList<-rbind(mrbin.env$mrbin$parameters$sumBinList,c(0,0,0,0))
}
}
}
if(!stopTMP&!adjbinRegion=="Go back"&!addbinRegion=="Go back"&!addbinRegion=="No"){
mean1<-mean(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1:2])
range1<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1]-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2]
mean2<-mean(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3:4])
range2<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4]-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3]
regionTMP<-c(mean1+4*range1,mean1-4*range1,mean2-4*range2,mean2+4*range2)
if(sum(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,]==0)==4) regionTMP<-"all"
if(mrbin.env$mrbin$parameters$dimension=="1D"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=regionTMP,rectangleRegions=matrix(c(
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1],
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2],0,2),ncol=4),
color="black",manualScale=FALSE,maxPlots=2,
plotTitle=paste("Sum area\nleft=",mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
if(mrbin.env$mrbin$parameters$dimension=="2D"){
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(
region=regionTMP,
rectangleRegions=matrix(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1:4],ncol=4),
color="black", manualScale=FALSE,maxPlots=2,
plotTitle=paste("Sum area\nleft=",mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1],
"ppm, right=",mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2],"ppm",sep=""),
restrictToRange=TRUE)
}
adjbinRegionAccept<-paste(paste(c("Keep left=","ppm, right=","ppm, top=","ppm, bottom=")[1:dimlength],
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1:dimlength],collapse="",sep=""),"ppm",sep="")
if(sum(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,]==0)==4){
adjbinRegion<-"Change..."
} else {
adjbinRegion<-utils::select.list(c(adjbinRegionAccept,"Change...","Remove","Go back"),
preselect=adjbinRegionAccept,
title =paste("Keep region ",ibinRegions,"?",sep=""),graphics=TRUE)
}
if(length(adjbinRegion)==0|adjbinRegion=="") stopTMP<-TRUE
}
}
if(adjbinRegion=="Change..."&!stopTMP&!adjbinRegion=="Go back"){
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": left border, press enter to keep ",
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": right border, press enter to keep ",
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1]<mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2]){
TMP<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1]
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,1]<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2]
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,2]<-TMP
}
if(mrbin.env$mrbin$parameters$dimension=="2D"&!stopTMP){
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": top border, press enter to keep ",
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3]<-as.numeric(regionTMP)
}
regionTMP<-readline(prompt=paste("Region ",ibinRegions,": bottom border, press enter to keep ",
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4],": ",sep=""))
if(!regionTMP=="") {
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4]<-as.numeric(regionTMP)
}
if(mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4]<mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3]){
TMP<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3]
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,3]<-mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4]
mrbin.env$mrbin$parameters$sumBinList[ibinRegions,4]<-TMP
}
}
}
if(adjbinRegion=="Remove"&!stopTMP&!adjbinRegion=="Go back"){
mrbin.env$mrbin$parameters$sumBinList<-mrbin.env$mrbin$parameters$sumBinList[-ibinRegions,,drop=FALSE]
}
if(adjbinRegion==adjbinRegionAccept&!stopTMP){
ibinRegions <- ibinRegions+1
}
}
}
}
if(is.null(mrbin.env$mrbin$parameters$sumBinList)){
adjbinRegion<-"Go back"
} else {
if(nrow(mrbin.env$mrbin$parameters$sumBinList)==0){
mrbin.env$mrbin$parameters$sumBinList<-NULL
adjbinRegion<-"Go back"
}
}
}
}
if(adjbinRegion=="Go back"|addbinRegion=="Go back"|sumBins=="Go back"|sumBinListTMP=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==10){#Crop HSQCs
if(mrbin.env$mrbin$parameters$dimension=="2D"&!stopTMP){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Cropping may remove noisy areas, optimized for HSQCs")
utils::flush.console()
}
if(mrbin.env$mrbin$parameters$showSpectrumPreview=="Yes") plotMultiNMR(region="all",
polygonRegion=matrix(c(mrbin.env$mrbin$parameters$croptopRight,
mrbin.env$mrbin$parameters$croptopLeft,
mrbin.env$mrbin$parameters$cropbottomLeft,
mrbin.env$mrbin$parameters$cropbottomRight),
ncol=2,byrow=TRUE),
color="black",manualScale=FALSE,maxPlots=2,
plotTitle=paste("Crop spectrum to diagonal",sep=""))
cropHSQC<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$cropHSQC,
title="Crop spectra?",graphics=TRUE)
if(length(cropHSQC)==0|cropHSQC=="") stopTMP<-TRUE
if(!stopTMP&!cropHSQC=="Go back"){
mrbin.env$mrbin$parameters$cropHSQC<-cropHSQC
}
if(cropHSQC=="Go back"){
selectStep<-selectStep-2
}
}
if(!stopTMP) selectStep<-selectStep+1
}
if(selectStep==11){#Define sample names
if(!stopTMP){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: If only EXPNO differs choose Folder names and EXPNO")
utils::flush.console()
}
NamesDictTMP<-c("Folder names","Spectrum titles","Folder names and EXPNO")
names(NamesDictTMP)<-paste(NamesDictTMP," (\"",c(mrbin.env$mrbinTMP$currentSpectrumFolderName,
mrbin.env$mrbinTMP$currentSpectrumTitle,
mrbin.env$mrbinTMP$currentSpectrumFolderName_EXPNO),
"\", ...)",sep="")
NamesDictTMP2<-names(NamesDictTMP)
names(NamesDictTMP2)<-NamesDictTMP
useAsNames<-utils::select.list(c(names(NamesDictTMP),"Go back"),
preselect=NamesDictTMP2[mrbin.env$mrbin$parameters$useAsNames],
title = "Create sample names from",graphics=TRUE)
if(length(useAsNames)==0|useAsNames=="") stopTMP<-TRUE
if(!stopTMP&!useAsNames=="Go back"){
mrbin.env$mrbin$parameters$useAsNames<-NamesDictTMP[useAsNames]
}
if(!stopTMP&useAsNames=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==12){#Plot results
if(!stopTMP){
PCA<-"Yes"
if(mrbin.env$mrbin$parameters$PCA=="No"){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Recommended for quality control")
utils::flush.console()
}
PCAtitlelength<-""
PCA<-utils::select.list(c("Yes","No","Go back"),
preselect = "Yes",#mrbin.env$mrbin$parameters$PCA,
title = "Create result plot?",graphics=TRUE)
if(length(PCA)==0|PCA=="") stopTMP<-TRUE
if(!stopTMP&!PCA=="Go back"){
mrbin.env$mrbin$parameters$PCA<-PCA
}
}
if(!stopTMP&!PCA=="Go back"){
if(!stopTMP&mrbin.env$mrbin$parameters$PCA=="Yes"){
currentPCAtitlelength<-as.character(mrbin.env$mrbin$parameters$PCAtitlelength)
if(mrbin.env$mrbin$parameters$useAsNames=="Spectrum titles") Title<-mrbin.env$mrbinTMP$currentSpectrumTitle
if(mrbin.env$mrbin$parameters$useAsNames=="Folder names") Title<-mrbin.env$mrbinTMP$currentSpectrumFolderName
if(mrbin.env$mrbin$parameters$useAsNames=="Folder names and EXPNO") Title<-mrbin.env$mrbinTMP$currentSpectrumFolderName_EXPNO
TitleListTMP<-unique(c(4,6,8,500,currentPCAtitlelength))
names(TitleListTMP)<-unique(c(4,6,8,500,currentPCAtitlelength))
TitleListTMPDict<-as.character(TitleListTMP)
names(TitleListTMPDict)<-TitleListTMP
TitleListTMPDict[TitleListTMPDict=="500"] <-"All"
TitleListTMP2<-c(TitleListTMPDict,"Custom...","Go back")
names_TitleListTMP2<-NULL
for(i_TitleListTMP2 in 1:length(TitleListTMPDict)){
names_TitleListTMP2<-c(names_TitleListTMP2,paste(TitleListTMPDict[i_TitleListTMP2]," letters (\"",
substr(Title,1,as.numeric(TitleListTMP[i_TitleListTMP2])),"\", ...)",sep=""))
}
names_TitleListTMP2<-c(names_TitleListTMP2,"Custom...","Go back")
names(TitleListTMP2)<-names_TitleListTMP2
TitleListTMP4<-TitleListTMP2
TitleListTMP4[TitleListTMP4=="All"]<-"500"
TitleListTMP3<-c(paste(TitleListTMPDict," (",substr(Title,1,TitleListTMP),")",sep=""),"Custom...","Go back")
names(TitleListTMP3)<-TitleListTMP2
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Recommended for a nicer plot, make sure names are unique")
utils::flush.console()
}
PCAtitlelength<-utils::select.list(names(TitleListTMP2),
preselect = names(TitleListTMP2)[TitleListTMP4==as.character(mrbin.env$mrbin$parameters$PCAtitlelength)],
title = "Crop titles for plot?",graphics=TRUE)
if(length(PCAtitlelength)==0|PCAtitlelength=="") stopTMP<-TRUE
if(!stopTMP&!PCAtitlelength=="Go back"){
if(TitleListTMP2[PCAtitlelength]=="All"){
mrbin.env$mrbin$parameters$PCAtitlelength<-500
} else {
if(PCAtitlelength=="Custom..."){
PCAtitlelengthTMP<-readline(prompt=paste("New title length, press enter to keep ",
mrbin.env$mrbin$parameters$PCAtitlelength,": ",sep=""))
if(!PCAtitlelengthTMP=="") {
mrbin.env$mrbin$parameters$PCAtitlelength<-as.numeric(PCAtitlelengthTMP)
}
} else {
mrbin.env$mrbin$parameters$PCAtitlelength<-as.numeric(TitleListTMP2[PCAtitlelength])
}
}
}
}
}
if(!stopTMP&(PCA=="Go back"|PCAtitlelength=="Go back")){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==13){#Save output files to hard drive?
if(!stopTMP){
saveFilesTMP2<-"Select new folder and file name"
saveFilesTMP<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$saveFiles,
title ="Save output to disk?",graphics=TRUE)
if(length(saveFilesTMP)==0|saveFilesTMP=="") stopTMP<-TRUE
if(!stopTMP&!saveFilesTMP=="Go back"){
mrbin.env$mrbin$parameters$saveFiles<-saveFilesTMP
if(mrbin.env$mrbin$parameters$saveFiles=="Yes"&!stopTMP){
if(!is.null(mrbin.env$mrbin$parameters$outputFileName)){
keepFileTMP<-paste("Keep ",mrbin.env$mrbin$parameters$outputFileName,sep="")
saveFilesTMP2<-utils::select.list(c(keepFileTMP,"Select new folder and file name","Go back"),
preselect=keepFileTMP,
title ="Keep file name and folder?",graphics=TRUE)
if(length(saveFilesTMP2)==0|saveFilesTMP=="") stopTMP<-TRUE
}
if(!stopTMP&saveFilesTMP2=="Select new folder and file name"){
enterFoldersTMP<-readline(prompt="Enter starting folder path. (Examples: Windows: \"C:\\\", Apple: \"/\") : ")
if(enterFoldersTMP=="") saveFilesTMP2<-"Go back"
if(!saveFilesTMP2=="Go back"){
parentFolder<-gsub('\\\\',"/",enterFoldersTMP)
#Browse
selectFlag<-0
while(selectFlag<1){
folderListFull<-list.dirs(path=parentFolder,recursive = FALSE,full.names=TRUE)
folderList<-list.dirs(path=parentFolder,recursive = FALSE,full.names=FALSE)
if(length(strsplit(parentFolder,split="/")[[1]])>1){
folderListTMP<-c(".. ",
folderList)
} else {
folderListTMP<-folderList
}
selectFolders<-utils::select.list(folderListTMP,preselect=NULL,multiple=TRUE,
title = "Go to folder, then click OK",graphics=TRUE)
if(!length(selectFolders)==1) {
selectFolders<-parentFolder
selectList<-parentFolder
selectFlag<-1
}
if(length(selectFolders)==1&selectFlag<1){
if(selectFolders==".. "){
if(length(strsplit(parentFolder,split="/")[[1]])>1){
selectList<-paste(rev(rev(strsplit(parentFolder,split="/")[[1]])[-1]),sep="",collapse="/")
} else {
selectList<-parentFolder
}
} else {
selectList<-folderListFull[which(folderList%in%selectFolders)]
}
}
parentFolder<-selectList
}
filenameTMP<-utils::select.list(c(paste("mrbin_",gsub(":","-",gsub(" ","_",Sys.Date())),
sep=""),"Change..."),
title ="Output file name: ",graphics=TRUE)
if(length(filenameTMP)==0|filenameTMP=="") stopTMP<-TRUE
if(!stopTMP){
if(filenameTMP=="Change..."&!stopTMP){
filenameTMP<-readline(prompt=paste("New file name, press enter to use ",
paste("mrbin_",gsub(":","-",gsub(" ","_",Sys.Date())),sep=""),": \n",sep=""))
if(filenameTMP=="") filenameTMP<-paste("mrbin_",gsub(":","-",gsub(" ","_",Sys.Date())),
sep="")
}
mrbin.env$mrbin$parameters$outputFileName<-gsub("//","/",paste(
parentFolder,"/",filenameTMP,sep=""))
}
}
}
}
}
if(!stopTMP&(saveFilesTMP=="Go back"|saveFilesTMP2=="Go back")){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==14){
if(!stopTMP){#make some example calculations to estimate speed of binning
createBinNumbers()#necessary here for time estimate
createBinRegions()#necessary here for time estimate
if(mrbin.env$mrbin$parameters$dimension=="1D") coverageRatioTMP<-nrow(
mrbin.env$mrbin$parameters$binRegions)/((max(as.numeric(
names(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
names(mrbin.env$mrbinTMP$currentSpectrum))))/mrbin.env$mrbin$parameters$binwidth1D)
if(mrbin.env$mrbin$parameters$dimension=="2D") coverageRatioTMP<-nrow(
mrbin.env$mrbin$parameters$binRegions)/((max(as.numeric(
colnames(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
colnames(mrbin.env$mrbinTMP$currentSpectrum))))*
(max(as.numeric(rownames(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
rownames(mrbin.env$mrbinTMP$currentSpectrum))))/
(mrbin.env$mrbin$parameters$binwidth2D*mrbin.env$mrbin$parameters$binheight))
dimScaleTMP<-1
if(mrbin.env$mrbin$parameters$dimension=="2D") dimScaleTMP<-.5#2D spectra take less time empirically
NrowTMP<-400#mock number of bins
NrowTMP2<-nrow(mrbin.env$mrbin$parameters$binRegions)/NrowTMP#ratio of real number of bins to mock number of bins
NpointsTMP<-100#mock number of data points per bin
NpointsTMP2<-ceiling(1+(coverageRatioTMP*length(mrbin.env$mrbinTMP$currentSpectrum)/
nrow(mrbin.env$mrbin$parameters$binRegions)))/NpointsTMP#ratio of estimated number of data points per bin to mock data point number
#calculate some sums in a loop as a mock binning example for time estimation
mrbin.env$mrbinTMP$timeEstimate<-mrbin.env$mrbinTMP$timeEstimate+max(.001,system.time(
for(i in 1:NrowTMP) sum((1:(NpointsTMP*NrowTMP))[(1:(NpointsTMP*NrowTMP))<(i*NpointsTMP)&
(1:(NpointsTMP*NrowTMP))>((i-1)*NpointsTMP)]))[1])*
(dimScaleTMP*20*NrowTMP2*NpointsTMP2^.5)
if(mrbin.env$mrbin$parameters$tryParallel){
mrbin.env$mrbinTMP$timeEstimate<-dimScaleTMP*mrbin.env$mrbinTMP$timeEstimate*ceiling(length(
mrbin.env$mrbin$parameters$NMRfolders)/max(1,(parallel::detectCores()-1)))
} else {
mrbin.env$mrbinTMP$timeEstimate<-dimScaleTMP*mrbin.env$mrbinTMP$timeEstimate*length(
mrbin.env$mrbin$parameters$NMRfolders)
}
if(mrbin.env$mrbin$parameters$verbose){
message(paste("Hint: Estimated binning time: ",round(
mrbin.env$mrbinTMP$timeEstimate/60,0)," minutes or more",sep=""))
utils::flush.console()
}
startmrbin<-utils::select.list(c("Start binning now","I'll do it later","Go back"),
preselect="Start binning now",
title =paste("Start now? Estimate: >",round(
mrbin.env$mrbinTMP$timeEstimate/60,0)," min",sep=""),graphics=TRUE)
if(length(startmrbin)==0|startmrbin==""|startmrbin=="I'll do it later") stopTMP<-TRUE
if(!stopTMP&startmrbin=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
if(startmrbin=="Start binning now") lastStepDone<-TRUE
}
}
}
}
}#end if(!silent)
if(!stopTMP){
if(startmrbin=="Start binning now"){
#Check if files or folders exist first to avoid long waiting due to binning failure
for(iCheckFiles in 1:length(mrbin.env$mrbin$parameters$NMRfolders)){
readNMR(folder=mrbin.env$mrbin$parameters$NMRfolders[iCheckFiles],
dimension=mrbin.env$mrbin$parameters$dimension,checkFiles=TRUE)
}
mrbin.env$mrbin<-mrbinrun(createbins=TRUE,process=FALSE,silent=silent)
if(mrbin.env$mrbin$parameters$verbose){
if(!is.null(mrbin.env$mrbin$parameters$warningMessages)){
for(iWarningTMP in 1:length(mrbin.env$mrbin$parameters$warningMessages)){
message("Warning: ",mrbin.env$mrbin$parameters$warningMessages[iWarningTMP])
}
utils::flush.console()
}
}
}
}
if(!silent){
lastStepDone<-FALSE
if(selectionRepeat=="Use current parameters without changes"&!stopTMP){
selectStep<-25
lastStepDone<-TRUE
}
while(!lastStepDone&!stopTMP&!restart){
if(selectionRepeat=="Review parameters"&!stopTMP){
if(selectStep==15){
if(!stopTMP){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Review plots for data quality. If issues are present, such as phasing\nor baseline issues, fix the spectra, e.g. in Topspin, then run mrbin again")
utils::flush.console()
}
plotReview<-utils::select.list(c("I will fix issues, if any, and then run mrbin again",
"I have fixed all spectrum issues and wish to continue",
"I would like to restart to adjust parameters"),
preselect="I will fix issues, if any, and then run mrbin again",
title="Please review data for quality issues",graphics=TRUE)
if(length(plotReview)==0|plotReview==""|plotReview=="I will fix issues, if any, and then run mrbin again") stopTMP<-TRUE
if(!stopTMP&plotReview=="I would like to restart to adjust parameters"){
restart<-TRUE
selectStep<--4#start from beginning
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==16){#data quality plots
if(!stopTMP){
if(!is.null(mrbin.env$mrbin$parameters$warningMessages)){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Run warnings(), fix issues if possible, then run mrbin again\n")
utils::flush.console()
}
listWarningTMP<-c("I will check warnings() and then run mrbin again",
"I have fixed all issues and wish to continue",
"I would like to restart to adjust parameters")
plotReview<-utils::select.list(listWarningTMP,
preselect="I will check warnings() and then run mrbin again",
title="There were warning messages",graphics=TRUE)
if(length(plotReview)==0|plotReview==""|plotReview=="I will check warnings() and then run mrbin again") stopTMP<-TRUE
}
if(!stopTMP&plotReview=="I would like to restart to adjust parameters"){
selectStep<--4#start from beginning
restart<-TRUE
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==17){#Remove noise
if(!stopTMP){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: All processing steps can be performed later if you skip them now")
message("Hint: Remove noise to increase statistical power")
utils::flush.console()
}
noiseRemoval<-utils::select.list(c("Yes","No"),
preselect=mrbin.env$mrbin$parameters$noiseRemoval,
title="Remove noise?",graphics=TRUE)
if(length(noiseRemoval)==0|noiseRemoval=="") stopTMP<-TRUE
if(!stopTMP){
if(!noiseRemoval==mrbin.env$mrbin$parameters$noiseRemoval){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(noiseRemoval=noiseRemoval),verbose=FALSE)
}
if(mrbin.env$mrbin$parameters$noiseRemoval=="Yes"){
mrbin.env$mrbin<-setNoiseLevels(mrbin.env$mrbin,plotOnly=FALSE)
}
selectStep<-selectStep+1
}
}
}
if(selectStep==18){#Dilution correction scaling
if(!stopTMP){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Use if volumes or weights differ between samples")
utils::flush.console()
}
dilutionCorrection<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$dilutionCorrection,
title = "Dilution correction?",graphics=TRUE)
if(length(dilutionCorrection)==0|dilutionCorrection=="") stopTMP<-TRUE
if(!stopTMP&!dilutionCorrection=="Go back"){
if(!dilutionCorrection==mrbin.env$mrbin$parameters$dilutionCorrection){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(dilutionCorrection=dilutionCorrection),verbose=FALSE)
}
if(mrbin.env$mrbin$parameters$dilutionCorrection=="Yes"){
mrbin.env$mrbin<-setDilutionFactors(mrbin.env$mrbin)
}
}
if(!stopTMP&(dilutionCorrection=="Go back")){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==19){#PQN scaling
if(!stopTMP){
PQNScalingIgnoreSugar<-""
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Recommended for urine and tissue extracts")
utils::flush.console()
}
PQNScaling<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$PQNScaling,
title = "PQN normalization?",graphics=TRUE)
if(length(PQNScaling)==0|PQNScaling=="") stopTMP<-TRUE
if(!stopTMP&!PQNScaling=="Go back"){
if(!PQNScaling==mrbin.env$mrbin$parameters$PQNScaling){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(PQNScaling=PQNScaling),verbose=FALSE)
}
if(mrbin.env$mrbin$parameters$PQNScaling=="Yes"){
if(mrbin.env$mrbin$parameters$verbose){
message("Hint: Improves PQN but works only for 1H and 1H-13C spectra")
utils::flush.console()
}
PQNScalingIgnoreSugar<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$PQNIgnoreSugarArea,
title = "Ignore glucose for PQN?",graphics=TRUE)
if(length(PQNScalingIgnoreSugar)==0|PQNScalingIgnoreSugar=="") stopTMP<-TRUE
if(!stopTMP&!PQNScalingIgnoreSugar=="Go back"&
!PQNScalingIgnoreSugar==mrbin.env$mrbin$parameters$PQNIgnoreSugarArea){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(PQNIgnoreSugarArea=PQNScalingIgnoreSugar),
verbose=FALSE)
}
}
}
if(!stopTMP&(PQNScaling=="Go back"|PQNScalingIgnoreSugar=="Go back")){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==20){#Replace negative values
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Replace negative values if you plan to do log transform")
utils::flush.console()
}
if(!stopTMP){
fixNegatives<-utils::select.list(c("Yes","No","Go back"),
preselect=mrbin.env$mrbin$parameters$fixNegatives,
title="Fix negative values (atnv)",graphics=TRUE)
if(length(fixNegatives)==0|fixNegatives=="") stopTMP<-TRUE
if(!stopTMP&!fixNegatives=="Go back"&!fixNegatives==mrbin.env$mrbin$parameters$fixNegatives){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(fixNegatives=fixNegatives),
verbose=FALSE)
}
if(!stopTMP&fixNegatives=="Go back"){
selectStep<-selectStep-2
}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==21){#Log scaling
if(!stopTMP){
#if(mrbin.env$mrbin$parameters$fixNegatives=="Yes"|mrbin.env$mrbin$parameters$logTrafo=="Yes"){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Makes data more normal but breaks linearity. Requires positive data.")
utils::flush.console()
}
preselectTMP<-mrbin.env$mrbin$parameters$logTrafo
#if(!mrbin.env$mrbin$parameters$fixNegatives=="Yes"){
# preselectTMP<-"No"
#}
logTrafo<-utils::select.list(c("Yes","No","Go back"),preselect=preselectTMP,
title="Log transformation?",graphics=TRUE)
if(length(logTrafo)==0|logTrafo=="") stopTMP<-TRUE
if(!stopTMP&!logTrafo=="Go back"&!logTrafo==mrbin.env$mrbin$parameters$logTrafo){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(logTrafo=logTrafo),
verbose=FALSE)
}
if(!stopTMP&logTrafo=="Go back"){
selectStep<-selectStep-2
}
#}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep==22){#Unit variance scaling
if(!stopTMP){
if(!stopTMP&mrbin.env$mrbin$parameters$verbose){
message("Hint: Usually not required. Breaks linearity.")
utils::flush.console()
}
preselectTMP<-mrbin.env$mrbin$parameters$unitVarianceScaling
unitVarianceScaling<-utils::select.list(c("Yes","No","Go back"),preselect=preselectTMP,
title="Unit variance scaling?",graphics=TRUE)
if(length(unitVarianceScaling)==0|unitVarianceScaling=="") stopTMP<-TRUE
if(!stopTMP&!unitVarianceScaling=="Go back"&!unitVarianceScaling==mrbin.env$mrbin$parameters$unitVarianceScaling){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(unitVarianceScaling=unitVarianceScaling),
verbose=FALSE)
}
if(!stopTMP&unitVarianceScaling=="Go back"){
selectStep<-selectStep-2
}
#}
if(!stopTMP) selectStep<-selectStep+1
}
}
if(selectStep>=23){
if(!stopTMP&!restart) lastStepDone<-TRUE
}
}
}
}#end if(!silent)
}
if(!stopTMP){
mrbin.env$mrbin<-mrbinrun(createbins=FALSE,process=TRUE,mrbinResults=mrbin.env$mrbin,
silent=silent)
if(mrbin.env$mrbin$parameters$verbose){
mrbin.env$mrbin<-editmrbin(mrbinObject=mrbin.env$mrbin,
functionName="mrbin::mrbin",
versionNumber=as.character(utils::packageVersion("mrbin")),
parameters=list(createCode=printParameters()),verbose=FALSE)
}
invisible(mrbin.env$mrbin)
}
}
#' A function performing all data read and processing steps.
#'
#' This function reads parameters from the global variable mrbin.env$mrbin$parameters and
#' performs the following operations:
#' Reading NMR files, creating bins, removing solvent area, removing additional
#' user-defined areas, summing up bins that contain unstable peaks such as
#' citric acid, removes noise bins, crops HSQC spectra to the diagonal area,
#' performs PQN scaling, replaces negative values, log transforms and displays a
#' PCA plot. Parameters are then saved in a text file. These can be recreated
#' using recreatemrbin().
#' @param createbins If TRUE, new bin data is generated
#' @param process If TRUE, bin data is processed, e.g. by noise removal, atnv, etc.
#' @param mrbinResults An mrbin object. Needs to be provided only if createbins is FALSE
#' @param silent If set to FALSE, no new time calculation is performed
#' @return An invisible mrbin object
#' @export
#' @examples
#' resetEnv()
#' setParam(parameters=list(dimension="2D",binwidth2D=0.1,binheight=5,
#' binRegion=c(8,1,15,140),PQNScaling="No",tryParallel=FALSE,
#' fixNegatives="No",logTrafo="No",signal_to_noise2D=10,solventRegion=c(5.5,4.2),
#' NMRfolders=c(system.file("extdata/1/12/pdata/10",package="mrbin"),
#' system.file("extdata/2/12/pdata/10",package="mrbin"))))
#' mrbinrun()
mrbinrun<-function(createbins=TRUE,process=TRUE,mrbinResults=NULL,silent=TRUE){
defineGroups<-FALSE
if(!is.null(mrbin.env$mrbin$parameters$NMRfolders)){
if(createbins){
mrbin.env$mrbinTMP$scaleFactorTMP1<-NULL
mrbin.env$mrbinTMP$scaleFactorTMP2<-NULL
mrbin.env$mrbinTMP$scaleFactorTMP3<-NULL
if(mrbin.env$mrbin$parameters$verbose){
message("\nPreparing parameters... ", appendLF = FALSE)
utils::flush.console()
}
mrbin.env$mrbinTMP$currentFolder<-mrbin.env$mrbin$parameters$NMRfolders[1]
readNMR2()
createBinNumbers()
createBinRegions()
mrbin.env$mrbin$parameters$numberOfFeaturesRaw<-nrow(mrbin.env$mrbin$parameters$binRegions)
if(mrbin.env$mrbin$parameters$removeSolvent=="Yes") removeSolvent()
if(mrbin.env$mrbin$parameters$removeAreas=="Yes") removeAreas()
if(mrbin.env$mrbin$parameters$sumBins=="Yes") sumBins()
if(mrbin.env$mrbin$parameters$cropHSQC=="Yes"&mrbin.env$mrbin$parameters$dimension=="2D") cropNMR()
#Sort bins
if(nrow(mrbin.env$mrbin$parameters$binRegions)>1){
binRegionsTMP<-mrbin.env$mrbin$parameters$binRegions
binRegionsTMP<-binRegionsTMP[rev(order(binRegionsTMP[,3])),,drop=FALSE]
}
if(mrbin.env$mrbin$parameters$verbose){
message("done. \n", appendLF = FALSE)
utils::flush.console()
}
if(mrbin.env$mrbin$parameters$verbose){
message("Binning spectra... ", appendLF = FALSE)
utils::flush.console()
}
if(silent|mrbin.env$mrbinTMP$timeEstimate==0){#time needs to be estimated now if mrbin was not run in interactive mode
mrbin.env$mrbinTMP$currentFolder<-mrbin.env$mrbin$parameters$NMRfolders[1]
readNMR2()#necessary to fill the variables, otherwise the next line is "too fast" and estimate will be off
mrbin.env$mrbinTMP$timeEstimate<-max(.001,system.time(readNMR2())[1])
if(mrbin.env$mrbin$parameters$dimension=="1D") coverageRatioTMP<-nrow(
mrbin.env$mrbin$parameters$binRegions)/((max(as.numeric(
names(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
names(mrbin.env$mrbinTMP$currentSpectrum))))/mrbin.env$mrbin$parameters$binwidth1D)
if(mrbin.env$mrbin$parameters$dimension=="2D") coverageRatioTMP<-nrow(
mrbin.env$mrbin$parameters$binRegions)/((max(as.numeric(
colnames(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
colnames(mrbin.env$mrbinTMP$currentSpectrum))))*
(max(as.numeric(rownames(mrbin.env$mrbinTMP$currentSpectrum)))-min(as.numeric(
rownames(mrbin.env$mrbinTMP$currentSpectrum))))/
(mrbin.env$mrbin$parameters$binwidth2D*mrbin.env$mrbin$parameters$binheight))
dimScaleTMP<-1
if(mrbin.env$mrbin$parameters$dimension=="2D") dimScaleTMP<-.5
NrowTMP<-400#mock number of bins
NrowTMP2<-nrow(mrbin.env$mrbin$parameters$binRegions)/NrowTMP#ratio of real number of bins to mock number of bins
NpointsTMP<-100#mock number of data points per bin
NpointsTMP2<-ceiling(1+(coverageRatioTMP*length(mrbin.env$mrbinTMP$currentSpectrum)/
nrow(mrbin.env$mrbin$parameters$binRegions)))/NpointsTMP#ratio of estimated number of data points per bin to mock data point number
#calculate some sums in a loop as a mock binning example for time estimation
mrbin.env$mrbinTMP$timeEstimate<-mrbin.env$mrbinTMP$timeEstimate+max(.001,system.time(
for(i in 1:NrowTMP) sum((1:(NpointsTMP*NrowTMP))[(1:(NpointsTMP*NrowTMP))<(i*NpointsTMP)&
(1:(NpointsTMP*NrowTMP))>((i-1)*NpointsTMP)]))[1])*
(dimScaleTMP*20*NrowTMP2*NpointsTMP2^.5)
if(mrbin.env$mrbin$parameters$tryParallel){
mrbin.env$mrbinTMP$timeEstimate<-dimScaleTMP*mrbin.env$mrbinTMP$timeEstimate*ceiling(length(
mrbin.env$mrbin$parameters$NMRfolders)/max(1,(parallel::detectCores()-1)))
} else {
mrbin.env$mrbinTMP$timeEstimate<-dimScaleTMP*mrbin.env$mrbinTMP$timeEstimate*length(
mrbin.env$mrbin$parameters$NMRfolders)
}
}
if(mrbin.env$mrbin$parameters$verbose){
message(paste("(estimated time: ",round(
mrbin.env$mrbinTMP$timeEstimate/60,0)," min or more) ",sep=""), appendLF = FALSE)
utils::flush.console()
}
#This creates the actual bins:
mrbinResults<-binMultiNMR()
if(mrbinResults$parameters$trimZeros=="Yes") mrbinResults<-trimZeros(mrbinResults)
if(mrbinResults$parameters$verbose) message("done.\n", appendLF = FALSE)
utils::flush.console()
}
if(process){
if(mrbinResults$parameters$verbose){
message("Processing data... ", appendLF = FALSE)
utils::flush.console()
}
mrbin.env$mrbinTMP$additionalPlots1D<-NULL
mrbin.env$mrbinTMP$additionalPlots1DMetadata<-NULL
mrbin.env$mrbinTMP$additionalPlots2D<-NULL
mrbin.env$mrbinTMP$additionalPlots2DMetadata<-NULL
#Find 3 more spectra: 33 percentile, 66 percentile, last spectrum
mrbin.env$mrbinTMP$spectrumListPlotTMP<-setdiff(unique(c(
ceiling(length(mrbinResults$parameters$NMRfolders)*.33),
ceiling(length(mrbinResults$parameters$NMRfolders)*.66),
length(mrbinResults$parameters$NMRfolders))),1)
if(length(mrbin.env$mrbinTMP$spectrumListPlotTMP)>0){
#for 2D spectra, only plot one additional spectrum to increase speed
for(ispectrumListPlotTMP in 1:length(mrbin.env$mrbinTMP$spectrumListPlotTMP)){
addToPlot(folder=mrbinResults$parameters$NMRfolders[
mrbin.env$mrbinTMP$spectrumListPlotTMP[ispectrumListPlotTMP]],
dimension=mrbinResults$parameters$dimension,
NMRvendor=mrbinResults$parameters$NMRvendor,
useAsNames=mrbinResults$parameters$useAsNames)
}
}
#create and save noise plots
if(silent&mrbinResults$parameters$saveFiles=="Yes") setNoiseLevels(mrbinResults,plotOnly=TRUE,silent=silent)
if(mrbinResults$parameters$noiseRemoval=="Yes") mrbinResults<-removeNoise(mrbinResults,verbose=FALSE)
if(mrbinResults$parameters$dilutionCorrection=="Yes") mrbinResults<-dilutionCorrection(mrbinResults)
if(mrbinResults$parameters$fixNegatives=="Yes") mrbinResults<-atnv(mrbinResults,verbose=FALSE)
if(mrbinResults$parameters$PQNScaling=="Yes") mrbinResults<-PQNScaling(mrbinResults,verbose=FALSE)
if(mrbinResults$parameters$logTrafo=="Yes") mrbinResults<-logTrafo(mrbinResults,verbose=FALSE)
if(mrbinResults$parameters$unitVarianceScaling=="Yes") mrbinResults<-unitVarianceScaling(mrbinResults,verbose=FALSE)
if(mrbinResults$parameters$verbose){
message("done.\n", appendLF = FALSE)
utils::flush.console()
}
if(mrbinResults$parameters$saveFiles=="Yes"){
save(mrbinResults,file=paste(mrbinResults$parameters$outputFileName,".Rdata",sep=""))
dput(mrbinResults$parameters, file = paste(mrbinResults$parameters$outputFileName,".txt",sep=""))
#utils::write.csv(mrbinResults$bins,file=paste(mrbinResults$parameters$outputFileName,"bins.csv",sep=""))
}
resultOutputTMP<-c("\nNumber of spectra: ",nrow(mrbinResults$bins),"\n",
"Number of bins at start: ",mrbinResults$parameters$numberOfFeaturesRaw,"\n")
if(!is.null(mrbinResults$parameters$numberOfFeaturesAfterRemovingSolvent)&
mrbinResults$parameters$removeSolvent=="Yes"){
resultOutputTMP<-c(resultOutputTMP,"Number of bins after removing solvent: ",
mrbinResults$parameters