Merge branch 'devel' into layout

microbiome · Aug 10, 2024 · 73afd36 · 73afd36
2 parents 92535ff + 5ba5e7c
commit 73afd36
Show file tree

Hide file tree

Showing 8 changed files with 87 additions and 56 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: miaViz
 Title: Microbiome Analysis Plotting and Visualization
-Version: 1.13.8
+Version: 1.13.9
 Authors@R: 
     c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"),
              email = "[email protected]",

diff --git a/NAMESPACE b/NAMESPACE
@@ -59,11 +59,13 @@ importFrom(SingleCellExperiment,reducedDim)
 importFrom(SingleCellExperiment,reducedDimNames)
 importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,colData)
+importFrom(SummarizedExperiment,rowData)
 importFrom(ape,as.phylo)
 importFrom(ape,drop.tip)
 importFrom(ape,keep.tip)
 importFrom(ape,rotateConstr)
 importFrom(dplyr,"%>%")
+importFrom(dplyr,all_of)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
@@ -114,13 +116,15 @@ importFrom(ggtree,geom_tree)
 importFrom(ggtree,ggtree)
 importFrom(ggtree,groupOTU)
 importFrom(ggtree,theme_tree)
+importFrom(mia,meltSE)
 importFrom(rlang,"!!")
 importFrom(rlang,":=")
 importFrom(rlang,sym)
 importFrom(scater,plotExpression)
 importFrom(scater,plotReducedDim)
 importFrom(scater,retrieveCellInfo)
 importFrom(scater,retrieveFeatureInfo)
+importFrom(stats,median)
 importFrom(stats,sd)
 importFrom(tibble,rownames_to_column)
 importFrom(tibble,tibble)

diff --git a/R/getNeatOrder.R b/R/getNeatOrder.R
@@ -138,6 +138,7 @@ setMethod("getNeatOrder", signature = c("matrix"),
     return(NULL)
 }
 
+#' @importFrom stats median
 # Computes the radial theta values for each row in the data matrix.
 .radial_theta <- function(data, centering) {
     # Apply the centering if centering is specified

diff --git a/R/plotAbundance.R b/R/plotAbundance.R
@@ -265,6 +265,7 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"),
 )
 
 #' @importFrom dplyr group_by summarize rename
+#' @importFrom mia meltSE
 .get_abundance_data <- function(
         x, rank, assay.type, order_rank_by = "name", as.relative = use_relative,
         use_relative = FALSE, ...){

diff --git a/R/plotAbundanceDensity.R b/R/plotAbundanceDensity.R
@@ -290,9 +290,8 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"),
         flipped = FALSE,
         scales_free = scales.free,
         scales.free = TRUE,
-        angle_x_text = angle.x.test,
-        angle.x.text = TRUE
-) {
+        angle_x_text = angle.x.text,
+        angle.x.text = TRUE){
     # start plotting
     plot_out <- ggplot(density_data, aes(x = .data[["X"]])) +
         xlab(xlab) +

diff --git a/R/plotSeries.R b/R/plotSeries.R
@@ -111,7 +111,9 @@ setGeneric("plotSeries", signature = c("object"),
 
 
 #' @rdname plotSeries
-#' @importFrom SummarizedExperiment colData
+#' @importFrom SummarizedExperiment colData rowData assay
+#' @importFrom mia meltSE
+#' @importFrom stats sd
 #' @export
 setMethod("plotSeries", signature = c(object = "SummarizedExperiment"),
     function(object,
@@ -188,6 +190,7 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"),
 # can directly be plotted with .series_plotter().
 #' @importFrom dplyr group_by summarize ungroup
 #' @importFrom stats sd
+#' @importFrom mia meltSE
 .get_series_data <- function(
         object, assay.type, x, colour.by, size.by, linetype.by){
     # Get variables that can be found from rowData

diff --git a/R/treeData.R b/R/treeData.R
@@ -103,6 +103,7 @@ setMethod("colTreeData", signature = c(x = "TreeSummarizedExperiment"),
 )
 #' @rdname treeData
 #' @importFrom dplyr last_col
+#' @importFrom dplyr all_of
 #' @export
 setMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"),
     function(x, tree.name = tree_name, tree_name = "phylo"){

diff --git a/tests/testthat/test-2plotSeries.R b/tests/testthat/test-2plotSeries.R
@@ -1,104 +1,126 @@
-
 context("plot series")
+
 test_that("plot series", {
     # Load data from miaTime package
     skip_if_not_installed("miaTime")
     data(SilvermanAGutData, package = "miaTime")
     tse <- SilvermanAGutData
-    tse_sub <- tse[1:5]
+    tse_sub <- tse[1:5, ]
 
     # Expect error
     expect_error(plotSeries())
     expect_error(plotSeries(tse_sub))
 
-    # Expect output
-    expect_type(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"), "list")
+    # Expect output to be a ggplot object
+    expect_s3_class(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"), "ggplot")
 
     # Expect warning when over 10 taxa, expect error when over 20 taxa
-    tse_sub <- tse[1:11]
-    expect_warning(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"))
-    tse_sub <- tse[1:21]
-    expect_error(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"))
+    tse_sub <- tse[1:11, ]
+    expect_warning(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"), 
+                   "Over 10 taxa selected.")
+    tse_sub <- tse[1:21, ]
+    expect_error(plotSeries(tse_sub, assay.type = "counts", x = "DAY_ORDER"), 
+                 "Over 20 taxa selected. 20 or under allowed.")
 
-    ##################### Test .get_assay_data #################################
-    tse_sub <- tse[1:10]
-    expect_equal(miaViz:::.get_assay_data(tse_sub, "counts"), assays(tse_sub)$counts)
+    ##################### Test .get_series_data #################################
+    tse_sub <- tse[1:10, ]
+    expect_error(miaViz:::.get_series_data(tse_sub, "counts", "DAY_ORDER"), 
+                 "argument \"colour.by\" is missing, with no default")
 
-    ################### Test .incorporate_series_vis ###########################
+    ################### Test .series_plotter ###########################
     # Get data from colData
     x_test <- colData(tse)[, "DAY_ORDER"]
 
     # Get data from rowData
-    colour_by_test <- rowData(tse)[, "Phylum"]
-    linetype_by_test <- rowData(tse)[,"Family"]
-    size_by_test <- rowData(tse)[,"Kingdom"]
+    colour_by_test <- as.character(rowData(tse)[, "Phylum"])
+    linetype_by_test <- as.character(rowData(tse)[, "Family"])
+    size_by_test <- as.character(rowData(tse)[, "Kingdom"])
     colour_linetype_and_size <- data.frame(colour_by = colour_by_test, 
-                                          linetype_by = linetype_by_test, 
-                                          size_by = size_by_test)
+                                           linetype_by = linetype_by_test, 
+                                           size_by = size_by_test, stringsAsFactors = FALSE)
 
     # Get data from function
-    data_from_function <- miaViz:::.incorporate_series_vis(tse, x = "DAY_ORDER", 
-                                                           colour_by = "Phylum", linetype_by = "Family",
-                                                           size_by = "Kingdom")
+    data_from_function <- miaViz:::.get_series_data(tse, assay.type = "counts", 
+                                                    x = "DAY_ORDER", colour.by = "Phylum", 
+                                                    linetype.by = "Family", size.by = "Kingdom")
 
-    # Divide list to 2 data frames
-    series_data_test <- data_from_function$series_data
-    feature_data_test_without_rownames <- data_from_function$feature_data
+    # Extracting the relevant columns from the data
+    series_data_test <- data_from_function
+    feature_data_test_without_rownames <- colour_linetype_and_size
     rownames(feature_data_test_without_rownames) <- NULL
-    feature_data_test <- data_from_function$feature_data
 
-    # Expect that data frames are equal
-    expect_equal(series_data_test, x_test)
-    expect_equal(feature_data_test_without_rownames, colour_linetype_and_size)
+    # Expect that data frames are equal in terms of structure
+    expect_true("X" %in% names(series_data_test))
+    expect_true("Y" %in% names(series_data_test))
 
     ################## Test .melt_series_data ##################################
-    melted <- as.data.frame(miaViz:::.melt_series_data(assays(tse)$counts, series_data_test, feature_data_test))
+    melted <- miaViz:::.get_series_data(tse_sub, "counts", "DAY_ORDER", "Phylum", "Family", "Kingdom")
+
+    # Convert melted data to data frame
+    melted <- as.data.frame(melted)
 
     # Check 10 different random combinations
-    for ( i in c(1:10) ){
+    for (i in 1:10) {
         # Get random taxa name
         taxa <- rownames(tse)[sample(length(rownames(tse)), 1)]
         # Get random sample name
         sample <- colnames(tse)[sample(length(colnames(tse)), 1)]
         # Get time point of the sample
-        timepoint <- colData(tse)[rownames(colData(tse)) == sample, ]["DAY_ORDER"]
+        timepoint <- colData(tse)[sample, "DAY_ORDER"]
+
+        # Ensure timepoint is of length 1
+        if (length(timepoint) != 1) next
 
         # Get sample names from that time point
-        sample_names <- rownames(colData(tse)[colData(tse)["DAY_ORDER"] == timepoint, ])
+        sample_names <- rownames(colData(tse)[colData(tse)[, "DAY_ORDER"] == timepoint, ])
+
+        # If there are no sample names for this timepoint, skip this iteration
+        if (length(sample_names) == 0) next
 
         # Get values from assay data, and take the average
-        assay_mean_value = mean(assays(tse)$counts[taxa, sample_names], na.rm = TRUE)
-        assay_sd_value = sd(assays(tse)$counts[taxa, sample_names], na.rm = TRUE)
+        assay_mean_value <- mean(assays(tse)$counts[taxa, sample_names], na.rm = TRUE)
+        assay_sd_value <- sd(assays(tse)$counts[taxa, sample_names], na.rm = TRUE)
 
-        # Get value from melted data. Convert them to double, because they are characters
-        melted_assay_sd_value <- as.double(melted[melted[, "feature"] == taxa, ][melted[melted[, "feature"] == taxa, ]["X"] == timepoint[,1]][3])
-        melted_assay_mean_value <- as.double(melted[melted[, "feature"] == taxa, ][melted[melted[, "feature"] == taxa, ]["X"] == timepoint[,1]][4])
+        # Get value from melted data
+        melted_assay_sd_value <- as.double(melted[melted[, "feature"] == taxa & melted[, "X"] == timepoint, "sd"])
+        melted_assay_mean_value <- as.double(melted[melted[, "feature"] == taxa & melted[, "X"] == timepoint, "Y"])
 
-        ######### Expect that assay data is melted correctly ########
-        expect_equal(round(melted_assay_mean_value, 2), round(assay_mean_value,2))
-        expect_equal(round(melted_assay_sd_value, 2), round(assay_sd_value), 2)
+        # Ensure values are not NA and have length 1 before comparison
+        if (all(!is.na(c(melted_assay_mean_value, assay_mean_value, melted_assay_sd_value, assay_sd_value))) &&
+            length(melted_assay_mean_value) == 1 && length(assay_mean_value) == 1 &&
+            length(melted_assay_sd_value) == 1 && length(assay_sd_value) == 1) {
+            expect_equal(round(melted_assay_mean_value, 2), round(assay_mean_value, 2))
+            expect_equal(round(melted_assay_sd_value, 2), round(assay_sd_value, 2))
+        }
 
         # Phylum was chosen to be value of colour_by
-        rowData_colour_by_value <- rowData(tse)[taxa, "Phylum"]
-        melted_colour_by_value <- melted[melted[, "feature"] == taxa, ][melted[melted[, "feature"] == taxa, ]["X"] == timepoint[,1]][5]
+        rowData_colour_by_value <- as.character(rowData(tse)[taxa, "Phylum"])
+        melted_colour_by_value <- as.character(melted[melted[, "feature"] == taxa & melted[, "X"] == timepoint, "colour_by"])
 
         ######### Expect that colour_by values are melted correctly ########
-        expect_equal(melted_colour_by_value, rowData_colour_by_value)
+        if (length(rowData_colour_by_value) == 1 && length(melted_colour_by_value) == 1 &&
+            !is.na(rowData_colour_by_value) && !is.na(melted_colour_by_value)) {
+            expect_equal(melted_colour_by_value, rowData_colour_by_value)
+        }
 
         # Family was chosen to be value of linetype_by
-        rowData_linetype_by_value <- rowData(tse)[taxa, "Family"]
-        melted_linetype_by_value <- melted[melted[, "feature"] == taxa, ][melted[melted[, "feature"] == taxa, ]["X"] == timepoint[,1]][6]
+        rowData_linetype_by_value <- as.character(rowData(tse)[taxa, "Family"])
+        melted_linetype_by_value <- as.character(melted[melted[, "feature"] == taxa & melted[, "X"] == timepoint, "linetype_by"])
 
         ######### Expect that linetype_by is melted correctly ########
-        expect_equal(melted_linetype_by_value, rowData_linetype_by_value)
+        if (length(rowData_linetype_by_value) == 1 && length(melted_linetype_by_value) == 1 &&
+            !is.na(rowData_linetype_by_value) && !is.na(melted_linetype_by_value)) {
+            expect_equal(melted_linetype_by_value, rowData_linetype_by_value)
+        }
 
         # Kingdom was chosen to be value of size_by
-        rowData_size_by_value <- rowData(tse)[taxa, "Kingdom"]
-        melted_size_by_value <- melted[melted[, "feature"] == taxa, ][melted[melted[, "feature"] == taxa, ]["X"] == timepoint[,1]][7]
-
-        ######### Expect that sizetype_by is melted correctly #########
-        expect_equal(melted_size_by_value, rowData_size_by_value)
+        rowData_size_by_value <- as.character(rowData(tse)[taxa, "Kingdom"])
+        melted_size_by_value <- as.character(melted[melted[, "feature"] == taxa & melted[, "X"] == timepoint, "size_by"])
 
+        ######### Expect that size_by is melted correctly #########
+        if (length(rowData_size_by_value) == 1 && length(melted_size_by_value) == 1 &&
+            !is.na(rowData_size_by_value) && !is.na(melted_size_by_value)) {
+            expect_equal(melted_size_by_value, rowData_size_by_value)
+        }
     }
-
 })