Skip to content

Commit

Permalink
Revert back to as_tibble() methods
Browse files Browse the repository at this point in the history
The S4 generic `ps_tibble()` was developed in place of `as_tibble()`
methods to avoid issue #61. However, this issue was due to speedyseq
defining an S4 generic `as_tibble()` in addition to the S3 methods for
`tibble::as_tibble()`. Defining S3 methods alone seems sufficient for
the desired behavior without an addition S4 method.

Other changes: Import tibble in joins example; rebuild site.
  • Loading branch information
mikemc committed Jun 25, 2021
1 parent eb5d030 commit ceb941f
Show file tree
Hide file tree
Showing 54 changed files with 955 additions and 339 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: speedyseq
Title: Faster implementations of phyloseq functions
Version: 0.5.3.9017
Version: 0.5.3.9018
Authors@R:
person(given = "Michael",
family = "McLaren",
Expand Down
7 changes: 6 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# Generated by roxygen2: do not edit by hand

S3method(as_tibble,XStringSet)
S3method(as_tibble,otu_table)
S3method(as_tibble,phyloseq)
S3method(as_tibble,sample_data)
S3method(as_tibble,taxonomyTable)
S3method(glimpse,sample_data)
S3method(glimpse,taxonomyTable)
S3method(print,otu_table)
Expand All @@ -24,7 +29,6 @@ export(orient_taxa)
export(plot_bar)
export(plot_heatmap)
export(plot_tree)
export(ps_tibble)
export(psmelt)
export(relocate_sample_data)
export(relocate_tax_table)
Expand Down Expand Up @@ -69,5 +73,6 @@ importFrom(ggplot2,scale_y_discrete)
importFrom(ggplot2,theme)
importFrom(magrittr,"%>%")
importFrom(scales,log_trans)
importFrom(tibble,as_tibble)
importFrom(tibble,glimpse)
importFrom(vegan,scores)
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@

* `merge_samples2()` now has a `fun_otu` argument for specifying alternative abundance-summarization functions

* Add `ps_tibble()` S4 generic to provide `tibble::as_tibble()` functionality for phyloseq objects
* Add `as_tibble()` methods for phyloseq objects

* Fixed bug in print outputs. Row numbers are now kept as their removal was causing the issue. This is a temporary fix; see [#60](https://github.com/mikemc/speedyseq/issues/60).

Expand Down
147 changes: 147 additions & 0 deletions R/as_tibble.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,147 @@
#' @importFrom tibble as_tibble
tibble::as_tibble

#' Coerce phyloseq objects to tibble data frames
#'
#' These functions extend the `as_tibble()` function defined by the tibble
#' package to work on phyloseq objects or phyloseq-component objects.
#'
#' Tibbles (tbl_df objects) do not support rownames; the taxa and sample names
#' in the returned tibbles will always be stored in the first or second
#' columns. The names ".otu", ".sample", ".abundance", and ".sequence" are
#' special column names reserved for the otu/taxa names, sample names,
#' abundances, and reference sequences.
#'
#' @param x A phyloseq object or component.
#' @param pivot Whether to pivot the otu table to long format.
#' @param tax Whether to include taxonomy data.
#' @param ref Whether to include reference sequences.
#' @param .name_repair Function to repair names in the case of conflicts.
#'
#' @return A tibble (tbl_df)
#'
#' @name as_tibble-phyloseq
#'
#' @examples
#' library(tibble) # for as_tibble() and glimpse()
#'
#' data(GlobalPatterns)
#'
#' # Subset to 1/100 of the original taxa to speed operations
#' ps <- GlobalPatterns %>%
#' filter_tax_table(dplyr::row_number() %% 100 == 1)
#'
#' # On phyloseq objects, as_tibble is similar to psmelt()
#' psmelt(ps) %>% glimpse
#' as_tibble(ps) %>% glimpse
#'
#' # By default, the otu_table method provides a tibble in long-format like
#' # psmelt and the phyloseq method
#' otu_table(ps) %>% as_tibble %>% glimpse
#'
#' # Sample data and taxonomy tables produced by as_tibble can be converted
#' # back into their respective phyloseq objects using speedyseq's tbl_df
#' # constructors
#' sample_data(ps) <- sample_data(ps) %>%
#' as_tibble %>%
#' dplyr::mutate(sample_sum = sample_sums(ps)) %>%
#' sample_data
#' sample_data(ps) %>% glimpse
NULL

#' @export
#' @rdname as_tibble-phyloseq
as_tibble.otu_table <- function(x,
pivot = TRUE,
.name_repair = base::make.unique) {
mat <- x %>% as("matrix")
if (pivot) {
if (!taxa_are_rows(x))
mat <- t(mat)
tb <- mat %>%
tibble::as_tibble(rownames = ".otu") %>%
tidyr::pivot_longer(
cols = sample_names(x),
names_to = ".sample",
values_to = ".abundance"
)
} else {
rn <- ifelse(taxa_are_rows(x), ".otu", ".sample")
tb <- mat %>%
tibble::as_tibble(rownames = rn) %>%
rlang::set_names(.,
vctrs::vec_as_names(names(.), repair = .name_repair)
)
}
tb
}

#' @export
#' @rdname as_tibble-phyloseq
as_tibble.sample_data <- function(x, .name_repair = base::make.unique) {
x %>%
as("data.frame") %>%
tibble::as_tibble(rownames = ".sample") %>%
rlang::set_names(.,
vctrs::vec_as_names(names(.), repair = .name_repair)
)
}

#' @export
#' @rdname as_tibble-phyloseq
as_tibble.taxonomyTable <- function(x, .name_repair = base::make.unique) {
x %>%
as("matrix") %>%
tibble::as_tibble(rownames = ".otu") %>%
rlang::set_names(.,
vctrs::vec_as_names(names(.), repair = .name_repair)
)
}

#' @export
#' @rdname as_tibble-phyloseq
as_tibble.XStringSet <- function(x) {
x %>%
as.character %>%
tibble::enframe(".otu", ".sequence")
}

#' @export
#' @rdname as_tibble-phyloseq
as_tibble.phyloseq <- function(x,
tax = TRUE,
ref = FALSE,
.name_repair = base::make.unique) {
tb <- otu_table(x) %>% as_tibble(pivot = TRUE)
# Add sample data if it exists
sam <- access(x, "sam_data")
if (!is.null(sam)) {
tb <- tb %>%
dplyr::left_join(
sam %>% as_tibble(.name_repair = .name_repair),
by = ".sample",
suffix = c("", ".sam")
)
}
# Add tax_table if it exists and tax = TRUE
tt <- access(x, "tax_table")
if (tax & !is.null(tt)) {
tb <- tb %>%
dplyr::left_join(
tt %>% as_tibble(.name_repair = .name_repair),
by = ".otu",
suffix = c("", ".tax")
)
}
# Add refseq if it exists and ref = TRUE
rs <- access(x, "refseq")
if (ref & !is.null(rs)) {
tb <- tb %>%
dplyr::left_join(
rs %>% as_tibble,
by = ".otu",
suffix = c("", ".ref")
)
}
tb
}
12 changes: 7 additions & 5 deletions R/dplyr-joins.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,8 @@
#' @name join-phyloseq
#'
#' @examples
#' library(tibble)
#'
#' data(GlobalPatterns)
#'
#' GlobalPatterns %>% sample_variables
Expand All @@ -39,7 +41,7 @@
#' y <- GlobalPatterns %>%
#' sample_data %>%
#' select_sample_data(contains("Barcode")) %>%
#' ps_tibble
#' as_tibble
#' ps2 <- ps1 %>% left_join_sample_data(y, by = ".sample")
#' ps2 %>% sample_variables
NULL
Expand All @@ -63,7 +65,7 @@ setMethod("left_join_tax_table", "phyloseq",
setMethod("left_join_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::left_join(...) %>%
{suppressMessages(tax_table(.))}
})
Expand All @@ -85,7 +87,7 @@ setMethod("left_join_sample_data", "phyloseq",
setMethod("left_join_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::left_join(...) %>%
{suppressMessages(sample_data(.))}
})
Expand All @@ -111,7 +113,7 @@ setMethod("inner_join_tax_table", "phyloseq",
setMethod("inner_join_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::inner_join(...) %>%
{suppressMessages(tax_table(.))}
})
Expand All @@ -133,7 +135,7 @@ setMethod("inner_join_sample_data", "phyloseq",
setMethod("inner_join_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::inner_join(...) %>%
{suppressMessages(sample_data(.))}
})
Expand Down
28 changes: 14 additions & 14 deletions R/dplyr-verbs.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ setMethod("filter_tax_table", "phyloseq",
setMethod("filter_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::filter(...) %>%
{suppressMessages(tax_table(.))}
})
Expand All @@ -64,7 +64,7 @@ setMethod("filter_sample_data", "phyloseq",
setMethod("filter_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::filter(...) %>%
{suppressMessages(sample_data(.))}
})
Expand Down Expand Up @@ -118,7 +118,7 @@ setGeneric("mutate_tax_table",
setMethod("mutate_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::mutate(...) %>%
{suppressMessages(tax_table(.))}
})
Expand Down Expand Up @@ -146,7 +146,7 @@ setGeneric("transmute_tax_table",
setMethod("transmute_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
# Make sure the .otu column is always included; new names can still be
# set if .otu occurs in the ... expressions
dplyr::transmute(.otu, ...) %>%
Expand Down Expand Up @@ -177,7 +177,7 @@ setGeneric("mutate_sample_data",
setMethod("mutate_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::mutate(...) %>%
{suppressMessages(sample_data(.))}
})
Expand Down Expand Up @@ -205,7 +205,7 @@ setGeneric("transmute_sample_data",
setMethod("transmute_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
# Make sure the .sample column is always included; new names can still be
# set if .sample occurs in the ... expressions
dplyr::transmute(.sample, ...) %>%
Expand Down Expand Up @@ -265,7 +265,7 @@ setGeneric("select_tax_table",
setMethod("select_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
# Ensure .otu always kept; Putafter the ... to handle use of '-' for
# column removal
dplyr::select(..., .otu) %>%
Expand All @@ -290,7 +290,7 @@ setGeneric("select_sample_data",
setMethod("select_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
# Ensure .sample always kept; put after the ... to handle use of '-' for
# column removal
dplyr::select(..., .sample) %>%
Expand Down Expand Up @@ -342,7 +342,7 @@ setGeneric("relocate_tax_table",
setMethod("relocate_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::relocate(...) %>%
# Ensure .otu always kept first
dplyr::relocate(.otu) %>%
Expand All @@ -366,7 +366,7 @@ setGeneric("relocate_sample_data",
setMethod("relocate_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::relocate(...) %>%
# Ensure .sample always kept first
dplyr::relocate(.sample) %>%
Expand Down Expand Up @@ -426,7 +426,7 @@ setGeneric("rename_tax_table",
setMethod("rename_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::rename(...) %>%
{suppressMessages(tax_table(.))}
})
Expand All @@ -450,7 +450,7 @@ setGeneric("rename_with_tax_table",
setMethod("rename_with_tax_table", "taxonomyTable",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::rename_with(...) %>%
{suppressMessages(tax_table(.))}
})
Expand All @@ -474,7 +474,7 @@ setGeneric("rename_sample_data",
setMethod("rename_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::rename(...) %>%
{suppressMessages(sample_data(.))}
})
Expand All @@ -498,7 +498,7 @@ setGeneric("rename_with_sample_data",
setMethod("rename_with_sample_data", "sample_data",
function(x, ...) {
x %>%
ps_tibble %>%
as_tibble %>%
dplyr::rename_with(...) %>%
{suppressMessages(sample_data(.))}
})
Expand Down

0 comments on commit ceb941f

Please sign in to comment.