In RGLab/HIPCCyto: HIPC Cytometry

knitr::opts_chunk$set(echo = FALSE, message = FALSE)

library(HIPCCyto)
library(flowWorkspace)
library(ggcyto)
library(plotly)
library(htmltools)
library(htmlwidgets)
library(reactable)
library(bsplus)
library(crosstalk)

gs_dir <- params$gs_dir
gs <- load_gs(file.path(params$gs_dir, "gs"))
pd <- pData(gs)
visible <- "hidden"
to_impute <- is.null(pd$imputed)
if (isTRUE(to_impute)) {
  outliers <- HIPCCyto:::find_outliers(gs)
  pd$outlier <- pd$name %in% outliers
  pData(gs) <- pd
  visible <- "visible"
}
s <- jsonlite::fromJSON(file.path(params$gs_dir, "summary"))

---

title: r paste(s$study_accession, s$gs_accession)

Summary

Column

Summary

reactable(
  data.frame(
    "HIPCCyto version" = s$version,
    "ImmPort Data Release" = s$data_release,
    "Number of Samples" = length(gs),
    "Number of Markers" = length(markernames(gs)),
    "Number of Participants" = length(unique(pd$participant_id)),
    check.names = FALSE
  ),
  sortable = FALSE,
  columns = list(
    "HIPCCyto version" = colDef(
      cell = function(value) {
        url <- paste0("https://github.com/RGLab/HIPCCyto/commit/", s$commit_hash)
        tags$a(href = url, target = "_blank", value)
      }
    )
  )
)

Gating Hierarchy

flowWorkspace::plot(gs)

Panel

m <- markernames(gs)
reactable(
  data = data.frame(Channel = names(m), Marker =  m, row.names = NULL),
  sortable = FALSE
)

Column {.tabset}

Study info

ImmPortR:::query(sprintf("study/summary/%s", s$study))

Tables

reactable(
  data = as.data.frame(table(pd$type)),
  pagination = FALSE,
  sortable = FALSE,
  columns = list(Var1 = colDef(name = c("Sample type")))
)

reactable(
  data = as.data.frame(table(paste(pd$study_time_collected, pd$study_time_collected_unit))),
  pagination = FALSE,
  sortable = FALSE,
  columns = list(Var1 = colDef(name = c("Study time collected")))
)

reactable(
  data = as.data.frame(table(pd$cohort)),
  pagination = FALSE,
  sortable = FALSE,
  columns = list(Var1 = colDef(name = c("Cohort")))
)

if (is.null(pd$batch)) {
  tbl <- data.frame(Var1 = "", Freq = nrow(pd))
} else {
  tbl <- as.data.frame(table(pd$batch))
}
reactable(
  data = tbl,
  pagination = FALSE,
  sortable = FALSE,
  columns = list(Var1 = colDef(name = c("Batch")))
)

reactable(
  data = as.data.frame(table(pd$outlier)),
  pagination = FALSE,
  sortable = FALSE,
  columns = list(Var1 = colDef(name = c("Outliers")))
)

Custom processing parameters

custom_params <- HIPCCyto:::DATA[[s$study]]
if (isFALSE(to_impute)) {
  custom_params$imputed_lymphocyte_gates <- pd$name[as.logical(pd$imputed)]
}
custom_params

Gating

Column {.tabset}

Gating Hierarchy

flowWorkspace::plot(gs)
gates <- HIPCCyto:::get_nodes(gs)

Live gates

if ("Live" %in% gates) {
  suppressWarnings(p <- HIPCCyto:::qc_gates(gs, "Live"))
  ggplotly(p) %>%
    onRender("
      function(el) {
        el.on('plotly_click', function(d) { 
          txt = d.points[0].text.split('<br />');
          console.log(txt);
          i = txt[txt.length - 1].trim();
          id = txt.filter(v => /sample/.test(v))[0].replace('sample: ', '');
          id = id.substring(0, id.search('.fcs')+4).trim();
          console.log(id);
          $('.dropdown-menu li.active').removeClass('active');
          $('.dropdown-tab').parent('li').eq(i-1).addClass('active');
          $('#samples div.active').removeClass('active');
          $('#' + CSS.escape(id)).addClass('active');
          window.open('#by-sample', '_self');
          check_box(id);
        });
      } 
    ")
} else {
  print("no Live gates")
}

Non-debris gates

if ("Nondebris" %in% gates) {
  suppressWarnings(p <- HIPCCyto:::qc_gates(gs, "Nondebris"))
  ggplotly(p) %>%
    onRender("
      function(el) {
        el.on('plotly_click', function(d) { 
          txt = d.points[0].text.split('<br />');
          console.log(txt);
          i = txt[txt.length - 1].trim();
          id = txt.filter(v => /sample/.test(v))[0].replace('sample: ', '');
          id = id.substring(0, id.search('.fcs')+4).trim();
          console.log(id);
          $('.dropdown-menu li.active').removeClass('active');
          $('.dropdown-tab').parent('li').eq(i-1).addClass('active');
          $('#samples div.active').removeClass('active');
          $('#' + CSS.escape(id)).addClass('active');
          window.open('#by-sample', '_self');
          check_box(id);
        });
      } 
    ")
} else {
  print("no Nondebris gates")
}

Lymphocytes gates

if ("Lymphocytes" %in% gates) {
suppressWarnings(p <- HIPCCyto:::qc_gates(gs, "Lymphocytes"))
ggplotly(p) %>%
  onRender("
    function(el) {
      el.on('plotly_click', function(d) {
        txt = d.points[0].data.text.split('<br />');
        console.log(txt);
        i = txt[txt.length - 1].trim();
        id = txt.filter(v => /sample/.test(v))[0].replace('sample: ', '');
        id = id.substring(0, id.search('.fcs')+4).trim();
        console.log(id);
        $('.dropdown-menu li.active').removeClass('active');
        $('.dropdown-tab').parent('li').eq(i-1).addClass('active');
        $('#samples div.active').removeClass('active');
        $('#' + CSS.escape(id)).addClass('active');
        window.open('#by-sample', '_self');
        check_box(id);
      });
    } 
  ")
} else {
  print("no Lymphocytes gates")
}

By sample {data-orientation=rows}

Row {data-height=15}

sample_names <- sampleNames(gs)
plotInfo <- lapply(
  seq_along(sample_names),
  function(i) {
    gate_file <- file.path(params$gs_dir, sprintf("gates/%s.png", sample_names[i]))
    spillover_file <- file.path(params$gs_dir, sprintf("spillover/%s.png", sample_names[i]))
    list(
      name = sample_names[i],
      i = i,
      gates = HIPCCyto:::encode_img(gate_file),
      spillover = HIPCCyto:::encode_img(spillover_file),
      pdata = pd[i, ]
    )
  })

Select Sample

wzxhzdk:18

Previous sample Next sample

Row

wzxhzdk:19

Marker expression

Column {.tabset}

After lymphocyte gate

img(
  src = HIPCCyto:::encode_img(file.path(params$gs_dir, "markers.png")),
  style = "height: 100%; width: 100%; object-fit: contain"
)

Sample metadata

body <- div(
  div(
    span(id = "n-selected", ""),
    span("samples selected for lymphocyte gate imputation.")
  ),
  pre(code(id = "impute"), style = "height: 500px")
)
bs_modal(
  id = "modal", title = "Lymphocyte gate imputation code", body = body, 
  footer = list(
    bs_button("Copy", onclick = "copy_code()"),
    bs_modal_closebutton("Close")
  )
)
bs <- bs_button("Make imputation code", onclick = "create_code()") %>%
  bs_attach_modal(id_modal = "modal")
bs$attribs$class <- ""
bs

data <- SharedData$new(pd)
if (isTRUE(to_impute)) {
  selection <- "multiple"
  defaultSelected <- which(pd$outlier)
} else {
  selection <- defaultSelected <- NULL
}
reactable(
  data = data,
  selection = selection,
  defaultSelected = defaultSelected,
  pagination = FALSE,
  onClick = JS("
    function(rowInfo, colInfo) {
      console.log(rowInfo);
      i = rowInfo.index;
      id = rowInfo.original.name;
      $('.dropdown-menu li.active').removeClass('active');
      $('.dropdown-tab').parent('li').eq(i).addClass('active');
      $('#samples div.active').removeClass('active');
      $('#' + CSS.escape(id)).addClass('active');
      window.open('#by-sample', '_self');
      check_box(id);
    }
  ")
)

Session info

sessionInfo()

RGLab/HIPCCyto documentation built on Nov. 13, 2021, 10:19 p.m.