#' @name gl.recode.ind
#' @title Recodes individual (=specimen = sample) labels in a genlight object
#' @description
#' This script recodes individual labels and/or deletes individuals from a DaRT
#' genlight SNP file based on a lookup table provided as a csv file.
#' @details
#' Renaming individuals may be required when there have been errors in labelling
#' arising in the process from sample to DArT files. There may be occasions
#' where renaming individuals is required for preparation of figures. When
#' caution needs to be exercised because of the potential for breaking the
#' 'chain of evidence' associated with the samples, recoding individuals using
#' a recode table (csv) can provide a clear record of the changes.
#'
#' The script, having deleted individuals, optionally identifies resultant
#' monomorphic loci or loci with all values missing and deletes them
#' (using gl.filter.monomorphs.r). The script also optionally recalculates
#' statistics made incorrect by the deletion of individuals from the dataset.
#'
#' The script returns a genlight object with the new individual labels, the
#' monomorphic loci optionally removed and the optionally recalculated locus
#' metadata.
#'
#' @param x Name of the genlight object containing SNP genotypes [required].
#' @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 or as specified using gl.set.verbosity].
#' @return A genlight or genind object with the recoded and reduced data.
#' @export
#' @author Custodian: Arthur Georges -- Post to \url{https://groups.google.com/d/forum/dartr}
#' @examples
#' file <- system.file('extdata','testset_ind_recode.csv', package='dartR')
#' gl <- gl.recode.ind(testset.gl, ind.recode=file, verbose=3)
#' @seealso \code{\link{gl.filter.monomorphs}} for filtering monomorphs,
#' \code{\link{gl.recalc.metrics}} for recalculating locus metrics,
#' \code{\link{gl.recode.pop}} for recoding populations
gl.recode.ind <- function(x,
ind.recode,
recalc = FALSE,
mono.rm = FALSE,
verbose = NULL) {
# SET VERBOSITY
verbose <- gl.check.verbosity(verbose)
# FLAG SCRIPT START
funname <- match.call()[[1]]
utils.flag.start(func = funname,
build = "Jody",
verbosity = verbose)
# CHECK DATATYPE
datatype <- utils.check.datatype(x, verbose = verbose)
# SCRIPT SPECIFIC ERROR CHECKING change stringsAsFactors=FALSE due to the new default in r
recode.table <-
read.csv(ind.recode,
header = FALSE,
stringsAsFactors = FALSE)
v1 <- unique(indNames(x))
v2 <- unique(recode.table[, 1])
v1_v2 <- v1[!(v1 %in% v2)]
l1 <- length(v1)
l2 <- length(v2)
if (l1 != l2) {
stop(
error(
"Fatal Error: Individuals do not agree in number with those listed in the recode table\n"
)
)
}
if (!(length(v1_v2) == 0)) {
stop(
error(
"Fatal Error: Some individuals have no reassignment specified in the recode table:",
v1_v2,
"\n"
)
)
}
# DO THE JOB
if (verbose >= 2) {
cat(report(
" Relabelling individuals (=specimens) as per ",
ind.recode,
"\n"
))
cat(report(" Reading lookup table\n"))
}
# Store variables
hold.nLoc <- nLoc(x)
hold.nInd <- nInd(x)
hold.nPop <- nPop(x)
# Apply the recode to the individuals
if (verbose >= 2) {
cat(report(" Applying the recoding\n"))
}
ind.list <- as.character(indNames(x))
ntr <- length(recode.table[, 1])
for (i in 1:nInd(x)) {
for (j in 1:ntr) {
if (ind.list[i] == recode.table[j, 1]) {
ind.list[i] <- recode.table[j, 2]
}
}
}
indNames(x) <- ind.list
# If there are individuals to be deleted, then recalculate relevant locus metadata and remove monomorphic loci
if ("delete" %in% x$ind.names | "Delete" %in% x$ind.names) {
# Remove rows flagged for deletion
if (verbose >= 2) {
cat(report(
" Deleting individuals/samples flagged for deletion\n"
))
}
deletions <-
indNames(x)[tolower(recode.table[, 2]) == "delete"]
if (verbose == 3) {
cat(" Dropping\n",
paste(deletions, collapse = ", "),
"\n")
cat(" A total of",
length(deletions),
"individuals dropped\n")
}
x <-
gl.drop.ind(x,
ind.list = c("Delete", "delete"),
verbose = 0)
}
# Remove monomorphic loci
if (mono.rm) {
if (verbose >= 2) {
cat(report(" Deleting monomorphic loc\n"))
}
x <- gl.filter.monomorphs(x, verbose = 0)
}
# Check monomorphs have been removed
if (x@other$loc.metrics.flags$monomorphs == FALSE) {
if (verbose >= 2) {
cat(warn(
" Warning: Resultant dataset may contain monomorphic loci\n"
))
}
}
# Recalculate statistics
if (recalc) {
x <- gl.recalc.metrics(x, verbose = 0)
if (verbose >= 2) {
cat(report(" Recalculating locus metrics\n"))
}
} else {
if (verbose >= 2) {
cat(warn(" Locus metrics not recalculated\n"))
x <- utils.reset.flags(x, verbose = 0)
}
}
# REPORT A SUMMARY
if (verbose >= 2) {
cat(" Summary of recoded dataset\n")
cat(paste(" Original No. of loci:", hold.nLoc, "\n"))
cat(paste(" New No. of loci:", nLoc(x), "\n"))
cat(paste(" Original No. of individuals:", hold.nInd, "\n"))
cat(paste(" New No. of individuals:", nInd(x), "\n"))
cat(paste(" Original No. of populations:", hold.nPop, "\n"))
cat(paste(" New No. of populations:", nPop(x), "\n"))
if (!recalc) {
cat(report(" Note: Locus metrics not recalculated\n"))
}
if (!mono.rm) {
cat(report(" 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
if (verbose > 0) {
cat(report("Completed:", funname, "\n"))
}
return(x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.