diff --git a/R/gl.assign.r b/R/gl.assign.r index 260d7ee7..0b164ca7 100644 --- a/R/gl.assign.r +++ b/R/gl.assign.r @@ -74,7 +74,7 @@ gl.assign <- function (x, unknown, nmin=10, dim=NULL, alpha= 0.05, threshold=0, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.collapse.pval.r b/R/gl.collapse.pval.r index 23a38941..405ab394 100644 --- a/R/gl.collapse.pval.r +++ b/R/gl.collapse.pval.r @@ -57,7 +57,7 @@ gl.collapse.pval <- function(fd, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.collapse.r b/R/gl.collapse.r index eccb1b89..032ff117 100644 --- a/R/gl.collapse.r +++ b/R/gl.collapse.r @@ -71,7 +71,7 @@ gl.collapse <- function(fd, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.collapse.recursive.r b/R/gl.collapse.recursive.r index 5dff5248..2a4a80b7 100644 --- a/R/gl.collapse.recursive.r +++ b/R/gl.collapse.recursive.r @@ -81,7 +81,7 @@ gl.collapse.recursive <- function(x, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.compliance.check.r b/R/gl.compliance.check.r index d0e630d1..cd0720b0 100644 --- a/R/gl.compliance.check.r +++ b/R/gl.compliance.check.r @@ -47,7 +47,7 @@ gl.compliance.check <- function (x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } @@ -108,7 +108,7 @@ gl.compliance.check <- function (x, verbose=NULL) { if (verbose >= 2){cat(" Checking verbosity flag\n")} if(is.null(x@other$verbose)){ if (verbose >= 1){cat(" Creating verbosity flag\n")} - x <- utils.reset.verbosity(x,set.verbosity=2,verbose=0) + x <- utils.reset.verbosity(x,value=2,verbose=0) } else { if (verbose >= 1){cat(" Verbosity flag confirmed\n")} } @@ -118,7 +118,13 @@ gl.compliance.check <- function (x, verbose=NULL) { if (verbose >= 2){cat(" Recalculating locus metrics\n")} x <- gl.recalc.metrics(x,verbose=verbose) - # Check that the individual metricx exist, and if not, create the df + # Check that the number of values in the loc.metrics dataframe is the same as the number of loci + + if (nLoc(gl)!=nrow(gl@other$loc.metrics)) { + cat(" The number of rows in the loc.metrics table does not match the number of loci! This is potentially a major problem if there is a mismatch of the loci with the metadata. Trace back to identify the cause.\n") + } + + # Check that the individual metrics exist, and if not, create the df if (verbose >= 2){cat(" Checking for individual metrics\n")} if(is.null(x@other$loc.metrics)){ diff --git a/R/gl.define.pop.r b/R/gl.define.pop.r index 5ac52eff..7f551a2a 100644 --- a/R/gl.define.pop.r +++ b/R/gl.define.pop.r @@ -40,7 +40,7 @@ gl.define.pop <- function(x, ind.list, new, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.dist.ind.r b/R/gl.dist.ind.r index 2d878c22..18947ab1 100644 --- a/R/gl.dist.ind.r +++ b/R/gl.dist.ind.r @@ -63,7 +63,7 @@ gl.dist.ind <- function(x, method=NULL, plot=TRUE, boxplot="standard", range=1.5 if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.dist.pop.r b/R/gl.dist.pop.r index d4116587..bd31a53c 100644 --- a/R/gl.dist.pop.r +++ b/R/gl.dist.pop.r @@ -55,7 +55,7 @@ gl.dist.pop <- function(x, method="euclidean", plot=TRUE, boxplot="standard", ra if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.drop.ind.r b/R/gl.drop.ind.r index 5c619914..0bd2c2ce 100644 --- a/R/gl.drop.ind.r +++ b/R/gl.drop.ind.r @@ -45,7 +45,7 @@ gl.drop.ind <- function(x, ind.list, recalc=FALSE, mono.rm=FALSE, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.drop.loc.r b/R/gl.drop.loc.r index 593db3c6..f4700496 100644 --- a/R/gl.drop.loc.r +++ b/R/gl.drop.loc.r @@ -40,7 +40,7 @@ gl.drop.loc <- function(x, loc.list=NULL, first=NULL, last=NULL, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.drop.pop.r b/R/gl.drop.pop.r index bbafb5c3..344e58cd 100644 --- a/R/gl.drop.pop.r +++ b/R/gl.drop.pop.r @@ -49,7 +49,7 @@ gl.drop.pop <- function(x, pop.list, as.pop=NULL, recalc=FALSE, mono.rm=FALSE, v if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.edit.recode.ind.r b/R/gl.edit.recode.ind.r index 7e379705..1473cdcb 100644 --- a/R/gl.edit.recode.ind.r +++ b/R/gl.edit.recode.ind.r @@ -29,8 +29,8 @@ #' @param outpath -- path where to save the output file [default tempdir(), mandated by CRAN]. #' @param recalc -- Recalculate the locus metadata statistics [default TRUE] #' @param mono.rm -- Remove monomorphic loci [default TRUE] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return An object of class ("genlight") with the revised individual labels -#' @param verbose -- verbose=0, silent; verbose=1, low verbosity; verbose=2, high verbosity [default 2] #' @import utils #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) @@ -43,30 +43,40 @@ gl.edit.recode.ind <- function(x, out.recode.file=NULL, outpath=tempdir(), recalc=FALSE, mono.rm=FALSE, verbose=NULL){ - # TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" if (!is.null(out.recode.file)){ outfilespec <- file.path(outpath, out.recode.file) } - - # FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } - # STANDARD ERROR CHECKING +# STANDARD ERROR CHECKING if(class(x)!="genlight") { stop("Fatal Error: genlight object required!\n") diff --git a/R/gl.edit.recode.pop.r b/R/gl.edit.recode.pop.r index f18f2ca3..24773803 100644 --- a/R/gl.edit.recode.pop.r +++ b/R/gl.edit.recode.pop.r @@ -31,7 +31,7 @@ #' @param outpath -- path where to save the output file [default tempdir(), mandated by CRAN]. #' @param recalc -- Recalculate the locus metadata statistics if any individuals are deleted [default TRUE] #' @param mono.rm -- Remove monomorphic loci [default TRUE] -#' @param verbose -- specify the level of verbosity: 0, silent, fatal errors only; 1, flag function begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return An object of class ("genlight") with the revised population assignments #' @import utils #' @export @@ -43,27 +43,37 @@ gl.edit.recode.pop <- function(x, pop.recode=NULL, out.recode.file=NULL, outpath=tempdir(), recalc=FALSE, mono.rm=FALSE, verbose=NULL) { -# TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" if (!is.null(out.recode.file)){ outfilespec <- file.path(outpath, out.recode.file) - } + } + +# SET VERBOSITY -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING diff --git a/R/gl.filter.callrate.r b/R/gl.filter.callrate.r index cc87b1e1..9417f027 100644 --- a/R/gl.filter.callrate.r +++ b/R/gl.filter.callrate.r @@ -63,7 +63,7 @@ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.hamming.r b/R/gl.filter.hamming.r index 428cbdd7..94c56717 100644 --- a/R/gl.filter.hamming.r +++ b/R/gl.filter.hamming.r @@ -65,7 +65,7 @@ gl.filter.hamming <- function(x, threshold=0.2, rs=5, pb=FALSE, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.heterozygosity.r b/R/gl.filter.heterozygosity.r index 951f6689..d387b74c 100644 --- a/R/gl.filter.heterozygosity.r +++ b/R/gl.filter.heterozygosity.r @@ -42,7 +42,7 @@ gl.filter.heterozygosity <- function(x, t.upper=0.7, t.lower=0, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.hwe.r b/R/gl.filter.hwe.r index fa57d58e..26c9eb97 100644 --- a/R/gl.filter.hwe.r +++ b/R/gl.filter.hwe.r @@ -49,7 +49,7 @@ gl.filter.hwe <- function(x, alpha=0.05, basis="any", bon=TRUE, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.maf.r b/R/gl.filter.maf.r index 8ba36dac..49f387c2 100644 --- a/R/gl.filter.maf.r +++ b/R/gl.filter.maf.r @@ -44,7 +44,7 @@ gl.filter.maf <- function(x, threshold=0.01, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.monomorphs.r b/R/gl.filter.monomorphs.r index 46028dfd..0118ab49 100644 --- a/R/gl.filter.monomorphs.r +++ b/R/gl.filter.monomorphs.r @@ -47,7 +47,7 @@ gl.filter.monomorphs <- function (x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.overshoot.r b/R/gl.filter.overshoot.r index 59bb525e..9b9e650d 100644 --- a/R/gl.filter.overshoot.r +++ b/R/gl.filter.overshoot.r @@ -42,7 +42,7 @@ gl.filter.overshoot <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.pa.r b/R/gl.filter.pa.r index 14d95e39..1f5ed3e5 100644 --- a/R/gl.filter.pa.r +++ b/R/gl.filter.pa.r @@ -42,7 +42,7 @@ gl.filter.pa<-function(x, pop1, pop2, invers=FALSE, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.rdepth.r b/R/gl.filter.rdepth.r index d7ca5dc5..6ea077a6 100644 --- a/R/gl.filter.rdepth.r +++ b/R/gl.filter.rdepth.r @@ -47,7 +47,7 @@ gl.filter.rdepth <- function(x, lower=5, upper=50, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.repeatability.r b/R/gl.filter.repeatability.r index beb4dd92..ae9fee31 100644 --- a/R/gl.filter.repeatability.r +++ b/R/gl.filter.repeatability.r @@ -47,7 +47,7 @@ gl.filter.repeatability <- function(x, threshold=0.99, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.secondaries.r b/R/gl.filter.secondaries.r index 94b37e24..f9bdde90 100644 --- a/R/gl.filter.secondaries.r +++ b/R/gl.filter.secondaries.r @@ -46,7 +46,7 @@ gl.filter.secondaries <- function(x, method="random", verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.filter.taglength.r b/R/gl.filter.taglength.r index b2989952..5d805683 100644 --- a/R/gl.filter.taglength.r +++ b/R/gl.filter.taglength.r @@ -45,7 +45,7 @@ gl.filter.taglength <- function(x, lower=20, upper=69, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.fixed.diff.r b/R/gl.fixed.diff.r index f325f500..5b3b771c 100644 --- a/R/gl.fixed.diff.r +++ b/R/gl.fixed.diff.r @@ -69,7 +69,7 @@ gl.fixed.diff <- function(x, tloc=0, test=FALSE, delta=0.02, reps=1000, mono.rm= if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.grm.r b/R/gl.grm.r index e791c4b0..9d3d5c4f 100644 --- a/R/gl.grm.r +++ b/R/gl.grm.r @@ -1,10 +1,11 @@ #' Calculates the genomic relatedness matrix #' #' The G matrix is calculated by centering the allele frequency matrix of the second allele by substracting 2 times the allefrequency -#'@param gl -- a genlight object +#'@param x -- a genlight object #'@param plotheatmap -- a switch if a heatmap should be shown [Default:TRUE] #'@param return.imputed switch if loci with imputed data should be returned (see ?A.mat in package rrBLUP) #'@param ... parameters passed to function A.mat from package rrBLUP +#'@param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #'@return a genomic relatedness matrix #'@importFrom stats heatmap cov var #'@importFrom rrBLUP A.mat @@ -14,13 +15,58 @@ #'gl.grm(bandicoot.gl[1:5,1:10],plotheatmap=TRUE) -gl.grm <- function(gl, plotheatmap=TRUE, return.imputed=FALSE, ...) -{ +gl.grm <- function(x, plotheatmap=TRUE, return.imputed=FALSE, verbose=NULL, ...){ + +# TRAP COMMAND, SET VERSION + + funname <- match.call()[[1]] + build <- "Jacob" + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } + + if (verbose < 0 | verbose > 5){ + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) + verbose <- 2 + } + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } + } + +# STANDARD ERROR CHECKING + + if(class(x)!="genlight") { + stop("Fatal Error: genlight object required!\n") + } + + if (all(x@ploidy == 1)){ + stop(" Detected Tag Presence/Absence (SilicoDArT) data. Please provide a SNP dataset\n") + } else if (all(x@ploidy == 2)){ + cat(" Processing a SNP dataset\n") + } else { + stop("Fatal Error: Ploidy must be universally 1 (fragment P/A data) or 2 (SNP data)!\n") + } + +# DO THE JOB + G <- A.mat(as.matrix(gl)-1,return.imputed = return.imputed) #if (plotheatmap & return.imputed==FALSE) heatmap(G) else heatmap(G$A) #### BERND, G$A THROWS AND ERROR if (plotheatmap & return.imputed==FALSE) heatmap(G) else heatmap(G) - # ff <- as.matrix(gl) # alf <- colMeans(ff, na.rm = T)/2 # pjm <- matrix(rep(alf,nInd(gl)), ncol=nLoc(gl), nrow=nInd(gl), byrow=T) @@ -35,5 +81,12 @@ if (plotheatmap & return.imputed==FALSE) heatmap(G) else heatmap(G) # GG <- GG[ii, ] # # if (plotheatmap & nrow(GG)>0) heatmap(GG) -return (G) + +# FLAG SCRIPT END + + if(verbose >= 1){ + cat("Completed:",funname,"\n") + } + + return (G) } \ No newline at end of file diff --git a/R/gl.join.r b/R/gl.join.r index ef8e5ff8..8b452146 100644 --- a/R/gl.join.r +++ b/R/gl.join.r @@ -48,7 +48,7 @@ gl.join <- function(x1, x2, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.keep.ind.r b/R/gl.keep.ind.r index ff45ade4..b208ac22 100644 --- a/R/gl.keep.ind.r +++ b/R/gl.keep.ind.r @@ -45,7 +45,7 @@ gl.keep.ind <- function(x, ind.list, recalc=FALSE, mono.rm=FALSE, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.keep.loc.r b/R/gl.keep.loc.r index 7707948a..82ab8cef 100644 --- a/R/gl.keep.loc.r +++ b/R/gl.keep.loc.r @@ -40,7 +40,7 @@ gl.keep.loc <- function(x, loc.list=NULL, first=NULL, last=NULL, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.keep.pop.r b/R/gl.keep.pop.r index b08141cd..f2754725 100644 --- a/R/gl.keep.pop.r +++ b/R/gl.keep.pop.r @@ -49,7 +49,7 @@ gl.keep.pop <- function(x, pop.list, as.pop=NULL, recalc=FALSE, mono.rm=FALSE, v if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.make.recode.ind.r b/R/gl.make.recode.ind.r index a857c693..27ed8b03 100644 --- a/R/gl.make.recode.ind.r +++ b/R/gl.make.recode.ind.r @@ -18,7 +18,7 @@ #' @param x -- name of the genlight object containing the SNP data [required] #' @param out.recode.file -- file name of the output file (including extension) [default default_recode_ind.csv] #' @param outpath -- path where to save the output file [default tempdir(), mandated by CRAN]. Use outpath=getwd() or outpath="." when calling this function to direct output files to your working directory. -#' @param verbose -- specify the level of verbosity: 0, silent, fatal errors only; 1, flag function begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return A vector containing the new individual names #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) @@ -27,25 +27,35 @@ gl.make.recode.ind <- function(x, out.recode.file="default_recode_ind.csv", outpath=tempdir(), verbose=NULL) { -# TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" outfilespec <- file.path(outpath, out.recode.file) -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING diff --git a/R/gl.make.recode.pop.r b/R/gl.make.recode.pop.r index 9d64abf1..33da7770 100644 --- a/R/gl.make.recode.pop.r +++ b/R/gl.make.recode.pop.r @@ -14,7 +14,7 @@ #' @param x -- name of the genlight object containing the SNP data [required] #' @param out.recode.file -- file name of the output file (including extension) [default recode_pop_table.csv] #' @param outpath -- path where to save the output file [default tempdir(), mandated by CRAN]. Use outpath=getwd() or outpath="." when calling this function to direct output files to your working directory. -#' @param verbose -- specify the level of verbosity: 0, silent, fatal errors only; 1, flag function begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return A vector containing the new population names #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) @@ -24,25 +24,35 @@ gl.make.recode.pop <- function(x, out.recode.file="recode_pop_table.csv", outpath=tempdir(), verbose=NULL) { -# TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" outfilespec <- file.path(outpath, out.recode.file) -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING @@ -83,8 +93,4 @@ return(NULL) } - - # # Test scripts - # gl.make.recode.pop(gl,out.recode.file="test.csv",outpath=getwd(),verbose=2) - # gl.make.recode.pop(gs,out.recode.file="test.csv",outpath=getwd(),verbose=3) - + \ No newline at end of file diff --git a/R/gl.merge.pop.r b/R/gl.merge.pop.r index a10d4821..098ba8d7 100644 --- a/R/gl.merge.pop.r +++ b/R/gl.merge.pop.r @@ -43,7 +43,7 @@ gl.merge.pop <- function(x, old=NULL, new=NULL, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.nhybrids.r b/R/gl.nhybrids.r index 0174246e..e7cfc9cb 100644 --- a/R/gl.nhybrids.r +++ b/R/gl.nhybrids.r @@ -54,7 +54,7 @@ #' @param AFPriorFile -- name of the file containing prior allele frequency information [default NULL] #' @param PiPrior -- Jeffreys-like priors or Uniform priors for the parameter pi [default Jeffreys] #' @param ThetaPrior -- Jeffreys-like priors or Uniform priors for the parameter theta [default Jeffreys] -#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return The reduced genlight object, if parentals are provided; output of NewHybrids is saved to disk #' @export #' @importFrom MASS write.matrix @@ -84,20 +84,52 @@ gl.nhybrids <- function(gl, outfile="nhyb.txt", outpath=tempdir(), ThetaPrior = "Jeffreys", verbose=NULL) { - if(class(gl)!="genlight") { - cat("Fatal Error: genlight object required!\n"); stop("Execution terminated\n") - } - # Work around a bug in adegenet if genlight object is created by subsetting - if (nLoc(gl)!=nrow(gl@other$loc.metrics)) { stop("The number of rows in the loc.metrics table does not match the number of loci in your genlight object!") } - - if (is.null(verbose) & !is.null(gl@other$verbose)) verbose=gl@other$verbose - if (is.null(verbose)) verbose=2 +# TRAP COMMAND, SET VERSION + + funname <- match.call()[[1]] + build <- "Jacob" + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: verbosity must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } + } + +# STANDARD ERROR CHECKING + + if(class(x)!="genlight") { + stop("Fatal Error: genlight object required!\n") + } + + if (all(x@ploidy == 1)){ + stop(" Detected Tag Presence/Absence (SilicoDArT) data. Please provide a SNP dataset\n") + } else if (all(x@ploidy == 2)){ + cat(" Processing a SNP dataset\n") + } else { + stop("Fatal Error: Ploidy must be universally 1 (fragment P/A data) or 2 (SNP data)!\n") + } + + # FUNCTION SPECIFIC ERROR CHECKING + if (!(method=="random" | method=="AvgPic" | method=="avgPic" | method=="AvgPIC")){ cat(" Warning: method must be either 'random' or AvgPic, set to 'random'\n") method <- "random" @@ -108,12 +140,8 @@ gl.nhybrids <- function(gl, outfile="nhyb.txt", outpath=tempdir(), pprob <- 0.99 } - if (verbose > 0) { - cat("Starting gl.nhybrids: Assigning individual to hybrid categories\n") - } +# DO THE JOB - #if (verbose < 2) { sink("/dev/null") } - gl.tmp <- gl thold<-threshold loc.limit <- 200 @@ -405,7 +433,12 @@ gl.nhybrids <- function(gl, outfile="nhyb.txt", outpath=tempdir(), cat("\nResults are stored in file aa-PofZ.csv\n") cat("Returning data used by New Hybrids in generating the results, as a genlight object\n") } - if (verbose > 0) {cat("gl.nhybrids Completed\n")} + + # FLAG SCRIPT END + + if(verbose >= 1){ + cat("Completed:",funname,"\n") + } return(gl2nhyb) diff --git a/R/gl.outflank.r b/R/gl.outflank.r deleted file mode 100644 index 66452b68..00000000 --- a/R/gl.outflank.r +++ /dev/null @@ -1,44 +0,0 @@ -#' Function to identify loci under selection per population using the outflank method of Whitlock and Lotterhos (2015) -#' -#' @param gi a genlight of genind object, with a defined population structure -#' @param plot a switch if a barplot is wanted. -#' @param LeftTrimFraction The proportion of loci that are trimmed from the lower end of the range of Fst before the likelihood funciton is applied. -#' @param RightTrimFraction The proportion of loci that are trimmed from the upper end of the range of Fst before the likelihood funciton is applied. -#' @param Hmin The minimum heterozygosity required before including calculations from a locus. -#' @param qthreshold The desired false discovery rate threshold for calculating q-values. -#' @param ... additional parameters (see documentation of outflank on github) -#' @return returns an index of outliers and the full outflank list -#' @details this function is a wrapper around the outflank function provided by Whitlock and Lotterhus. To be able to run this function the packages qvalue (from bioconductor) and outflank (from github) needs to be installed. To do so see example below. -#' @export -#' @importFrom qvalue qvalue -#' @importFrom stats optim pgamma quantile -#' @examples -#' \donttest{ -#' gl.outflank(bandicoot.gl, plot = TRUE) -#' } -#' @references Whitlock, M.C. and Lotterhos K.J. (2015) Reliable detection of loci responsible for local adaptation: inference of a neutral model through trimming the distribution of Fst. The American Naturalist 186: 24 - 36. -#' -#' Github repository: Whitlock & Lotterhos: \url{https://github.com/whitlock/OutFLANK} (Check the readme.pdf within the repository for an explanation. Be aware you now can run OufFLANK from a genlight object) -#' @seealso \code{\link{utils.outflank}}, \code{\link{utils.outflank.plotter}}, \code{\link{utils.outflank.MakeDiploidFSTMat}} - - - - -gl.outflank <- function(gi, plot=TRUE, LeftTrimFraction=0.05, RightTrimFraction=0.05, Hmin=0.1, qthreshold=0.05, ... ) -{ -# convert genlight to genind -if (class(gi)=="genlight") gi <- gl2gi(gi) - -# missing value is 9!!! tempted to rewrite their model to be able to use genlight directly.... - snpmat <- as.matrix(gi)#(matrix(NA, nrow=nind, ncol=nsnp) - snpmat <- replace(snpmat, is.na(snpmat), 9) - mdfm <- utils.outflank.MakeDiploidFSTMat(SNPmat = snpmat, list(colnames(snpmat)), list(as.character(gi@pop))) - #run outflank - outf <- utils.outflank(mdfm, LeftTrimFraction = LeftTrimFraction, RightTrimFraction=RightTrimFraction, Hmin = Hmin, NumberOfSamples = length(levels(gi@pop)), qthreshold = qthreshold) - if (plot) utils.outflank.plotter(outf) - index.outflank <- !(outf$results$OutlierFlag) ## 6650 inliers and 188 outliers - return(list(index=index.outflank, outflank=outf)) -} - - - diff --git a/R/gl.pcoa.plot.3d.r b/R/gl.pcoa.plot.3d.r index 0b3f34a0..f17bd264 100644 --- a/R/gl.pcoa.plot.3d.r +++ b/R/gl.pcoa.plot.3d.r @@ -64,7 +64,7 @@ gl.pcoa.plot.3d <- function(x, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.pcoa.plot.r b/R/gl.pcoa.plot.r index 902fcdd4..ee948fff 100644 --- a/R/gl.pcoa.plot.r +++ b/R/gl.pcoa.plot.r @@ -90,7 +90,7 @@ gl.pcoa.plot <- function(glPca, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.pcoa.pop.r b/R/gl.pcoa.pop.r deleted file mode 100644 index 6c18333e..00000000 --- a/R/gl.pcoa.pop.r +++ /dev/null @@ -1,46 +0,0 @@ -#' PCoA ordination of populations -#' -#' This script takes the data on allele frequencies for populations and undertakes a Gower -#' PCoA ordination using a nominated distance measure. It draws population information and -#' calculates gene frequencies by drawing upon -#' data in the original genlight \{adegenet\} object (entity x attribute matrix). -#' The script is essentially a wrapper for pcoa() \{ape\}. -#' -#' @param gl -- name of the genlight object containing the SNP genotypes by specimen and population [required] -#' @param c -- Correction methods for negative eigenvalues: \"lingoes\" and \"cailliez\" Refer to \{ape\} documentation. -#' [default \"none\"] -#' @param method -- the distance measure to be used. This must be one of "euclidean", -#' "maximum", "manhattan", "canberra", "binary" or "minkowski". Any unambiguous substring can be given. -#' @return An object of class pcoa containing the eigenvalues, factor scores and factor loadings -#' @author Arthur Georges (gl.bugs@aerg.canberra.edu.au) -#' @export -#' @importFrom ape pcoa -#' @examples -#' pcoa <- gl.pcoa.pop(testset.gl) -#' pcoa <- gl.pcoa.pop(testset.gl, c="cailliez", m="minkowski") - - -gl.pcoa.pop <- function(gl, c="none", method="euclidean") { - - cat("PCoA on allele frequencies -- populations", - "as entities, SNP loci as attributes\n") - - mat <- gl.gene.freq(gl, method=levels(pop(gl))) - - D <- dist(mat, method=method, diag=FALSE, upper=FALSE, p=2) - - t <- pcoa(D, correction=c, rn=attributes(D)$Labels) - - e <- round(t$values[,2]*100/sum(t$values[,2]),1) - cat(paste("Ordination yielded",length(e),"dimensions being the number of populations minus 1\n")) - cat(paste(" PCoA Axis 1 explains",e[1],"% of the total variance\n")) - cat(paste(" PCoA Axes 1 and 2 combined explain",e[1]+e[2],"% of the total variance\n")) - cat(paste(" PCoA Axes 1-3 combined explain",e[1]+e[2]+e[3],"% of the total variance\n")) - - - t2 <- list(t$values[,1],t$vectors) - names(t2) <- c("eig", "scores") - class(t2) <- "glPca" - - return(t2) -} diff --git a/R/gl.pcoa.r b/R/gl.pcoa.r index 30c1aa59..ea0488b1 100644 --- a/R/gl.pcoa.r +++ b/R/gl.pcoa.r @@ -103,7 +103,7 @@ gl.pcoa <- function(x, nfactors=5, correction=NULL, parallel=FALSE, n.cores=16, if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.pcoa.scree.r b/R/gl.pcoa.scree.r index b5fd037d..82ec429f 100644 --- a/R/gl.pcoa.scree.r +++ b/R/gl.pcoa.scree.r @@ -47,7 +47,7 @@ gl.pcoa.scree <- function(x, top=TRUE, verbose=0) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.percent.freq.r b/R/gl.percent.freq.r index 6e1deaab..3878592d 100644 --- a/R/gl.percent.freq.r +++ b/R/gl.percent.freq.r @@ -40,7 +40,7 @@ gl.percent.freq<- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.plot.heatmap.r b/R/gl.plot.heatmap.r index 6f004b03..ea8904eb 100644 --- a/R/gl.plot.heatmap.r +++ b/R/gl.plot.heatmap.r @@ -23,22 +23,44 @@ #' gl.plot.heatmap(D) #' gl.plot.heatmap(D, ncolors=10, rank=TRUE, legend=TRUE) -gl.plot.heatmap <- function(D, ncolors=5, labels=TRUE, labels.cex=1, values=TRUE, values.cex=1, legend=TRUE, rank=FALSE, verbose=2){ +gl.plot.heatmap <- function(D, + ncolors=5, + labels=TRUE, + labels.cex=1, + values=TRUE, + values.cex=1, + legend=TRUE, + rank=FALSE, + verbose=NULL){ + +# TRAP COMMAND, SET VERSION -# TIDY UP FILE SPECS - funname <- match.call()[[1]] - -# FLAG SCRIPT START - # set verbosity + build <- "Jacob" + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } - - if (verbose > 0) { - cat("Starting",funname,"\n") + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # FUNCTION SPECIFIC ERROR CHECKING diff --git a/R/gl.plot.network.r b/R/gl.plot.network.r index 2dc59349..17ea364d 100644 --- a/R/gl.plot.network.r +++ b/R/gl.plot.network.r @@ -34,40 +34,61 @@ #'@author Arthur Georges (Post to https://groups.google.com/d/forum/dartr) #' #'@examples -#'#gl.plot.network(D) +#' D <- gl.grm(testset.gl) +#' gl.plot.network(D,testset.gl) -# Last amended 3-Feb-19 - -gl.plot.network <- function(D, x=NULL, method="fr", node.size=3, node.label=FALSE, node.label.size=0.7, node.label.color="black", alpha=0.005, title="Network based on genetic distance", verbose=NULL){ +gl.plot.network <- function(D, + x=NULL, + method="fr", + node.size=3, + node.label=FALSE, + node.label.size=0.7, + node.label.color="black", + alpha=0.005, + title="Network based on genetic distance", + verbose=2){ + +# TRAP COMMAND, SET VERSION -# TIDY UP FILE SPECS - funname <- match.call()[[1]] - -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - + build <- "Jacob" + +# SET VERBOSITY + + if(!is.null(x)) { + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } - - if (verbose > 0) { - cat("Starting",funname,"\n") + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } - + # FUNCTION SPECIFIC ERROR CHECKING if(class(D)!="dist") { - cat("Fatal Error: distance matrix required for gl.dist.network!\n"); stop("Execution terminated\n") + stop("Fatal Error: distance matrix required for gl.dist.network!\n") } if (!is.null(x)){ if(class(x)!="genlight") { - cat("Fatal Error: if specified, genlight object required for gl.dist.network!\n"); stop("Execution terminated\n") + stop("Fatal Error: if specified, genlight object required for gl.dist.network!\n") } } else { if (verbose>=2) { diff --git a/R/gl.plot.r b/R/gl.plot.r index 808cebdd..db3cec12 100644 --- a/R/gl.plot.r +++ b/R/gl.plot.r @@ -24,29 +24,33 @@ gl.plot <- function (x, labels=FALSE, indlabels=indNames(x), col=NULL, legend=TR { # TRAP COMMAND, SET VERSION - + funname <- match.call()[[1]] build <- "Jacob" # SET VERBOSITY - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - - if (verbose < 0 | verbose > 5){ - cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to default 2\n")) + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { verbose <- 2 + } + } + + if (verbose < 0 | verbose > 5){ + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) + verbose <- 2 } - + # FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - - + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING diff --git a/R/gl.read.csv.r b/R/gl.read.csv.r index 187d442d..25e2562d 100644 --- a/R/gl.read.csv.r +++ b/R/gl.read.csv.r @@ -39,21 +39,34 @@ gl.read.csv <- function(filename, loc.metafile=NULL, verbose=NULL){ -# TIDY UP FILE SPECS - +# TRAP COMMAND, SET VERSION + funname <- match.call()[[1]] - -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose)) verbose=2 - - + build <- "Jacob" + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } + if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } - if (verbose > 0) { - cat("Starting",funname,"\n") + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING @@ -244,10 +257,8 @@ gl.read.csv <- function(filename, # MAKE COMPLIANT - gl <- gl.check(gl, verbose=1) - gl <- utils.reset.flags(gl, set=FALSE, verbose=1) - gl <- gl.recalc.metrics(gl, verbose=1) - + gl <- gl.compatability.check(gl, verbose=1) + # FLAG SCRIPT END if (verbose > 0) { diff --git a/R/gl.reassign.pop.r b/R/gl.reassign.pop.r index 1c7d6bc9..c1fb0256 100644 --- a/R/gl.reassign.pop.r +++ b/R/gl.reassign.pop.r @@ -45,7 +45,7 @@ gl.reassign.pop <- function (x, as.pop, verbose = 2) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.recalc.metrics.r b/R/gl.recalc.metrics.r index 6a1ebc89..c9b76a65 100644 --- a/R/gl.recalc.metrics.r +++ b/R/gl.recalc.metrics.r @@ -47,7 +47,7 @@ gl.recalc.metrics <- function(x, verbose=NULL){ if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/gl.recode.ind.r b/R/gl.recode.ind.r index 5171014b..0ed5fc17 100644 --- a/R/gl.recode.ind.r +++ b/R/gl.recode.ind.r @@ -20,7 +20,7 @@ #' @param ind.recode -- name of the csv file containing the individual relabelling [required] #' @param recalc -- if TRUE, recalculate the locus metadata statistics if any individuals are deleted in the filtering [default FALSE] #' @param mono.rm -- if TRUE, remove monomorphic loci [default FALSE] -#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return A genlight or genind object with the recoded and reduced data #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) @@ -32,24 +32,34 @@ gl.recode.ind <- function(x, ind.recode, recalc=FALSE, mono.rm=FALSE, verbose=NULL){ -# TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING diff --git a/R/gl.recode.pop.r b/R/gl.recode.pop.r index 62555575..5754f4ed 100644 --- a/R/gl.recode.pop.r +++ b/R/gl.recode.pop.r @@ -18,7 +18,7 @@ #' @param pop.recode -- name of the csv file containing the population reassignments [required] #' @param recalc -- Recalculate the locus metadata statistics if any individuals are deleted in the filtering [default FALSE] #' @param mono.rm -- Remove monomorphic loci [default FALSE] -#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return A genlight object with the recoded and reduced data #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) @@ -31,24 +31,34 @@ gl.recode.pop <- function(x, pop.recode, recalc=TRUE, mono.rm=TRUE, verbose=NULL){ -# TIDY UP FILE SPECS +# TRAP COMMAND, SET VERSION funname <- match.call()[[1]] build <- "Jacob" - # FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } +# FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING @@ -129,13 +139,13 @@ gl.recode.pop <- function(x, pop.recode, recalc=TRUE, mono.rm=TRUE, verbose=NULL if (!recalc) {cat("Note: Locus metrics not recalculated\n")} if (!mono.rm) {cat("Note: Resultant monomorphic loci not deleted\n")} } - + +# ADD TO HISTORY + nh <- length(x@other$history) + x@other$history[[nh + 1]] <- match.call() + # FLAG SCRIPT END - #add to history - nh <- length(x@other$history) - x@other$history[[nh + 1]] <- match.call() - if (verbose > 0) { cat("Completed:",funname,"\n") } diff --git a/R/gl.report.taglength.r b/R/gl.report.taglength.r index 2299df0c..386aa9a6 100644 --- a/R/gl.report.taglength.r +++ b/R/gl.report.taglength.r @@ -49,7 +49,7 @@ gl.report.taglength <- function(x, boxplot="adjusted", range=1.5, verbose=NULL) if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } @@ -172,7 +172,6 @@ gl.report.taglength <- function(x, boxplot="adjusted", range=1.5, verbose=NULL) cat("Completed:",funname,"\n") } - if (length(whisker$out)==0){ return(NULL) } else { diff --git a/R/gl.set.verbosity.r b/R/gl.set.verbosity.r index 77f3b67b..6e234b99 100644 --- a/R/gl.set.verbosity.r +++ b/R/gl.set.verbosity.r @@ -12,9 +12,9 @@ #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) #' @examples -#' gl <- gl.set.verbosity(testset.gl, set.verbosity=2) +#' gl <- gl.set.verbosity(testset.gl, value=2) -gl.set.verbosity <- function(x, set.verbosity=2, verbose=NULL) { +gl.set.verbosity <- function(x, value=2, verbose=NULL) { # TRAP COMMAND, SET VERSION diff --git a/R/gl.subsample.loci.r b/R/gl.subsample.loci.r index fc55e1db..9eb100d1 100644 --- a/R/gl.subsample.loci.r +++ b/R/gl.subsample.loci.r @@ -16,26 +16,35 @@ gl.subsample.loci <- function(x, n, method="random", verbose=NULL) { -# TIDY UP FILE SPECS + # TRAP COMMAND, SET VERSION - build <- "Jacob" funname <- match.call()[[1]] + build <- "Jacob" hold <- x - # Note does not draw upon or modifies the loc.metrics.flags. -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - + # SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } + # FLAG SCRIPT START + if (verbose >= 1){ - cat("Starting",funname,"\n") + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING @@ -98,14 +107,3 @@ gl.subsample.loci <- function(x, n, method="random", verbose=NULL) { return(x.new) } - -# test <- gl.subsample.loci(gl, 6, method="pic") -# as.matrix(test)[1:20,] -# as.matrix(x)[1:20,1:6] -# as.matrix(test)[1:20,1:6] -# -# test <- gl.subsample.loci(gs, 6, method="pic") -# as.matrix(test)[1:20,] -# as.matrix(x)[1:20,1:6] -# as.matrix(test)[1:20,1:6] - diff --git a/R/gl.tree.nj.r b/R/gl.tree.nj.r index 71898dc7..c8697859 100644 --- a/R/gl.tree.nj.r +++ b/R/gl.tree.nj.r @@ -15,48 +15,61 @@ #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) #' @examples -#' gl.tree.nj(testset.gl,type="fan") +#' # SNP data +#' gl.tree.nj(testset.gl,type="fan") +#' # Tag P/A data +#' gl.tree.nj(testset.gs,type="fan") -# Last amended 3-Aug-19 - -gl.tree.nj <- function(x, type="phylogram", outgroup=NULL, labelsize=0.7, treefile=NULL, verbose=NULL) { - -# TIDY UP FILE SPECS +gl.tree.nj <- function(x, + type="phylogram", + outgroup=NULL, + labelsize=0.7, + treefile=NULL, + verbose=NULL) { +# TRAP COMMAND, SET VERSION + funname <- match.call()[[1]] - -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - - + build <- "Jacob" + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } + if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } - - if (verbose > 0) { - cat("Starting",funname,"\n") + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } # STANDARD ERROR CHECKING - + if(class(x)!="genlight") { - cat(" Fatal Error: genlight object required!\n"); stop("Execution terminated\n") + stop("Fatal Error: genlight object required!\n") + } + + if (all(x@ploidy == 1)){ + if (verbose >= 2){cat(" Processing Presence/Absence (SilicoDArT) data\n")} + } else if (all(x@ploidy == 2)){ + if (verbose >= 2){cat(" Processing a SNP dataset\n")} + } else { + stop("Fatal Error: Ploidy must be universally 1 (fragment P/A data) or 2 (SNP data)") } - - - # Set a population if none is specified (such as if the genlight object has been generated manually) - if (is.null(pop(x)) | is.na(length(pop(x))) | length(pop(x)) <= 0) { - if (verbose >= 2){ cat(" Population assignments not detected, individuals assigned to a single population labelled 'pop1'\n")} - pop(x) <- array("pop1",dim = nInd(x)) - pop(x) <- as.factor(pop(x)) - } - - # Check for monomorphic loci - tmp <- gl.filter.monomorphs(x, verbose=0) - if ((nLoc(tmp) < nLoc(x)) & verbose >= 2) {cat(" Warning: genlight object contains monomorphic loci\n")} # DO THE JOB @@ -93,16 +106,16 @@ gl.tree.nj <- function(x, type="phylogram", outgroup=NULL, labelsize=0.7, treefi if(verbose>=2){cat(" Writing the tree topology to",treefile,"\n")} write.tree(tree,file=treefile) } - - # FLAG SCRIPT END + + # Reset the par options + par(op) + +# FLAG SCRIPT END if (verbose > 0) { cat("Completed:",funname,"\n") } - # Reset the par options - par(op) - return(tree) } diff --git a/R/gl.write.csv.r b/R/gl.write.csv.r index 37208cc6..2a53c680 100644 --- a/R/gl.write.csv.r +++ b/R/gl.write.csv.r @@ -10,54 +10,64 @@ #' @param x -- name of the genlight object containing the SNP data [required] #' @param outfile -- file name of the output file (including extension) [default outfile.csv] #' @param outpath -- path where to save the output file [default tempdir(), mandated by CRAN]. Use outpath=getwd() or outpath="." when calling this function to direct output files to your working directory. -#' @param verbose -- specify the level of verbosity: 0, silent, fatal errors only; 1, flag function begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2] +#' @param verbose -- verbosity: 0, silent or fatal errors; 1, begin and end; 2, progress log ; 3, progress and results summary; 5, full report [default 2 or as specified using gl.set.verbosity] #' @return saves a glenlight object to csv, returns NULL #' @export #' @author Arthur Georges (Post to \url{https://groups.google.com/d/forum/dartr}) #' @examples -#' gl.write.csv(testset.gl, outfile="SNP_1row.csv") +#' # SNP data +#' gl.write.csv(testset.gl, outfile="SNP_1row.csv") +#' # Tag P/A data +#' gl.write.csv(testset.gs, outfile="PA_1row.csv") gl.write.csv <- function(x, outfile="outfile.csv", outpath=tempdir(), verbose=NULL) { -# TIDY UP FILE SPECS - - outfilespec <- file.path(outpath, outfile) +# TRAP COMMAND, SET VERSION + funname <- match.call()[[1]] - -# FLAG SCRIPT START - # set verbosity - if (is.null(verbose) & !is.null(x@other$verbose)) verbose=x@other$verbose - if (is.null(verbose)) verbose=2 - - + build <- "Jacob" + outfilespec <- file.path(outpath, outfile) + +# SET VERBOSITY + + if (is.null(verbose)){ + if(!is.null(x@other$verbose)){ + verbose <- x@other$verbose + } else { + verbose <- 2 + } + } + if (verbose < 0 | verbose > 5){ - cat(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n") + cat(paste(" Warning: Parameter 'verbose' must be an integer between 0 [silent] and 5 [full report], set to 2\n")) verbose <- 2 } - - if (verbose > 0) { - cat("Starting",funname,"\n") + +# FLAG SCRIPT START + + if (verbose >= 1){ + if(verbose==5){ + cat("Starting",funname,"[ Build =",build,"]\n") + } else { + cat("Starting",funname,"\n") + } } -# STANDARD ERROR CHECKING + # STANDARD ERROR CHECKING if(class(x)!="genlight") { - cat(" Fatal Error: genlight object required!\n"); stop("Execution terminated\n") + stop("Fatal Error: genlight object required!\n") + } + + if (all(x@ploidy == 1)){ + if (verbose >= 2){cat(" Processing Presence/Absence (SilicoDArT) data\n")} + data.type <- "SilicoDArT" + } else if (all(x@ploidy == 2)){ + if (verbose >= 2){cat(" Processing a SNP dataset\n")} + data.type <- "SNP" + } else { + stop("Fatal Error: Ploidy must be universally 1 (fragment P/A data) or 2 (SNP data)") } - - # Work around a bug in adegenet if genlight object is created by subsetting - if (nLoc(x)!=nrow(x@other$loc.metrics)) { stop("The number of rows in the loc.metrics table does not match the number of loci in your genlight object!") } - - # Set a population if none is specified (such as if the genlight object has been generated manually) - if (is.null(pop(x)) | is.na(length(pop(x))) | length(pop(x)) <= 0) { - if (verbose >= 2){ cat(" Population assignments not detected, individuals assigned to a single population labelled 'pop1'\n")} - pop(x) <- array("pop1",dim = nInd(x)) - pop(x) <- as.factor(pop(x)) - } - - # Check for monomorphic loci - tmp <- gl.filter.monomorphs(x, verbose=0) - if ((nLoc(tmp) < nLoc(x)) & verbose >= 2) {cat(" Warning: genlight object contains monomorphic loci\n")} # DO THE JOB diff --git a/R/utils.dart2genlight.r b/R/utils.dart2genlight.r index e828a32c..187eb528 100644 --- a/R/utils.dart2genlight.r +++ b/R/utils.dart2genlight.r @@ -36,7 +36,7 @@ utils.dart2genlight <- function(dart, ind.metafile=NULL, covfilename=NULL, proba if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.dist.binary.r b/R/utils.dist.binary.r index 8299a294..57e8c20b 100644 --- a/R/utils.dist.binary.r +++ b/R/utils.dist.binary.r @@ -47,7 +47,7 @@ utils.dist.binary <- function(x, method="simple", verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.hwe.r b/R/utils.hwe.r index 027c9627..69811e33 100644 --- a/R/utils.hwe.r +++ b/R/utils.hwe.r @@ -39,7 +39,7 @@ utils.hwe <- function (x, prob=0.05, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.pa.ind.r b/R/utils.pa.ind.r index 9544476e..a2ff9362 100644 --- a/R/utils.pa.ind.r +++ b/R/utils.pa.ind.r @@ -44,7 +44,7 @@ utils.pa.ind <- function (x, unknown, nmin=10, threshold=0, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.read.dart.r b/R/utils.read.dart.r index 2dc6c230..67466c3e 100644 --- a/R/utils.read.dart.r +++ b/R/utils.read.dart.r @@ -34,7 +34,7 @@ utils.read.dart <- function(filename, nas = "-", topskip=NULL, lastmetric ="Rep if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.avgpic.r b/R/utils.recalc.avgpic.r index 1531367e..283e0d35 100644 --- a/R/utils.recalc.avgpic.r +++ b/R/utils.recalc.avgpic.r @@ -47,7 +47,7 @@ utils.recalc.avgpic <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.callrate.r b/R/utils.recalc.callrate.r index 84e4594d..8de8130b 100644 --- a/R/utils.recalc.callrate.r +++ b/R/utils.recalc.callrate.r @@ -43,7 +43,7 @@ utils.recalc.callrate <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.freqhets.r b/R/utils.recalc.freqhets.r index ba410cdb..0736a326 100644 --- a/R/utils.recalc.freqhets.r +++ b/R/utils.recalc.freqhets.r @@ -43,7 +43,7 @@ utils.recalc.freqhets <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.freqhomref.r b/R/utils.recalc.freqhomref.r index af2ea4bd..af757f25 100644 --- a/R/utils.recalc.freqhomref.r +++ b/R/utils.recalc.freqhomref.r @@ -43,7 +43,7 @@ utils.recalc.freqhomref <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.freqhomsnp.r b/R/utils.recalc.freqhomsnp.r index 3898fe38..8b8368e4 100644 --- a/R/utils.recalc.freqhomsnp.r +++ b/R/utils.recalc.freqhomsnp.r @@ -43,7 +43,7 @@ utils.recalc.freqhomsnp <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.recalc.maf.r b/R/utils.recalc.maf.r index bd2dd3ba..d54f1602 100644 --- a/R/utils.recalc.maf.r +++ b/R/utils.recalc.maf.r @@ -43,7 +43,7 @@ utils.recalc.maf <- function(x, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") } diff --git a/R/utils.reset.flags.r b/R/utils.reset.flags.r index 6af54f36..754309db 100644 --- a/R/utils.reset.flags.r +++ b/R/utils.reset.flags.r @@ -22,7 +22,7 @@ #' @examples #' #result <- utils.reset.flags(testset.gl) -utils.reset.flags <- function(x, set=FALSE, set.verbosity=2, verbose=NULL) { +utils.reset.flags <- function(x, set=FALSE, value=2, verbose=NULL) { # TRAP COMMAND, SET VERSION @@ -48,7 +48,7 @@ utils.reset.flags <- function(x, set=FALSE, set.verbosity=2, verbose=NULL) { if (verbose >= 1){ if(verbose==5){ - cat("Starting",funname,"[Build =",build,"\n") + cat("Starting",funname,"[ Build =",build,"]\n") } else { cat("Starting",funname,"\n") }