Commit 4c7f7326 authored by Eric Coissac's avatar Eric Coissac

A first trial for taxonomy

parent eee6ad26
......@@ -2,3 +2,8 @@
.Rhistory
.RData
.Ruserdata
B1000.fasta
B100000.fasta
B3500.fasta
B5.fasta
Bison-gh.uniq.fasta
......@@ -9,18 +9,44 @@ Description: More about what it does (maybe more than one line)
License: What license is it under?
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.0.1
Imports: tidyverse
RoxygenNote: 7.1.0
VignetteBuilder: knitr
Imports: R6,
tidyverse,
Rdpack
RdMacros: Rdpack
Suggests: vegan,
roxygen2,
knitr,
rmarkdown
Collate:
'ROBITools2.R'
'color.R'
'utils.R'
'robiobject.R'
'dplyr.R'
'entropie.R'
'robiseq.R'
'fasta.R'
'robicategory.R'
'robiuniqueid.R'
'robisample.R'
'ids.R'
'lowest_common_ancestor.R'
'metabar_data_class.R'
'oligotag.R'
'randseq.R'
'rdna.R'
'read_obitab.R'
'robidata.R'
'robimetabar.R'
'taxonomy.R'
'robimetabar_xlsx.R'
'robiseq_db.R'
'robitag.R'
'robitaxid.R'
'tags_categories.R'
'taxonomy_methods.R'
'taxonomy_robi.R'
'taxonomy_ncbi.R'
'taxonomy_obitools.R'
'vegan.R'
# Generated by roxygen2: do not edit by hand
S3method("$",robimetabar)
S3method("$",robiseq)
S3method("$<-",robimetabar)
S3method("[",robiobject)
S3method("$<-",robisample)
S3method("[",robicategory)
S3method("[",robiseq)
S3method("[",robiseq_db)
S3method("[",robitag)
S3method("[",robitag_forward)
S3method("[",robitag_reverse)
S3method("[",robitaxid)
S3method("[",robitaxid_master)
S3method("[",robiuniqueid)
S3method("[<-",robicategory)
S3method("[<-",robitag)
S3method("[<-",robitag_forward)
S3method("[<-",robitag_reverse)
S3method("[<-",robitaxid)
S3method("[<-",robitaxid_master)
S3method("[<-",robiuniqueid)
S3method("[[",robimetabar)
S3method("[[",robiseq)
S3method("[[<-",robimetabar)
S3method("[[<-",robisample)
S3method("motus<-",robimetabar)
S3method("samples<-",robimetabar)
S3method(as_tibble,robiobject)
S3method(alternative_names,robitaxonomy)
S3method(alternative_taxids,robitaxonomy)
S3method(as_robicategory,character)
S3method(as_robicategory,default)
S3method(as_robicategory,factor)
S3method(as_robicategory,robicategory)
S3method(as_robiobject,default)
S3method(as_robiobject,robiobject)
S3method(as_robisample,default)
S3method(as_robisample,robisample)
S3method(as_robitag,character)
S3method(as_robitag,default)
S3method(as_robitag,robitag)
S3method(as_robitag_forward,character)
S3method(as_robitag_forward,default)
S3method(as_robitag_forward,robitag)
S3method(as_robitag_reverse,character)
S3method(as_robitag_reverse,default)
S3method(as_robitag_reverse,robitag)
S3method(as_robitaxid,default)
S3method(as_robitaxid,robitaxid)
S3method(as_robitaxid,robitaxonomy)
S3method(as_robitaxid_master,default)
S3method(as_robitaxid_master,robitaxid)
S3method(as_robitaxid_master,robitaxonomy)
S3method(as_robitaxonomy,robilca)
S3method(as_robiuniqueid,character)
S3method(as_robiuniqueid,default)
S3method(as_robiuniqueid,robiuniqueid)
S3method(c,robicategory)
S3method(c,robitag)
S3method(c,robitag_forward)
S3method(c,robitag_reverse)
S3method(c,robitaxid)
S3method(c,robitaxid_master)
S3method(c,robiuniqueid)
S3method(decostand,"NULL")
S3method(decostand,default)
S3method(decostand,robimetabar)
S3method(dim,robimetabar)
S3method(dim,robitaxonomy)
S3method(dimnames,robidata)
S3method(dimnames,robimetabar)
S3method(filter,robiobject)
S3method(ecofind,robitaxonomy)
S3method(expand_names,robitaxonomy)
S3method(format,robicategory)
S3method(full_taxonomy,robitaxonomy)
S3method(ids,default)
S3method(ids,robisample)
S3method(ids_colname,robisample)
S3method(is_full_taxonomy,robitaxonomy)
S3method(lowest_common_ancestor,robitaxonomy)
S3method(max,robitaxonomy)
S3method(min,robitaxonomy)
S3method(motu_ids_name,robimetabar)
S3method(motus,robimetabar)
S3method(names,robimetabar)
S3method(names,robiseq)
S3method(nmotus,robimetabar)
S3method(nodes,robitaxonomy)
S3method(nsamples,robimetabar)
S3method(parent,robitaxonomy)
S3method(pillar_shaft,robicategory)
S3method(pillar_shaft,robitag)
S3method(pillar_shaft,robitaxid)
S3method(pillar_shaft,robiuniqueid)
S3method(print,robicategory)
S3method(reference_taxonomy,robilca)
S3method(reference_taxonomy,robitaxonomy)
S3method(rep,robicategory)
S3method(rep,robitag)
S3method(rep,robitag_forward)
S3method(rep,robitag_reverse)
S3method(rep,robitaxid)
S3method(rep,robitaxid_master)
S3method(sample_ids_name,robimetabar)
S3method(samples,robimetabar)
S3method(scientific_name,robitaxonomy)
S3method(sort,robipath)
S3method(tags_positive_ctrls,robimetabar)
S3method(type_sum,robicategory)
S3method(type_sum,robilca)
S3method(type_sum,robipath)
S3method(type_sum,robitag)
S3method(type_sum,robitag_forward)
S3method(type_sum,robitag_reverse)
S3method(type_sum,robitaxid)
S3method(type_sum,robitaxid_master)
S3method(type_sum,robiuniqueid)
S3method(validate_robisample,robisample)
S3method(validate_robitaxonomy,robitaxonomy)
S3method(write.xlsx,default)
S3method(write.xlsx,robimetabar)
export("levels <- .robicategory")
export("motus<-")
export("samples<-")
export(Fasta.reader)
export(build.robimetabar)
export(colors.tol)
export(D_q)
export(H_q)
export(alternative_names)
export(alternative_taxids)
export(as.robimetabar.robiseq_db)
export(as_robicategory)
export(as_robimetabar)
export(as_robiobject)
export(as_robisample)
export(as_robitag)
export(as_robitag_forward)
export(as_robitag_reverse)
export(as_robitaxid)
export(as_robitaxid_master)
export(as_robitaxonomy)
export(as_robiuniqueid)
export(build.robiseq)
export(build_sample_names)
export(clique_tag)
export(colors_tol)
export(combine_LETTERS)
export(d_exp_q)
export(d_log_q)
export(dd_exp_q)
export(decostand)
export(download_ncbi_taxdump)
export(ecofind)
export(every_oligo)
export(exp_q)
export(expand_names)
export(family)
export(feature_as_matrix)
export(filter_tag_gcmax)
export(filter_tag_homopolymere)
export(filter_tag_homopolymere_min)
export(full_taxonomy)
export(genus)
export(gradient.tol1)
export(gradient.tol2)
export(is.robiobject)
export(gradient_tol1)
export(gradient_tol2)
export(ids)
export(ids_colname)
export(int2nuc)
export(is.subcladeof)
export(is_full_taxonomy)
export(is_robi_verbose)
export(is_robicategory)
export(is_robidata)
export(is_robiobject)
export(is_robisample)
export(is_robitag)
export(is_robitaxid)
export(is_robitaxonomy)
export(is_robiuniqueid)
export(kingdom)
export(lowest.common.ancestor)
export(make.robiobject)
export(log_q)
export(lowest_common_ancestor)
export(motu_ids_name)
export(motus)
export(ntaxa)
export(new_robicategory)
export(new_robidata)
export(new_robilca)
export(new_robiobject)
export(new_robipath)
export(new_robisample)
export(new_robitag)
export(new_robitag_forward)
export(new_robitag_reverse)
export(new_robitaxid)
export(new_robitaxid_master)
export(new_robitaxonomy)
export(new_robiuniqueid)
export(nmotus)
export(nodes)
export(nsamples)
export(nuc2int)
export(parent)
export(rainbow.tol)
export(rainbow_tol)
export(rank.list)
export(read.fasta)
export(robiclass)
export(rbarcode)
export(read.sequence)
export(read_fasta)
export(read_ncbi_taxdump)
export(read_obitab)
export(read_obitools_taxonomy)
export(reference_taxonomy)
export(resets_category_tags)
export(rkmer)
export(rnuc)
export(robiassert)
export(robiassert_arg)
export(robicategory)
export(robilca)
export(robimetabar)
export(robipath)
export(robisample)
export(robitag)
export(robitag_forward)
export(robitag_reverse)
export(robitaxid)
export(robitaxid_master)
export(robiuniqueid)
export(rseq)
export(sample_ids_name)
export(samples)
export(scientificname)
export(scientific_name)
export(species)
export(superkingdom)
export(taxid.list)
export(taxid.max)
export(taxid.min)
export(tags_positive_ctrls)
export(taxid.validate)
export(taxon.at.rank)
export(taxon.path)
export(taxonomic.rank)
export(unmake.robiobject)
export(unclass_robiobject)
export(validate_robisample)
export(validate_robitaxonomy)
export(write.xlsx)
import(R6)
import(doParallel)
import(dplyr)
import(foreach)
import(readr)
import(stringr)
import(tibble)
import(utils)
import(vegan)
import(xlsx)
importFrom(Rdpack,reprompt)
importFrom(glue,glue)
importFrom(pillar,pillar_shaft)
importFrom(pillar,type_sum)
useDynLib(ROBITools2)
#' @title Analysing metabarcoding data.
#' @name ROBITools2
#' @description Provides tools to help in the analysing of DNA metabarcoding data.
#'
#' @details
#' The functions in the ProcMod package aims to estimate and to test correlation
#' between matrices, correcting for the spurious correlations because of the
#' over-fitting effect.
#'
#' over-fitting effect.
#'
#' The ProcMod package is developed on the metabarcoding.org gitlab
#' (https://git.metabarcoding.org/obitools/ROBITools2.git).
#' The gitlab of metabarcoding.org provides up-to-date information and
#' forums for bug reports.
#'
#' @author Eric Coissac
#'
#' @docType package
#' @importFrom Rdpack reprompt
NULL
.has_doParallel <- is.element("doParallel",installed.packages())
if (.has_doParallel) require(doParallel)
.onLoad <- function(libname, pkgname) {
if ( is.null(getOption("ROBITools2.verbose")) ||
!is.logical(getOption("ROBITools2.verbose"))
)
options(ROBITools2.verbose = TRUE)
invisible()
}
\ No newline at end of file
#' Qualitative color schemes by Paul Tol
#' Qualitative color schemes by Paul Tol.
#'
#' Provide a set of color palette covenient even for blind color people
#' Provides a set of color palettes covenient even for blind color people
#'
#' @param n the minimal number of color you are interested in
#' @param alpha the transparency value between $0$ full transparency
......@@ -8,15 +9,16 @@
#' @return a character vector containing hexadecimal color codes
#'
#' @examples
#' x = colors.tol(10,0.5)
#' x = colors_tol(10,0.5)
#' x
#' plot(1:10,1:10,col=x,cex=1:10,pch=16)
#'
#' @see <http://www.sron.nl/~pault/>
#' @seealso <http://www.sron.nl/~pault/>
#' @author Eric Coissac
#' @export
colors.tol = function(n,alpha=1) {
colors_tol = function(n,alpha=1) {
color.tol = list(
color_tol = list(
"1" = c("#4477AA"),
"2" = c("#4477AA", "#CC6677"),
......@@ -80,23 +82,24 @@ colors.tol = function(n,alpha=1) {
if (n > 21)
stop("Only color schemas with at maximum 21 colors are handled")
limits = as.integer(names(color.tol))
limits = as.integer(names(color_tol))
n.tol = as.character(limits[n <= limits][1])
tol = color.tol[[n.tol]]
n_tol = as.character(limits[n <= limits][1])
tol = color_tol[[n_tol]]
hex.alpha = toupper(as.hexmode(floor(alpha * 255)))
tol.alpha = paste(tol,hex.alpha,sep="")
hex_alpha = toupper(as.hexmode(floor(alpha * 255)))
tol_alpha = paste(tol,hex_alpha,sep="")
return(tol.alpha)
return(tol_alpha)
}
#' Colors for variations around 0 (blue-red)
#' @see <http://www.sron.nl/~pault/>
#'
#' @rdname colors_tol
#' @export
gradient.tol1 = function(x,alpha=1) {
gradient_tol1 = function(x,alpha=1) {
rcol = function(x) 0.237 - 2.13*x + 26.92*x**2 - 65.5*x**3 + 63.5*x**4 - 22.36*x**5
gcol = function(x) ((0.572 + 1.524*x - 1.811*x**2)/(1 - 0.291*x + 0.1574*x**2))**2
bcol = function(x) 1/(1.579 - 4.03*x + 12.92*x**2 - 31.4*x**3 + 48.6*x**4 - 23.36*x**5)
......@@ -105,27 +108,26 @@ gradient.tol1 = function(x,alpha=1) {
}
#' Gradient colors,
#' @see <http://www.sron.nl/~pault/>
#'
#' @rdname colors_tol
#' @export
gradient.tol2 = function(x,alpha=1) {
rcol = function(x) (1 - 0.392*(1 + erf((x - 0.869)/ 0.255)))
gcol = function(x) (1.021 - 0.456*(1 + erf((x - 0.527)/ 0.376)))
bcol = function(x) (1 - 0.493*(1 + erf((x - 0.272)/ 0.309)))
gradient_tol2 = function(x,alpha=1) {
rcol = function(x) (1 - 0.392*(1 + erf((x - 0.869) / 0.255)))
gcol = function(x) (1.021 - 0.456*(1 + erf((x - 0.527) / 0.376)))
bcol = function(x) (1 - 0.493*(1 + erf((x - 0.272) / 0.309)))
return(rgb(rcol(x),gcol(x),bcol(x),alpha))
}
#' Rainbow gradient colors,
#' @see <http://www.sron.nl/~pault/>
#'
#' @rdname colors_tol
#' @export
rainbow_tol = function(x,alpha=1) {
rcol = function(x) (0.472 - 0.567 * x + 4.05 * x ** 2) / (1. + 8.72 * x - 19.17 * x ** 2 + 14.1 * x ** 3)
gcol = function(x) 0.108932 - 1.22635 * x + 27.284 * x ** 2 - 98.577 * x ** 3 + 163.3 * x ** 4 - 131.395 * x ** 5 + 40.634 * x ** 6
bcol = function(x) 1./(1.97 + 3.54 * x - 68.5 * x ** 2 + 243 * x ** 3 - 297 * x ** 4 + 125 * x ** 5)
rainbow.tol = function(x,alpha=1) {
rcol = function(x) (0.472-0.567*x+4.05*x**2)/(1.+8.72*x-19.17*x**2+14.1*x**3)
gcol = function(x) 0.108932-1.22635*x+27.284*x**2-98.577*x**3+163.3*x**4-131.395*x**5+40.634*x**6
bcol = function(x) 1./(1.97+3.54*x-68.5*x**2+243*x**3-297*x**4+125*x**5)
return(rgb(rcol(x),gcol(x),bcol(x),alpha))
return(rgb(rcol(x), gcol(x), bcol(x), alpha))
}
......@@ -2,16 +2,3 @@
#' @include robiobject.R
NULL
#' @author Eric Coissac
#' @export
filter.robiobject = function(.data, ...) {
attrib=attributes(.data)
message("filter.robiobject : ",
deparse(attrib))
rep = NextMethod("filter")
return(.set_robiattribs(rep,
attrib = attrib,
set.class=TRUE))
}
\ No newline at end of file
#' @importFrom Rdpack reprompt
#'
NULL
#' Generalized logaritmic function.
#'
#' \deqn{x \longmapsto 1 : \log(x) \approx x-1}
#'
#' @param x A numerical vector of values, from which the logarithm must be extracted.
#' @param q The shape parameter of the generalized logarithm.
#'
#' @return a numeric vector of logarithm values
#'
#' @references
#' \insertRef{Tsallis:94:00}{ROBITools2}
#'
#'
#' @author Eric Coissac <eric.coissac@metabarcoding.org>
#' @export
log_q = function(x, q = 1) {
if (q == 1)
log(x)
else (x^(1 - q) - 1) / (1 - q)
}
#' Derivative of the generalized exponential function.
#'
#'
#' @references
#' \insertRef{Tsallis:94:00}{ROBITools2}
#'
#' @author Eric Coissac
#' @export
d_log_q = function(x, q = 1) {
x^(-q)
}
#' Generalized exponential function.
#'
#'
#' @references
#' \insertRef{Tsallis:94:00}{ROBITools2}
#'
#' @author Eric Coissac
#' @export
exp_q = function(x, q = 1) {
if (q == 1)
exp(x)
else
(1 + (1 - q) * x)^(1 / (1 - q))
}
#' @author Eric Coissac
#' @export
d_exp_q = function(x,q=1) {
exp_q(x, q)^q
}
#' @author Eric Coissac
#' @export
dd_exp_q = function(x, q = 1) {
exp_q(x, q)^(2 * q - 1)
}
#' @author Eric Coissac
#' @export
H_q = function(x, q = 1) {
sum(x * log_q( 1 / x, q))
}
#' @author Eric Coissac
#' @export
D_q = function(x, q = 1) {
exp_q(H_q(x, q), q)
}
#' @include utils.R
#' @include robiseq.R
#' @import stringr
#' @import readr
#' @import foreach
#' @import dplyr
#'
#' @author Eric Coissac
NULL
#' Iterate through a fasta file.
#'
#' `Fasta.reader` returns an iterator over a fasta file.
#' Each call of the returned iterator function return an
#' instance of \link[build.robiseq]{robiseq}
#'
#' @param con the connection object to read. It could consist in a
#' `charactere` value
#' @param keys the list of keys to extract from the header.
#' @param chunck.size how many lines from the fasta file must be read at once.
features_as_tibble <- function(features) {
all_names <- sort(unique(unlist(lapply(features, names))))
data <- do.call(rbind,lapply(features,
function(x) {
x <- x[all_names]
x[vapply(x, is.null, TRUE)] <- NA
names(x) <- all_names
x <- lapply(x, function(y) if (length(y)<=1) y else list(y))