Add sample metadata tables to reports

templates/qc_report/celltypes_supplemental_report.rmd

@@ -381,6 +381,34 @@ glue::glue("
 ```
 
 
+# Sample metadata 
+
+The below table summarizes clinical metadata for the sample associated with this library. 
+Blue hyperlinks are present for any terms with an ontology term identifier associated with the displayed human readable value. 
+These links will direct you to a web page with information about that ontology term identifier.   
+
+```{r}
+# extract sce metadata containing processing information as table
+processed_meta <- metadata(processed_sce)
+
+# if data is not multiplexed, print out sample metadata
+if (!has_multiplex) {
+  print_sample_metadata(processed_meta)
+} else {
+  # otherwise print out an info box that no sample metadata will be displayed
+  knitr::asis_output(
+    glue::glue("
+      <div class=\"alert alert-info\">
+
+      This library is multiplexed and contains data from more than one sample.
+      Demultiplexing has not been performed, so sample metadata will not be displayed.
+      </div>
+    ")
+  )
+}
+```
+
+
 <!------- Call the celltypes_qc report section from the main report ----------->
 ```{r, child='celltypes_qc.rmd'}
 ```

templates/qc_report/main_qc_report.rmd

@@ -208,8 +208,7 @@ if ("cell line" %in% sample_types) {
 }
 ```
 
-
-# Processing Information for `r library_id`
+# Metadata and Processing Information for `r library_id`
 
 ```{r, eval = has_multiplex, results='asis'}
 # convert sample id to bullet separated list
@@ -226,13 +225,40 @@ glue::glue("
 ")
 ```
 
-## Raw Sample Metrics
+## Sample Metadata
+
+The below table summarizes clinical metadata for the sample associated with this library. 
+Blue hyperlinks are present for any terms with an ontology term identifier associated with the displayed human readable value. 
+These links will direct you to a web page with information about that ontology term identifier.  
+
+```{r}
+# extract sce metadata containing processing information as table
+unfiltered_meta <- metadata(unfiltered_sce)
+
+# if data is not multiplexed, print out sample metadata
+if (!has_multiplex) {
+  print_sample_metadata(unfiltered_meta)
+} else {
+  # otherwise print out an info box that no sample metadata will be displayed
+  knitr::asis_output(
+    glue::glue("
+      <div class=\"alert alert-info\">
+
+      This library is multiplexed and contains data from more than one sample.
+      Demultiplexing has not been performed, so sample metadata will not be displayed.
+      </div>
+    ")
+  )
+}
+```
+
+## Raw Library Metrics
 
 ```{r }
 # extract sce metadata containing processing information as table
 unfiltered_meta <- metadata(unfiltered_sce)
 
-sample_information <- tibble::tibble(
+library_information <- tibble::tibble(
   "Library id" = library_id,
   "Sample id" = paste(sample_id, collapse = ", "),
   "Tech version" = format(unfiltered_meta$tech_version), # format to keep nulls
@@ -251,7 +277,7 @@ if (has_adt) {
   adt_exp <- altExp(filtered_sce, "adt") # must be filtered_sce in case has_processed is FALSE
   adt_meta <- metadata(adt_exp)
 
-  sample_information <- sample_information |>
+  library_information <- library_information |>
     mutate(
       "Number of antibodies assayed" =
         format(nrow(adt_exp), big.mark = ",", scientific = FALSE),
@@ -266,7 +292,7 @@ if (has_cellhash) {
   multiplex_exp <- altExp(filtered_sce, "cellhash")
   multiplex_meta <- metadata(multiplex_exp)
 
-  sample_information <- sample_information |>
+  library_information <- library_information |>
     mutate(
       "Number of HTOs assayed" =
         format(nrow(multiplex_exp), big.mark = ",", scientific = FALSE),
@@ -277,12 +303,12 @@ if (has_cellhash) {
     )
 }
 
-sample_information <- sample_information |>
+library_information <- library_information |>
   reformat_nulls() |>
   t()
 
 # make table with sample information
-knitr::kable(sample_information, align = "r") |>
+knitr::kable(library_information, align = "r") |>
   kableExtra::kable_styling(
     bootstrap_options = "striped",
     full_width = FALSE,

templates/qc_report/utils/report_functions.rmd

@@ -26,3 +26,84 @@ determine_umap_point_size <- function(n_processed_cells) {
   return(c(umap_point_size, umap_facet_point_size))
 }
 ```
+
+```{r}
+#' Print table with sample metadata
+#'
+#' @param meta_list List of metadata from SCE object.
+#'   Must contain `sample_metadata`.
+#'
+#' @return table with sample metadata
+
+print_sample_metadata <- function(meta_list) {
+  # get sample metadata as a data frame
+  sample_metadata <- meta_list$sample_metadata
+
+  # only print table if sample metadata is present
+  if (!is.null(sample_metadata)) {
+    # build urls using ontology terms
+    # first create a tibble with term, human readable value, and ontology ID
+    ontology_link_df <- tibble::tribble(
+      ~term, ~hr_value, ~ontology_term_id,
+      "age", as.character(sample_metadata$age), sample_metadata$development_stage_ontology_term_id,
+      "sex", sample_metadata$sex, sample_metadata$sex_ontology_term_id,
+      "organism", sample_metadata$organism, sample_metadata$organism_ontology_id,
+      "diagnosis", sample_metadata$diagnosis, sample_metadata$disease_ontology_term_id,
+      "tissue_location", sample_metadata$tissue_location, sample_metadata$tissue_ontology_term_id
+    ) |>
+      dplyr::mutate(
+        # replace ID with _ to construct url
+        ontology_term_id = stringr::str_replace(ontology_term_id, ":", "_"),
+        # build url
+        url = glue::glue("http://purl.obolibrary.org/obo/{ontology_term_id}"),
+        # format linked url with hr value for table
+        # if NA term ID, don't link
+        url = dplyr::if_else(
+          is.na(ontology_term_id),
+          kableExtra::text_spec(hr_value, "html"),
+          kableExtra::text_spec(hr_value, "html", link = url)
+        )
+      )
+
+    # create a named list of urls to use for easy table building
+    url_list <- as.list(ontology_link_df$url) |>
+      purrr::set_names(ontology_link_df$term)
+
+    # construct table to print
+    # fill in with sample metadata information for non ontology IDs and use urls for all ontology IDs
+    table <- tibble::tibble(
+      "Sample ID" = sample_metadata$sample_id,
+      "Diagnosis" = url_list$diagnosis,
+      "Subdiagnosis" = sample_metadata$subdiagnosis,
+      "Tissue location" = url_list$tissue_location,
+      "Disease timing" = sample_metadata$disease_timing,
+      "Age" = url_list$age,
+      "Sex" = url_list$sex,
+      "Organism" = url_list$organism,
+      "Sample type" = meta_list$sample_type
+    ) |>
+      t() |>
+      # account for html links
+      knitr::kable(format = "html", escape = FALSE, align = "r") |>
+      kableExtra::kable_styling(
+        bootstrap_options = "striped",
+        full_width = FALSE,
+        position = "left"
+      ) |>
+      kableExtra::column_spec(2, monospace = TRUE)
+
+    return(table)
+  } else {
+    # if no sample metadata, print out a message
+    knitr::asis_output(
+      glue::glue("
+    <div class=\"alert alert-info\">
+
+    No sample metadata is available for this library.
+
+    </div>
+  ")
+    )
+  }
+}
+```