Merge pull request #3 from Kevin-Haigis-Lab/metadata

Add a metadata attribute to the tissue slide
Kevin-Haigis-Lab · Feb 27, 2021 · 2752723 · 2752723
2 parents 04e0d9d + 61689e4
commit 2752723
Show file tree

Hide file tree

Showing 37 changed files with 601 additions and 37 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: PackageBluishgreen
 Title: Classify cells by fluorescence
-Version: 0.1.0
+Version: 0.1.1
 Authors@R: 
     person(given = "Joshua",
            family = "Cook",
@@ -25,5 +25,6 @@ Imports:
     ggplot2,
     tibble,
     rlang,
-    tidyr
+    tidyr,
+    digest
 Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
@@ -2,10 +2,12 @@
 
 export(cluster_manually)
 export(get_manual_classification)
+export(get_slide_metadata)
 export(manual_classification)
 export(plot_density)
 export(plot_slide_clusters)
 export(plot_tissue)
+export(set_slide_metadata)
 export(summarize_cluster_results)
 export(tissue_slide)
 import(ggplot2)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# PackageBluishgreen 0.1.1
+
+- Add the ability to add metadata to a tissue slide object.
+
 # PackageBluishgreen 0.1.0
 
 - A basic feature set has been created, documented, and tested.

diff --git a/R/tissue_slide.R b/R/tissue_slide.R
@@ -3,22 +3,24 @@
 #' An S3 class to hold the information for an individual slide.
 #'
 #' @param slide_data The data from the slide.
+#' @param metadata Additional metadata as a list with arbitrary structure and values.
 #'
 #' @return A \code{tissue_slide} object that is a subclass of a tibble.
 #'
 #' @examples
 #' pancreas_slide <- tissue_slide(pancreas)
 #' @export tissue_slide
-tissue_slide <- function(slide_data) {
-  new_tissue_slide(slide_data)
+tissue_slide <- function(slide_data, metadata = list()) {
+  new_tissue_slide(slide_data, metadata = metadata)
 }
 
 
-new_tissue_slide <- function(data = tibble::tibble()) {
+new_tissue_slide <- function(data = tibble::tibble(), metadata = list()) {
   stopifnot(inherits(data, "data.frame"))
   structure(
     data,
     manual_class = manual_classification(),
+    metadata = metadata,
     class = c("tissue_slide", class(tibble::tibble()))
   )
 }
@@ -27,8 +29,13 @@ new_tissue_slide <- function(data = tibble::tibble()) {
 validate_tissue_slide <- function(ts) {
   stopifnot(inherits(ts, "tissue_slide"))
   stopifnot(inherits(ts, "data.frame"))
+
   assertr::verify(ts, assertr::has_all_names("x", "y"))
 
+  stopifnot("metadata" %in% names(attributes(ts)))
+  stopifnot(is.list(attr(ts, "metadata")))
+
+  stopifnot("manual_class" %in% names(attributes(ts)))
   stopifnot(inherits(attr(ts, "manual_class"), "manual_classification"))
 
   return(TRUE)
@@ -66,3 +73,42 @@ set_manual_classification <- function(ts, manual_class) {
   validate_tissue_slide(ts)
   return(ts)
 }
+
+
+#' Get metadata from a tissue slide.
+#'
+#' Extract the metadata stored with a tissue slide object. To set the metadata, use the function \code{set_slide_metadata()}.
+#'
+#' @param ts A Tissue slide object.
+#'
+#' @return The metadata object associated with the slide.
+#'
+#' @examples
+#' slide <- tissue_slide(pancreas, metadata = list(tissue = "pancreas", mouse = "OP24"))
+#' get_slide_metadata(slide)
+#' @export get_slide_metadata
+get_slide_metadata <- function(ts) {
+  validate_tissue_slide(ts)
+  return(attr(ts, "metadata"))
+}
+
+
+#' Set metadata from a tissue slide.
+#'
+#' Write the metadata stored with a tissue slide object. To get the metadata, use the function \code{get_slide_metadata()}.
+#'
+#' @param ts A Tissue slide object.
+#' @param metadata Metadata of arbitrary structure.
+#'
+#' @return Returns the tissue slide object with the metadata.
+#'
+#' @examples
+#' slide <- tissue_slide(pancreas, metadata = list(tissue = "pancreas", mouse = "OP24"))
+#' slide <- set_slide_metadata(slide, list(tissue = "not pancreas", mouse = "Mickey"))
+#' get_slide_metadata(slide)
+#' @export set_slide_metadata
+set_slide_metadata <- function(ts, metadata) {
+  validate_tissue_slide(ts)
+  attr(ts, "metadata") <- metadata
+  return(ts)
+}
diff --git a/README.Rmd b/README.Rmd
@@ -15,6 +15,8 @@ knitr::opts_chunk$set(
 
 library(dplyr)
 library(ggplot2)
+
+set.seed(0)
 ```
 
 # PackageBluishgreen
@@ -71,6 +73,14 @@ head(lung_data)
 lung_slide <- tissue_slide(lung_data)
 ```
 
+The slide can store metadata, too.
+It can be added to the slide when it is instantiated with `tissue_slide()` using the `metadata` parameter or can be added to an existing tissue slide object using `set_slide_metadata()`
+
+```{r}
+lung_slide <- set_slide_metadata(lung_slide, list(tissue = "lung", mouse = "OP24"))
+get_slide_metadata(lung_slide)
+```
+
 ```{r}
 plot_tissue(lung_slide, color = log10(fitc))
 ```

diff --git a/README.md b/README.md
@@ -71,24 +71,39 @@ head(lung_data)
 lung_slide <- tissue_slide(lung_data)
 ```
 
+The slide can store metadata, too. It can be added to the slide when it
+is instantiated with `tissue_slide()` using the `metadata` parameter or
+can be added to an existing tissue slide object using
+`set_slide_metadata()`
+
+``` r
+lung_slide <- set_slide_metadata(lung_slide, list(tissue = "lung", mouse = "OP24"))
+get_slide_metadata(lung_slide)
+#> $tissue
+#> [1] "lung"
+#> 
+#> $mouse
+#> [1] "OP24"
+```
+
 ``` r
 plot_tissue(lung_slide, color = log10(fitc))
 ```
 
-<img src="man/figures/README-unnamed-chunk-3-1.png" width="100%" />
+<img src="man/figures/README-unnamed-chunk-4-1.png" width="100%" />
 
 ``` r
 plot_density(lung_slide, value = fitc)
 ```
 
-<img src="man/figures/README-unnamed-chunk-4-1.png" width="100%" />
+<img src="man/figures/README-unnamed-chunk-5-1.png" width="100%" />
 
 ``` r
 lung_slide <- cluster_manually(lung_slide, fitc, cutoff = 4, transform = log10)
 plot_slide_clusters(lung_slide)
 ```
 
-<img src="man/figures/README-unnamed-chunk-5-1.png" width="100%" />
+<img src="man/figures/README-unnamed-chunk-6-1.png" width="100%" />
 
 ``` r
 summarize_cluster_results(lung_slide)

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -30,6 +30,8 @@ reference:
     and applied classification methods.
   contents:
   - tissue_slide
+  - set_slide_metadata
+  - get_slide_metadata
 
 - title: Classification
   desc: >

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE.html b/docs/LICENSE.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -2,5 +2,5 @@ pandoc: 2.11.4
 pkgdown: 1.6.1
 pkgdown_sha: ~
 articles: {}
-last_built: 2021-02-26T15:37Z
+last_built: 2021-02-27T15:37Z
 
diff --git a/docs/reference/cluster_manually.html b/docs/reference/cluster_manually.html
diff --git a/docs/reference/figures/README-unnamed-chunk-4-1.png b/docs/reference/figures/README-unnamed-chunk-4-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-5-1.png b/docs/reference/figures/README-unnamed-chunk-5-1.png
diff --git a/docs/reference/figures/README-unnamed-chunk-6-1.png b/docs/reference/figures/README-unnamed-chunk-6-1.png
diff --git a/docs/reference/get_manual_classification.html b/docs/reference/get_manual_classification.html