Commit c5820221 authored by Eric Coissac's avatar Eric Coissac

Batch of corrections

parent e35c0374
......@@ -151,9 +151,13 @@ S3method(validate_object,robitaxid)
S3method(validate_object,robiuniqueid)
S3method(validate_robitaxonomy,robitaxonomy)
S3method(vec_cast.character,robicategory)
S3method(vec_cast.character,robilca)
S3method(vec_cast.character,robipath)
S3method(vec_cast.character,robitag)
S3method(vec_cast.character,robitag_forward)
S3method(vec_cast.character,robitag_reverse)
S3method(vec_cast.character,robitaxid)
S3method(vec_cast.character,robitaxid_master)
S3method(vec_cast.character,robiuniqueid)
S3method(vec_cast.double,robicategory)
S3method(vec_cast.double,robilca)
......@@ -170,11 +174,13 @@ S3method(vec_cast.robicategory,character)
S3method(vec_cast.robicategory,default)
S3method(vec_cast.robicategory,factor)
S3method(vec_cast.robicategory,robicategory)
S3method(vec_cast.robilca,character)
S3method(vec_cast.robilca,default)
S3method(vec_cast.robilca,double)
S3method(vec_cast.robilca,integer)
S3method(vec_cast.robilca,robilca)
S3method(vec_cast.robilca,robitaxid)
S3method(vec_cast.robipath,character)
S3method(vec_cast.robipath,default)
S3method(vec_cast.robipath,double)
S3method(vec_cast.robipath,integer)
......@@ -193,6 +199,7 @@ S3method(vec_cast.robitag_reverse,character)
S3method(vec_cast.robitag_reverse,default)
S3method(vec_cast.robitag_reverse,robitag)
S3method(vec_cast.robitag_reverse,robitag_reverse)
S3method(vec_cast.robitaxid,character)
S3method(vec_cast.robitaxid,default)
S3method(vec_cast.robitaxid,double)
S3method(vec_cast.robitaxid,integer)
......@@ -200,6 +207,7 @@ S3method(vec_cast.robitaxid,robilca)
S3method(vec_cast.robitaxid,robipath)
S3method(vec_cast.robitaxid,robitaxid)
S3method(vec_cast.robitaxid,robitaxid_master)
S3method(vec_cast.robitaxid_master,character)
S3method(vec_cast.robitaxid_master,default)
S3method(vec_cast.robitaxid_master,double)
S3method(vec_cast.robitaxid_master,integer)
......
......@@ -45,7 +45,7 @@ plot_read_x_hill <- function(metabar, q = 0,
filter(read_count__ > 0 & hill__ > 0) %>%
ggplot(aes(x = read_count__,
y = hill__,
col=get(cats))) +
col = get(cats))) +
gp +
scale_x_log10() +
scale_y_log10() +
......@@ -102,7 +102,7 @@ plot_read_x_pcr_tags <- function(metabar,
selector = c(id = "id",
forward_tag = forward_tags_colname(metabar),
reverse_tag = reverse_tags_colname(metabar),
read_count = "read_count",
read_count__ = "read_count__",
category = categories_colname(metabar))
if (!missing(library_colname))
......@@ -110,7 +110,7 @@ plot_read_x_pcr_tags <- function(metabar,
data %>%
group_by(sample) %>% rename(id=sample) %>%
summarise(read_count=sum(count)) %>%
summarise(read_count__=sum(count)) %>%
left_join(samples(metabar), by = bys) %>%
select(selector) -> data
......@@ -128,7 +128,7 @@ plot_read_x_pcr_tags <- function(metabar,
ggplot(data,aes(x = forward_factor(forward_tag),
y = reverse_factor(reverse_tag),
col = category,
cex = sqrt(read_count))) + gp -> gg
cex = sqrt(read_count__))) + gp -> gg
if (!missing(library_colname)) {
if (missing(ncol_library))
......
#' @include robimetabar.R
NULL
#' Title
#'
#' @param data
......
#' @include read_obifasta.R
#' @include robimetabar.R
NULL
#' Title
......
......@@ -170,6 +170,16 @@ vec_cast.robitaxid.double <- function(x, to, ...)
vec_cast.double.robitaxid <- function(x, to, ...)
vec_cast(vec_data(x),double())
#' @method vec_cast.robitaxid character
#' @export
vec_cast.robitaxid.character <- function(x, to, ...)
new_robitaxid(vec_cast(x,integer()))
#' @method vec_cast.character robitaxid
#' @export
vec_cast.character.robitaxid <- function(x, to, ...)
vec_cast(vec_data(x),character())
......@@ -349,6 +359,15 @@ vec_cast.robitaxid_master.double <- function(x, to, ...)
vec_cast.double.robitaxid_master <- function(x, to, ...)
vec_cast(vec_data(x),double())
#' @method vec_cast.robitaxid_master character
#' @export
vec_cast.robitaxid_master.character <- function(x, to, ...)
new_robitaxid_master(vec_cast(x,integer()))
#' @method vec_cast.character robitaxid_master
#' @export
vec_cast.character.robitaxid_master <- function(x, to, ...)
vec_cast(vec_data(x),character())
#' @export
......@@ -436,7 +455,6 @@ vec_ptype2.robipath.double <- function(x, y, ...) double()
vec_ptype2.double.robipath <- function(x, y, ...) double()
#' @export
vec_cast.robipath <- function(x, to, ...)
UseMethod("vec_cast.robipath")
......@@ -479,6 +497,16 @@ vec_cast.robipath.double <- function(x, to, ...)
vec_cast.double.robipath <- function(x, to, ...)
vec_cast(vec_data(x),double())
#' @method vec_cast.robipath character
#' @export
vec_cast.robipath.character <- function(x, to, ...)
new_robipath(vec_cast(x,integer()))
#' @method vec_cast.character robipath
#' @export
vec_cast.character.robipath <- function(x, to, ...)
vec_cast(vec_data(x),character())
#' @export
......@@ -619,6 +647,16 @@ vec_cast.robilca.double <- function(x, to, ...)
vec_cast.double.robilca <- function(x, to, ...)
vec_cast(vec_data(x),double())
#' @method vec_cast.robilca character
#' @export
vec_cast.robilca.character <- function(x, to, ...)
new_robilca(vec_cast(x,integer()))
#' @method vec_cast.character robilca
#' @export
vec_cast.character.robilca <- function(x, to, ...)
vec_cast(vec_data(x),character())
#' @export
......
#' @importFrom rlang are_na
NULL
#' Title
#'
#' @param data
#'
#' @return
#' @export
#'
#' @examples
tagjump <- function(data, verbose = is_robi_verbose()) {
UseMethod("tagjump",data)
}
#' @rdname seek_contaminents
#' @export
tagjump.robimetabar <- function(data, verbose = is_robi_verbose()) {
data$data %>%
left_join(samples(data),
by = c(sample="id")) %>%
filter_at(categories_colname(data),
any_vars( . == "sequencing_blk")) %>%
group_by(motu) %>%
summarise(tagjump_max = max(count)) -> tj
min_jmp = ceiling(mean(tj$tagjump_max))
bys = "motu"
names(bys) <- motus_ids_colname(data)
motus(data) %>%
select(motus_ids_colname(data)) %>%
left_join(tj, by = bys) %>%
mutate(tagjump_threshold = ifelse(are_na(tagjump_max) | tagjump_max < min_jmp,
min_jmp,
tagjump_max))
}
#' Title
#'
#' @param data
#'
#' @return
#' @export
#'
#' @examples
clean_tagjump <- function(data, verbose = is_robi_verbose()) {
UseMethod("clean_tagjump",data)
}
#' @rdname seek_contaminents
#' @export
clean_tagjump.robimetabar <- function(data, verbose = is_robi_verbose()) {
clean <- tagjump(data)
data$data %>%
left_join(clean,
by = c("motu" = motus_ids_colname(data))) %>%
mutate(tagjump_orig = count, count = ifelse(count < tagjump_threshold,
0,
count - tagjump_threshold) ) %>%
ungroup() %>%
filter(count > 0)
}
#' @export
hist_tag_jumps <- function(metabar,
maximum = FALSE,
mapping = NULL,
data = NULL, stat = "identity",
position = "identity", ...,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
fcall <- match.call()
fcall$metabar = NULL
fcall$maximum = NULL
fcall[[1]] <- quote(geom_histogram)
gh <- eval(fcall)
metabar$data %>%
left_join(samples(metabar),
by = c(sample="id")) %>%
filter(category == "sequencing_blk") -> data
if (maximum)
data %>%
group_by(motu) %>%
summarise(count = max(count)) -> data
data %>% ggplot(aes(x=count)) + gh -> gg
if(maximum)
gg +
xlab("Maximum read count") +
ylab("MOTUs")
else
gg +
xlab("Read count") +
ylab("MOTU occurrences")
}
......@@ -506,17 +506,19 @@ taxon_at_rank.robitaxid = function(data,taxonomy,rank,with_name=FALSE, results_i
tibble(taxid = as_robitaxid_master(data)) %>%
left_join(nodes(taxonomy) %>%
select(taxid,path,rpath),
select(taxid,trank=rank,path,rpath),
by = "taxid") -> results
results[[results_in]] <- vapply(seq_along(results$taxid),
function(i) { p <- results$path[[i]]
if (results$trank[[i]] == rank)
return(results$taxid[[i]])
if (length(p > 0))
p[match(rankid,
results$rpath[[i]],
NA)][1]
else NA
},0)
},0) %>% as_robitaxid()
if (with_name)
suppressWarnings(
......@@ -528,7 +530,7 @@ taxon_at_rank.robitaxid = function(data,taxonomy,rank,with_name=FALSE, results_i
results_in = paste0(results_in,"_name")),
by = bys)) -> results
results %>% select(-path,-rpath)
results %>% select(-path,-rpath,-trank)
}
#' @rdname taxon_at_rank
......@@ -544,6 +546,7 @@ taxon_at_rank.numeric <- function(data,taxonomy,rank,with_name=FALSE, results_in
#' @rdname taxonomic_parent
#' @export
taxon_at_rank.tbl <- function(data, taxonomy, rank, with_name=FALSE, results_in, slot) {
reference <- reference_taxonomy(taxonomy)
ranks <- levels(nodes(reference)$rank)
rankid <- match(rank,ranks,nomatch = 0)
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tagjump.R
\name{clean_tagjump}
\alias{clean_tagjump}
\title{Title}
\usage{
clean_tagjump(data, verbose = is_robi_verbose())
}
\arguments{
\item{data}{}
}
\value{
}
\description{
Title
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/metabar_data_class.R, R/robimetabar.R
\name{motus_ids_colname}
\alias{motus_ids_colname}
\alias{motus_ids}
% Please edit documentation in R/robimetabar.R, R/metabar_data_class.R
\name{motus_ids_colname.robimetabar}
\alias{motus_ids_colname.robimetabar}
\alias{motus_ids.robimetabar}
\alias{motus_ids_colname}
\alias{motus_ids}
\title{Returns motu ids column name}
\usage{
motus_ids_colname(data)
motus_ids(data)
\method{motus_ids_colname}{robimetabar}(object)
\method{motus_ids}{robimetabar}(object)
motus_ids_colname(data)
motus_ids(data)
}
\arguments{
\item{data}{a metabar object}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/metabar_data_class.R, R/robimetabar.R
\name{nmotus}
\alias{nmotus}
% Please edit documentation in R/robimetabar.R, R/metabar_data_class.R
\name{nmotus.robimetabar}
\alias{nmotus.robimetabar}
\alias{nmotus}
\title{Returns number of MOTUs}
\usage{
nmotus(data)
\method{nmotus}{robimetabar}(data)
nmotus(data)
}
\arguments{
\item{data}{a metabar object}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/metabar_data_class.R, R/robimetabar.R
\name{nsamples}
\alias{nsamples}
% Please edit documentation in R/robimetabar.R, R/metabar_data_class.R
\name{nsamples.robimetabar}
\alias{nsamples.robimetabar}
\alias{nsamples}
\title{Returns number of samples}
\usage{
nsamples(data)
\method{nsamples}{robimetabar}(data)
nsamples(data)
}
\arguments{
\item{data}{a metabar object}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/metabar_data_class.R, R/robimetabar.R
\name{samples_ids_colname}
\alias{samples_ids_colname}
\alias{samples_ids}
% Please edit documentation in R/robimetabar.R, R/metabar_data_class.R
\name{samples_ids_colname.robimetabar}
\alias{samples_ids_colname.robimetabar}
\alias{samples_ids.robimetabar}
\alias{samples_ids_colname}
\alias{samples_ids}
\title{Returns sample ids column name}
\usage{
samples_ids_colname(data)
samples_ids(data)
\method{samples_ids_colname}{robimetabar}(object)
\method{samples_ids}{robimetabar}(object)
samples_ids_colname(data)
samples_ids(data)
}
\arguments{
\item{data}{a metabar object}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/contaminent.R
% Please edit documentation in R/contaminent.R, R/tagjump.R
\name{seek_contaminents}
\alias{seek_contaminents}
\alias{seek_contaminents.robimetabar}
\alias{tagjump.robimetabar}
\alias{clean_tagjump.robimetabar}
\title{Title}
\usage{
seek_contaminents(data)
\method{seek_contaminents}{robimetabar}(data)
\method{tagjump}{robimetabar}(data, verbose = is_robi_verbose())
\method{clean_tagjump}{robimetabar}(data, verbose = is_robi_verbose())
}
\arguments{
\item{data}{}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/tagjump.R
\name{tagjump}
\alias{tagjump}
\title{Title}
\usage{
tagjump(data, verbose = is_robi_verbose())
}
\arguments{
\item{data}{}
}
\value{
}
\description{
Title
}
......@@ -63,6 +63,12 @@ The \codse{\link[ROBITools2]{robidata}} version
The \code{\link{robiatomic}} version of that method
ckecks that the instance is an \code{\link[rlang:is_atomic]{atomic}} object.
The \code{\link{robitag}} version of that method ckecks that :
\itemize{
\item All the tags have the same length
\item Every tags are composed only of upper case A, C, G, or T
}
The \codse{\link[ROBITools2]{robiuniqueid}} version
ckecks that the instance contains no dupplicated identifers.
......@@ -91,6 +97,10 @@ xd <- new_robiatomic(1:10,class="robifoo")
validate_object(xd)
rt <- new_robitag(c("AGT","GGT","CGT","GTA","CCC"))
validate_object(rt)
# For robimotu instance
s <- robimotu(n=20)
validate_object(s)
......
......@@ -419,7 +419,7 @@ SEXP R_trim_and_unquote_strings(SEXP string) {
if (*csource == '"' || *csource == '\'') {
while(*last == ' ' && last > csource) last --;
while(*last == ' ' && last > csource) last --;
if (*csource == *last) {
csource++;
......
......@@ -36,10 +36,12 @@ static int32_t is_big_endian()
return (int32_t)((char*)&i)[0];
}
/*
static int32_t swap_int32_t(int32_t i)
{
return SWAPINT32(i);
}
*/
SEXP R_raw_to_ecopcr_record(SEXP raw)
{
......@@ -106,8 +108,6 @@ SEXP R_raw_to_ecopcr_tnames(SEXP raw)
const void* pointer;
econameformat_p rpointer;
void* precord;
SEXP name_table;
SEXP names;
SEXP classes;
......@@ -202,8 +202,6 @@ SEXP R_raw_to_ecopcr_tnodes(SEXP raw)
const void* pointer;
ecotxformat_p rpointer;
void* precord;
SEXP taxon_table;
SEXP taxids;
SEXP parents;
......@@ -227,7 +225,7 @@ SEXP R_raw_to_ecopcr_tnodes(SEXP raw)
parents = PROTECT(NEW_INTEGER(size));
ranks = PROTECT(NEW_INTEGER(size));
pointer = rawdata + sizeof(int32_t);
pointer = (char*)rawdata + sizeof(int32_t);
for (i=0; i < size; i++) {
rsize = *((const int32_t*) pointer);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment