Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
R
ROBITools2
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
OBITools
ROBITools2
Commits
81b263d0
Commit
81b263d0
authored
Sep 23, 2020
by
Eric Coissac
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Following of the development...
parent
67d40585
Changes
30
Hide whitespace changes
Inline
Side-by-side
Showing
30 changed files
with
701 additions
and
121 deletions
+701
-121
.Rbuildignore
.Rbuildignore
+0
-1
DESCRIPTION
DESCRIPTION
+4
-2
NAMESPACE
NAMESPACE
+23
-6
R/as_motu_matrix.R
R/as_motu_matrix.R
+8
-2
R/dplyr.R
R/dplyr.R
+11
-0
R/entropie.R
R/entropie.R
+1
-0
R/metabar_data_class.R
R/metabar_data_class.R
+11
-6
R/robicategory.R
R/robicategory.R
+20
-0
R/robimetabar.R
R/robimetabar.R
+3
-40
R/robimetabar_aggregate.R
R/robimetabar_aggregate.R
+114
-0
R/robimetabar_filter.R
R/robimetabar_filter.R
+182
-10
R/robimetabar_store.R
R/robimetabar_store.R
+58
-0
R/robimetabar_xlsx.R
R/robimetabar_xlsx.R
+50
-44
R/robisample.R
R/robisample.R
+5
-2
R/robitag.R
R/robitag.R
+1
-1
R/robitaxid.R
R/robitaxid.R
+1
-1
R/robiuniqueid.R
R/robiuniqueid.R
+1
-1
man/aggregate_robidata.Rd
man/aggregate_robidata.Rd
+17
-0
man/as_motus_matrix.Rd
man/as_motus_matrix.Rd
+2
-2
man/filter_motus_empty.Rd
man/filter_motus_empty.Rd
+17
-0
man/filter_sample_category.Rd
man/filter_sample_category.Rd
+22
-0
man/filter_sample_empty.Rd
man/filter_sample_empty.Rd
+17
-0
man/filter_sample_min_diversity.Rd
man/filter_sample_min_diversity.Rd
+38
-0
man/filter_sample_min_read.Rd
man/filter_sample_min_read.Rd
+17
-1
man/motus_average.Rd
man/motus_average.Rd
+17
-0
man/robimetabar.Rd
man/robimetabar.Rd
+1
-1
man/samples_average.Rd
man/samples_average.Rd
+17
-0
man/unique.robicategory.Rd
man/unique.robicategory.Rd
+17
-0
man/validate_object.Rd
man/validate_object.Rd
+1
-1
man/write_xlsx.robimetabar.Rd
man/write_xlsx.robimetabar.Rd
+25
-0
No files found.
.Rbuildignore
View file @
81b263d0
...
...
@@ -3,4 +3,3 @@
^external_data_pkg$
^LICENCE-CECILL-2.1.txt$
^data-raw$
^R/robimetabar_xlsx.R$
\ No newline at end of file
DESCRIPTION
View file @
81b263d0
...
...
@@ -9,7 +9,7 @@ Description: More about what it does (maybe more than one line)
License: CeCILL-2
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.1.
0
RoxygenNote: 7.1.
1
VignetteBuilder: knitr
Imports: R6,
vctrs (>= 0.3.0),
...
...
@@ -18,7 +18,7 @@ Imports: R6,
Rdpack,
rlang,
ggplot2,
xlsx
open
xlsx
RdMacros: Rdpack
Suggests: vegan,
roxygen2,
...
...
@@ -60,8 +60,10 @@ Collate:
'read_metabar.R'
'read_ngsfilter.R'
'read_obitab.R'
'robimetabar_aggregate.R'
'robimetabar_filter.R'
'robimetabar_stat.R'
'robimetabar_store.R'
'robimetabar_xlsx.R'
'robimutation.R'
'robiseq_db.R'
...
...
NAMESPACE
View file @
81b263d0
...
...
@@ -105,10 +105,12 @@ S3method(scientific_name,robimotu)
S3method(scientific_name,robitaxid)
S3method(scientific_name,tbl)
S3method(seek_contaminents,robimetabar)
S3method(set_motus,data.frame)
S3method(set_motus,robimotu)
S3method(set_samples,robisample)
S3method(sort,robipath)
S3method(store_into,robimotu)
S3method(store_into,robisample)
S3method(store_into_motus,data.frame)
S3method(store_into_motus,robimotu)
S3method(store_into_samples,robisample)
S3method(tagjump,robimetabar)
S3method(tags,default)
S3method(tags,robimetabar)
...
...
@@ -143,6 +145,7 @@ S3method(type_sum,robitag)
S3method(type_sum,robitag_forward)
S3method(type_sum,robitag_reverse)
S3method(type_sum,robiuniqueid)
S3method(unique,robicategory)
S3method(validate_object,default)
S3method(validate_object,robi4mer)
S3method(validate_object,robiatomic)
...
...
@@ -307,11 +310,14 @@ S3method(vec_ptype_abbr,robitaxid)
S3method(vec_ptype_abbr,robitaxid_master)
S3method(vec_ptype_abbr,robiuniqueid)
S3method(vec_ptype_full,robitaxid)
S3method(write_xlsx,default)
S3method(write_xlsx,robimetabar)
export("levels <- .robicategory")
export("motus<-")
export("samples<-")
export(D_q)
export(H_q)
export(aggregate_robidata)
export(alternative_names)
export(alternative_taxids)
export(as.robimetabar.robiseq_db)
...
...
@@ -359,6 +365,12 @@ export(expand_names)
export(family)
export(feature_as_matrix)
export(filter_motus)
export(filter_motus_empty)
export(filter_sample_category)
export(filter_sample_empty)
export(filter_sample_max_diversity)
export(filter_sample_max_read)
export(filter_sample_min_diversity)
export(filter_sample_min_read)
export(filter_tag_gcmax)
export(filter_tag_homopolymere)
...
...
@@ -403,6 +415,7 @@ export(lowest_common_ancestor)
export(master_taxids)
export(master_taxids_colname)
export(motus)
export(motus_average)
export(motus_ids)
export(motus_ids_colname)
export(motus_ranks)
...
...
@@ -480,6 +493,7 @@ export(robitaxid_master)
export(robiuniqueid)
export(rseq)
export(samples)
export(samples_average)
export(samples_entropy)
export(samples_hill)
export(samples_ids)
...
...
@@ -491,11 +505,12 @@ export(samples_read_count)
export(scientific_name)
export(seek_contaminents)
export(set_default_taxonomy)
export(set_motus)
export(set_sample.data.frame)
export(set_samples)
export(species)
export(spread_names.robitaxonomy)
export(store_into)
export(store_into_motus)
export(store_into_sample.data.frame)
export(store_into_samples)
export(substitution)
export(superkingdom)
export(tagjump)
...
...
@@ -533,10 +548,12 @@ export(vec_ptype2.robitaxid)
export(vec_ptype2.robitaxid_master)
export(vec_ptype2.robiuniqueid)
export(write_robitaxonomy)
export(write_xlsx)
import(R6)
import(doParallel)
import(dplyr)
import(foreach)
import(openxlsx)
import(purrr)
import(readr)
import(rlang)
...
...
R/as_motu_matrix.R
View file @
81b263d0
...
...
@@ -8,12 +8,15 @@ NULL
#'
#' @param metabar
#' @param value
#' @param values_fill
#' @param transpose
#'
#' @return
#' @export
#'
#' @examples
as_motus_matrix
<-
function
(
metabar
,
value
=
"count"
,
values_fill
=
0
)
{
as_motus_matrix
<-
function
(
metabar
,
value
=
"count"
,
values_fill
=
0
,
transpose
=
FALSE
)
{
metabar
$
data
%>%
select
(
sample
,
motu
,
data
=
!!
value
)
%>%
dt_pivot_wider
(
names_from
=
motu
,
values_from
=
data
)
->
mat
...
...
@@ -24,7 +27,10 @@ as_motus_matrix <- function(metabar,value = "count", values_fill = 0) {
rownames
(
mat
)
<-
row_names
mat
[
is.na
(
mat
)]
<-
values_fill
mat
if
(
transpose
)
t
(
mat
)
else
mat
}
#' Title
...
...
R/dplyr.R
View file @
81b263d0
...
...
@@ -2,3 +2,14 @@
#' @include robiobject.R
NULL
group.robisample
<-
function
(
x
,
y
,
by
=
NULL
,
copy
=
FALSE
,
suffix
=
c
(
".x"
,
".y"
),
...
,
keep
=
FALSE
)
{
call
=
match.call
()
call
[[
1
]]
=
quote
(
dplyr
::
left_join
)
call
[[
2
]]
=
quote
(
unclass_robiobject
(
x
))
eval
(
call
)
%>%
robisample
()
}
\ No newline at end of file
R/entropie.R
View file @
81b263d0
...
...
@@ -71,6 +71,7 @@ dd_exp_q = function(x, q = 1) {
#' @author Eric Coissac
#' @export
H_q
=
function
(
x
,
q
=
1
,
normalize
=
TRUE
)
{
x
=
x
[
x
>
0
]
if
(
normalize
)
x
<-
x
/
sum
(
x
)
sum
(
x
*
log_q
(
1
/
x
,
q
))
...
...
R/metabar_data_class.R
View file @
81b263d0
...
...
@@ -125,14 +125,14 @@ motus <- function(data) {
#' @rdname motus
#' @export
s
et
_motus
<-
function
(
value
,
data
)
{
UseMethod
(
"s
et
_motus"
,
value
)
s
tore_into
_motus
<-
function
(
value
,
data
)
{
UseMethod
(
"s
tore_into
_motus"
,
value
)
}
#' @rdname motus
#' @export
`motus<-`
<-
function
(
data
,
value
)
{
value
%>%
s
et
_motus
(
data
)
value
%>%
s
tore_into
_motus
(
data
)
invisible
(
data
)
}
...
...
@@ -145,16 +145,21 @@ samples <- function(data) {
#' @rdname motus
#' @export
s
et
_samples
<-
function
(
value
,
data
)
{
UseMethod
(
"s
et
_samples"
,
value
)
s
tore_into
_samples
<-
function
(
value
,
data
)
{
UseMethod
(
"s
tore_into
_samples"
,
value
)
}
#' @rdname motus
#' @export
`samples<-`
<-
function
(
data
,
value
)
{
value
%>%
s
et
_samples
(
data
)
value
%>%
s
tore_into
_samples
(
data
)
invisible
(
data
)
}
#' @export
store_into
<-
function
(
value
,
data
)
{
UseMethod
(
"store_into"
,
value
)
}
R/robicategory.R
View file @
81b263d0
...
...
@@ -384,3 +384,23 @@ pillar_shaft.robicategory <- function(x, ...) {
}
#' Title
#'
#' @param x
#' @param incomparables
#' @param fromLast
#' @param nmax
#' @param ...
#'
#' @return
#' @export
#'
#' @examples
unique.robicategory
<-
function
(
x
,
incomparables
=
FALSE
,
fromLast
=
FALSE
,
nmax
=
NA
,
...
)
{
call
=
match.call
()
call
[[
1
]]
<-
quote
(
unique.default
)
as_robicategory
(
eval
(
call
))
}
R/robimetabar.R
View file @
81b263d0
...
...
@@ -165,7 +165,7 @@ new_robimetabar <- function(data,
#' rownames(reads) <- c("sample_1", "sample_2", "sample_3")
#' colnames(reads) <- c("motu_1", "motu_2", "motu_3", "motu_4")
#'
#' metabar <- robimetabar(
reads
= reads)
#' metabar <- robimetabar(
data
= reads)
#'
#' samples(metabar)
#' motus(metabar)
...
...
@@ -242,7 +242,7 @@ robimetabar <- function(data, samples, motus,
if
(
verbose
)
message
(
"missing sample descriptions"
)
if
(
!
is.null
(
sample_names
))
samples
=
robisample
(
tibble
(
id
=
robiuniqueid
(
sample_names
)))
samples
=
robisample
(
tibble
(
id
=
as_
robiuniqueid
(
sample_names
)))
else
{
if
(
verbose
)
message
(
"no row names on the data matrix"
)
samples
=
robisample
(
n
=
c
(
pcr
=
nrow
(
data
)))
...
...
@@ -278,7 +278,7 @@ robimetabar <- function(data, samples, motus,
else
{
if
(
verbose
)
message
(
"missing motus descriptions"
)
if
(
!
is.null
(
motus_names
))
motus
=
robimotu
(
tibble
(
id
=
robiuniqueid
(
motus_names
)))
motus
=
robimotu
(
tibble
(
id
=
as_
robiuniqueid
(
motus_names
)))
else
{
if
(
verbose
)
message
(
"no column names on the data matrix"
)
motus
=
robimotu
(
n
=
ncol
(
data
))
...
...
@@ -425,43 +425,6 @@ motus.robimetabar <- function(data) {
data
$
motus
}
#' @rdname motus
#' @export
set_samples.robisample
<-
function
(
value
,
data
)
{
robiassert_arg
(
is_robimetabar
(
data
),
"data"
,
"the data parameter must belong the class robimetabar, not {dclass}"
,
dclass
=
class
(
data
)[
1
])
data
$
samples
<-
value
invisible
(
data
)
}
#' @rdname motus
#' @export
set_sample.data.frame
<-
function
(
value
,
data
)
{
set_sample.robimotu
(
robisample
(
value
),
data
)
}
#' @rdname motus
#' @export
set_motus.robimotu
<-
function
(
value
,
data
)
{
robiassert_arg
(
is_robimetabar
(
data
),
"data"
,
"the data parameter must belong the class robimetabar, not {dclass}"
,
dclass
=
class
(
data
)[
1
])
data
$
motus
<-
value
invisible
(
data
)
}
#' @rdname motus
#' @export
set_motus.data.frame
<-
function
(
value
,
data
)
{
set_motus.robimotu
(
robimotu
(
value
),
data
)
}
#' @author Eric Coissac
#' @export
...
...
R/robimetabar_aggregate.R
0 → 100644
View file @
81b263d0
#' @include robimetabar.R
#' @import dplyr
#'
NULL
identical_or_na
<-
function
(
x
)
{
x
<-
unique
(
x
)
if
(
length
(
x
)
==
1
)
x
else
NA
}
#' Title
#'
#' @param data
#' @param key
#'
#' @return
#' @export
#'
#' @examples
aggregate_robidata
<-
function
(
data
,
key
)
{
id_col
=
ids_colname
(
data
)
data
%>%
mutate
(
`__key__`
=
key
)
%>%
select
(
-!!
id_col
)
%>%
group_by
(
`__key__`
)
%>%
summarise_all
(
identical_or_na
)
%>%
mutate
(
!!
id_col
:=
as_robiuniqueid
(
as.character
(
`__key__`
)))
%>%
select
(
-
`__key__`
)
%>%
select
(
!!
id_col
,
everything
())
->
data
sapply
(
data
,
function
(
c
)
!
all
(
is_na
(
c
)))
->
to_keep
data
[,
to_keep
]
%>%
as_robidata
()
}
samples_average_data
<-
function
(
metabar
,
key
)
{
id_col
=
samples_ids_colname
(
metabar
)
bys
<-
"sample"
names
(
bys
)
=
id_col
samples
(
metabar
)
->
s
s
$
`__key__`
<-
as.character
(
key
)
s
%>%
select
(
!!
id_col
,
`__key__`
)
%>%
group_by
(
`__key__`
)
%>%
mutate
(
`__gsize__`
=
length
(
`__key__`
))
%>%
ungroup
()
%>%
right_join
(
metabar
$
data
%>%
group_by
(
sample
)
%>%
mutate
(
`__scount__`
=
sum
(
count
),
`__rel_freq__`
=
count
/
`__scount__`
)
%>%
ungroup
(),
by
=
bys
)
%>%
select
(
-!!
id_col
)
%>%
group_by
(
`__key__`
,
motu
)
%>%
summarise
(
count
=
sum
(
`__rel_freq__`
)
/
`__gsize__`
[
1
]
*
`__scount__`
[
1
])
%>%
select
(
sample
=
`__key__`
,
motu
,
count
)
%>%
ungroup
()
}
motus_average_data
<-
function
(
metabar
,
key
)
{
id_col
=
motus_ids_colname
(
metabar
)
bys
<-
"motu"
names
(
bys
)
=
id_col
motus
(
metabar
)
%>%
mutate
(
`__key__`
=
as.character
(
key
))
%>%
select
(
!!
id_col
,
`__key__`
)
%>%
right_join
(
metabar
$
data
,
by
=
bys
)
%>%
select
(
-!!
id_col
)
%>%
group_by
(
`__key__`
,
sample
)
%>%
summarise_all
(
mean
)
%>%
select
(
sample
,
motu
=
`__key__`
,
everything
())
}
#' Title
#'
#' @param metabar
#' @param key
#'
#' @return
#' @export
#'
#' @examples
samples_average
<-
function
(
metabar
,
key
)
{
data
<-
samples_average_data
(
metabar
,
key
)
samples
<-
aggregate_robidata
(
samples
(
metabar
),
key
)
%>%
as_robisample
()
motus
<-
motus
(
metabar
)
new_robimetabar
(
data
=
data
,
samples
=
samples
,
motus
=
motus
)
}
#' Title
#'
#' @param metabar
#' @param key
#'
#' @return
#' @export
#'
#' @examples
motus_average
<-
function
(
metabar
,
key
)
{
data
<-
motus_average_data
(
metabar
,
key
)
motus
<-
aggregate_robidata
(
motus
(
metabar
),
key
)
%>%
as_robimotu
()
samples
<-
samples
(
metabar
)
new_robimetabar
(
data
=
data
,
samples
=
samples
,
motus
=
motus
)
}
\ No newline at end of file
R/robimetabar_filter.R
View file @
81b263d0
...
...
@@ -3,7 +3,54 @@
#'
NULL
#' Filters out samples based on reacd count.
filter_data_orphean
<-
function
(
metabar
)
{
metabar
$
data
[
metabar
$
data
$
motu
%in%
pull
(
motus_ids
(
metabar
))
&
metabar
$
data
$
sample
%in%
pull
(
samples_ids
(
metabar
)),]
->
metabar
$
data
invisible
(
metabar
)
}
#' Remove samples with no more reads associated to them.
#'
#' @param metabar
#'
#' @return
#' @export
#'
#' @examples
filter_sample_empty
<-
function
(
metabar
)
{
metabar
$
data
%>%
group_by
(
sample
)
%>%
summarise
(
.total__
=
sum
(
count
))
%>%
filter
(
.total__
>
0
)
%>%
pull
(
sample
)
->
skeep
samples
(
metabar
)[(
samples_ids
(
metabar
)
%>%
pull
())
%in%
skeep
,]
->
metabar
$
samples
invisible
(
filter_data_orphean
(
metabar
))
}
#' Remove MOTUs with no more reads associated to them.
#'
#' @param metabar
#'
#' @return
#' @export
#'
#' @examples
filter_motus_empty
<-
function
(
metabar
)
{
metabar
$
data
%>%
group_by
(
motu
)
%>%
summarise
(
.total__
=
sum
(
count
))
%>%
filter
(
.total__
>
0
)
%>%
pull
(
motu
)
->
skeep
motus
(
metabar
)[(
motus_ids
(
metabar
)
%>%
pull
())
%in%
skeep
,]
->
metabar
$
motus
invisible
(
filter_data_orphean
(
metabar
))
}
#' Filters out samples based on read count.
#'
#' Filters out samples having less than the specified minimum
#' number of reads in total.
...
...
@@ -15,7 +62,8 @@ NULL
#'
#' @return the modified robimetabar object
#' @export
#'
#' @md
#' @seealso `filter_sample_empty`, `filter_motus_empty`
#' @examples
filter_sample_min_read
<-
function
(
metabar
,
min_read
,
remove_empty_samples
=
TRUE
,
...
...
@@ -27,15 +75,139 @@ filter_sample_min_read <- function(metabar,min_read,
select
(
-
.total__
)
%>%
ungroup
()
->
metabar
$
data
if
(
remove_empty_samples
)
{
metabar
$
data
%>%
group_by
(
sample
)
%>%
summarise
(
.total__
=
sum
(
count
))
%>%
filter
(
.total__
>
0
)
%>%
pull
(
sample
)
->
skeep
if
(
remove_empty_samples
)
filter_sample_empty
(
metabar
)
samples
(
metabar
)[(
samples_ids
(
metabar
)
%>%
pull
())
%in%
skeep
,]
->
metabar
$
samples
}
if
(
remove_empty_motus
)
filter_motus_empty
(
metabar
)
invisible
(
metabar
)
}
#' Filters out samples based on read count.
#'
#' `filter_sample_max_read` filters out samples having more than the specified maximum
#' number of reads in total.
#'
#' @param max_read
#'
#'
#' @rdname filter_sample_min_read
#' @md
#' @examples
#' @export
filter_sample_max_read
<-
function
(
metabar
,
max_read
,
remove_empty_samples
=
TRUE
,
remove_empty_motus
=
TRUE
)
{
metabar
$
data
%>%
group_by
(
sample
)
%>%
mutate
(
.total__
=
sum
(
count
))
%>%
filter
(
.total__
<=
max_read
)
%>%
select
(
-
.total__
)
%>%
ungroup
()
->
metabar
$
data
if
(
remove_empty_samples
)
filter_sample_empty
(
metabar
)
if
(
remove_empty_motus
)
filter_motus_empty
(
metabar
)
invisible
(
metabar
)
}
#' Filters out samples based on diversity.
#'
#' Filters out samples having a diversity below the specified minimum
#' Hill's number specified.
#'
#' @param metabar
#' @param remove_empty_samples
#' @param remove_empty_motus
#' @param min_diversity
#' @param q
#'
#' @return the modified robimetabar object
#' @export
#'
#' @examples
filter_sample_min_diversity
<-
function
(
metabar
,
min_diversity
,
q
=
1
,
remove_empty_samples
=
TRUE
,
remove_empty_motus
=
TRUE
)
{
metabar
$
data
%>%
group_by
(
sample
)
%>%
mutate
(
.diversity__
=
D_q
(
count
,
q
=
q
))
%>%
filter
(
.diversity__
>=
min_diversity
)
%>%
select
(
-
.diversity__
)
%>%
ungroup
()
->
metabar
$
data
if
(
remove_empty_samples
)
filter_sample_empty
(
metabar
)
if
(
remove_empty_motus
)
filter_motus_empty
(
metabar
)
invisible
(
metabar
)
}
#' Filters out samples based on diversity.
#'
#' Filters out samples having a diversity below the specified minimum
#' Hill's number specified.
#'
#' @param metabar
#' @param remove_empty_samples
#' @param remove_empty_motus
#' @param min_diversity
#' @param q
#'
#' @return the modified robimetabar object
#' @export
#'
#' @rdname filter_sample_min_diversity
#' @examples
filter_sample_max_diversity
<-
function
(
metabar
,
max_diversity
,
q
=
1
,
remove_empty_samples
=
TRUE
,
remove_empty_motus
=
TRUE
)
{
metabar
$
data
%>%
group_by
(
sample
)
%>%
mutate
(
.diversity__
=
D_q
(
count
,
q
=
q
))
%>%
filter
(
.diversity__
<=
min_diversity
)
%>%
select
(
-
.diversity__
)
%>%
ungroup
()
->
metabar
$
data
if
(
remove_empty_samples
)
filter_sample_empty
(
metabar
)
if
(
remove_empty_motus
)
filter_motus_empty
(
metabar
)
invisible
(
metabar
)
}
#' Filters out samples based on category
#'
#' Filters out samples having not belonging the specified sample categories.