Week09 lk

Announcements.qmd

@@ -34,4 +34,6 @@ For previous course announcements emails, see the links below.
 
 - April 12, 2026 [Cytometry in R - Week # 09 - It's Raining Functions!](https://github.com/UMGCCCFCSR/CytometryInR/discussions/162) 
 
+- April 21, 2026 [No Class This Week](https://github.com/UMGCCCFCSR/CytometryInR/discussions/174)
+
 ![](images/YouTubeHex.png)

README.md

@@ -4,7 +4,7 @@ Cytometry in R is a free virtual mini-course being organized by the [Flow Cytome
 
 We are excited that so many individuals worldwide have chosen to take part, and we look forward to helping you get started on your own learning journeys. 
 
-![](/images/WorldwideSignups.png){width=100%}
+![](/images/WorldwideSignups.png){width="100%"}
 
 Click here to go to our [Course Website](https://umgcccfcsr.github.io/CytometryInR)
 

Schedule.qmd

@@ -117,7 +117,7 @@ No class week of March 30, 2026. If you are attending the [ABRF conference](http
 
 ![](https://images2.minutemediacdn.com/image/upload/c_fill,w_720,ar_16:9,f_auto,q_auto,g_auto/shape/cover/sport/raining-monkeys-e3fa8001e4eb47433b1cc58e2017d2b8.png){width=75%}
 
-[**Week 9: April 13, 2026**]{.underline} In the course of this ninth session, we tackle one of the harder but most useful concepts to learn for a beginner, namely [functions](https://r4ds.had.co.nz/functions.html). We explore what they are, how their individual arguments work, how they differ from for-loops, and how to create our own to do useful work, reduce the number times code gets copied and pasted. Additionally, some functional programming best practices will be introduced, as well as provide introduction to how to use the walk and map functions from the [purrr](https://purrr.tidyverse.org/) package. 
+[**Week 9: April 13, 2026**]{.underline} In the course of this [ninth](/course/09_Functions/index.qmd) session, we tackle one of the harder but most useful concepts to learn for a beginner, namely [functions](https://r4ds.had.co.nz/functions.html). We explore what they are, how their individual arguments work, how they differ from for-loops, and how to create our own to do useful work, reduce the number times code gets copied and pasted. Additionally, some functional programming best practices will be introduced, as well as provide introduction to how to use the walk and map functions from the [purrr](https://purrr.tidyverse.org/) package. 
 
 <br>
 <br>
@@ -126,7 +126,7 @@ No class week of March 30, 2026. If you are attending the [ABRF conference](http
 
 ![](https://www.ibm.com/content/dam/connectedassets-adobe-cms/worldwide-content/creative-assets/s-migr/ul/g/7d/10/downsampling-near-miss-v3.png){width=50%}
 
-[**Week 10: April 20, 2026**]{.underline} Within this session, we will expand on our growing understanding of GatingSets, functions and fcs file internals to write a script to downsample your fcs files to a desired number (or percentage) of cells for a given cell population. We will additionally learn how to concatenate these downsampled files together, and save them to a new .fcs file in ways that the metadata can be read by commercial software without the scaling being widely thrown off.  
+[**Week 10: April 20, 2026**]{.underline} Within this [tenth](/course/10_Downsampling/index.qmd) session, we will expand on our growing understanding of GatingSets, functions and fcs file internals to write a function to downsample your fcs files to a desired number (or percentage) of cells for a given cell population. We will additionally learn how to concatenate these downsampled files together, and save them to a new .fcs file in ways that the metadata can be read by commercial software without the scaling being widely thrown off.  
 
 <br>
 <br>

_quarto.yml

@@ -20,6 +20,7 @@ project:
     - 07_*   
     - 08_* 
     - 09_*
+    - 10_*
 website:
   google-analytics: "G-LZ35J3XE4D"
   announcement: 
@@ -96,7 +97,9 @@ website:
       - text: "09 - It's Raining Functions!"
         href: course/09_Functions/index.qmd 
     - section: "Cytometry Core"
-      href: Schedule.qmd
+      contents:
+      - text: "10 - Downsampling and Concatenation"
+        href: course/10_Downsampling/index.qmd
     - section: "Beyond the Sandbox"
       href: Schedule.qmd
     - section: "The World is your Oyster"

course/09_Functions/homeworks/lkisselbach-afk1/TakeHomeProblems_Wk09_LK.qmd

@@ -0,0 +1,31 @@
+---
+title: "Take Home Problems Week 09 - LK"
+format: pdf
+---
+# Problem 1
+
+Modify one of the simpler functions (SecondFunction or similar), provide your own argument names, and modify the message(), paste0 or print() functions to print a text style output. Generate a small vector of values, and iterate through your vector using one of the approaches we used.
+
+# Answer 1
+
+![Alt text](images/Screenshot01.png)
+
+![Alt text](images/Screenshot02.png)
+
+# Problem 2
+
+Using the initial framework for the CellConcentration function, retrieve several other keywords that are of interest, and incorporate them into the returned data.frame row.
+
+# Answer 2
+
+I calculated the total acquisition time in minutes, although I used Claude AI to help work through some of this code.
+
+![Alt text](images/Screenshot03.png)
+
+# Problem 3
+
+For CellConcentration, we retrieved both start and end time. Look up information on lubridate package, convert these times to a time-style format, and from acquired volume derive uL/min at which each .fcs file was acquired. Did this vary at all across days?
+
+The acquisition time was very consistent across all days.
+
+![Alt text](images/Screenshot04.png)

course/10_Downsampling/R/Concatenate.R

@@ -0,0 +1,206 @@
+#' Concatenate Internal
+#' 
+#' @param x TBD
+#' @param y TBD
+#' @param metadata TBD
+#' 
+#' @importFrom dplyr filter bind_cols
+#' 
+KeywordAppend <- function(x, y, metadata) {
+  df <- y
+  rownames(metadata) <- NULL
+  AddThisRow <- metadata |> filter(name %in% x)
+  ExpandedData <- bind_cols(df, AddThisRow)
+  return(ExpandedData)
+}
+
+#' Concatenate Internal
+#' 
+#' @param DictionaryList TBD
+#' @param data TBD
+#' 
+#' @importFrom dplyr left_join select rename
+#' @importFrom tidyselect all_of
+#' @importFrom rlang sym
+#' 
+KeywordTranslate <- function(DictionaryList, data) {
+
+  for (Entry in DictionaryList) {
+    ColumnName <- names(Entry)[1] 
+    KeyName <- names(Entry)[2]
+
+    data <- data |> dplyr::left_join(Entry, by = ColumnName) |>
+      dplyr::select(-tidyselect::all_of(ColumnName)) |> dplyr::rename(!!ColumnName := !!rlang::sym(KeyName))
+  }
+
+  return(data)
+}
+
+#' Concatenate Internal
+#' 
+#' @param x TBD
+#' @param data TBD
+#' 
+#' @importFrom dplyr select pull
+#' @importFrom tidyselect all_of
+#' @importFrom tibble tibble
+#' 
+#' 
+ColumnToKeyword <- function(x, data){
+  IndividualColumn <- data |> dplyr::select(tidyselect::all_of(x))
+
+  if(!is.numeric(IndividualColumn)){ # Is not numeric
+    Values <- IndividualColumn |> dplyr::pull(x) |> unique()
+
+    Dictionary <- tibble::tibble(Values = Values, Values_Key = seq(1000, by = 1000, length.out = length(Values)))
+    colnames(Dictionary) <- gsub("Values", x, colnames(Dictionary))
+    return(Dictionary)
+  } else { # Is numeric already
+    Values <- IndividualColumn |> dplyr::pull(x) |> unique()
+    Dictionary <- tibble::tibble(Values = Values, Values_Key = Values)
+    colnames(Dictionary) <- gsub("Values", x, colnames(Dictionary))
+    return(Dictionary)
+  }
+}
+
+#' Concatenate Internal
+#' 
+#' @param flowFrame TBD
+#' @param NewColumns TBD
+#' 
+#' @importFrom flowCore pData parameters
+#' 
+ParameterUpdate <- function(flowFrame, NewColumns){
+	NewColumnLength <- ncol(NewColumns)
+	NewColumnNames <- colnames(NewColumns)
+	OldParameters <- pData(parameters(flowFrame))
+	NewParameter <- max(as.integer(gsub("\\$P", "", rownames(OldParameters)))) + 1
+	NewParameter <- seq(NewParameter, length.out = NewColumnLength)
+	NewParameter <- paste0("$P", NewParameter)
+
+	UpdatedParameters <- do.call(rbind, lapply(NewColumnNames, function(i){
+						vec <- NewColumns[,i]
+						rg <- range(vec)
+						data.frame(name = i, desc = NA, range = diff(rg) + 1, minRange = rg[1], maxRange = rg[2])
+					}))
+	rownames(UpdatedParameters) <- NewParameter
+	return(UpdatedParameters)
+}
+
+#' Concatenates together .fcs files present in the GatingSet on the
+#'  basis of a given gate
+#' 
+#' @param gs A GatingSet object
+#' @param subset The gate from which to retrieve cell counts from 
+#' @param inverse.transform Whether to revert values back to their
+#' original untransformed values before export as an .fcs file, default
+#' is set to TRUE
+#' @param DownsampleCount The desired number of cells to downsample from
+#' each gated population. If value is less than 1, subsets out the 
+#' equivalent proportion from that specimen
+#' @param addon An additional character value to add before .fcs in the GUID
+#' keyword to tell the downsampled file apart from the original. 
+#' @param StorageLocation A file.path to the folder you want to store the new downsampled
+#' fcs file to. Default NULL results in .fcs file being stored in current working directory
+#' @param returnType Whether to return as a "fcs" file (default), or "flowFrame" or "data.frame"
+#' @param desiredCols A vector containing the names of the columns from the pData metadata
+#' that need to be added as keywords to the concatenated .fcs file. 
+#' @param specimenIndex Which specimen in the GatingSet to use as the metadata
+#' framework for the new fcs file. Default is set to 1. 
+#' @param filename Desired name for the concatenated file, default is MyConcatenatedFCS
+#' 
+#' @importFrom flowCore pData parameters keyword exprs write.FCS
+#' @importFrom flowWorkspace gs_pop_get_data
+#' @importFrom dplyr select bind_rows
+#' @importFrom tidyselect all_of
+#' @importFrom purrr map map2 flatten
+#' 
+Concatenate <- function(gs, subset, inverse.transform=TRUE, DownsampleCount,
+  addon, StorageLocation=NULL, returnType="flowFrame", desiredCols,
+  specimenIndex=1, filename="MyConcatenatedFCS"){
+
+  Metadata <- flowCore::pData(gs)
+  DesiredMetadata <- Metadata |> dplyr::select(tidyselect::all_of(desiredCols))
+
+  dataFrameList <- purrr::map(.x=gs, subset=subset, .f=Downsampling,
+   DownsampleCount=DownsampleCount, addon=addon, returnType="data.frame",
+  inverse.transform=inverse.transform, StorageLocation=StorageLocation)
+
+  TheFileNames <- DesiredMetadata |> dplyr::pull(name)
+
+  ExpandedDataframes <- purrr::map2(.x=TheFileNames, .y=dataFrameList,
+   .f=KeywordAppend, metadata=DesiredMetadata)
+
+  CombinedData <- dplyr::bind_rows(ExpandedDataframes)
+
+  NewData <- CombinedData |> dplyr::select(tidyselect::all_of(desiredCols))
+  OldData <- CombinedData |> dplyr::select(!tidyselect::all_of(desiredCols))
+
+  Dictionaries <- purrr::map(.x=desiredCols, .f=ColumnToKeyword, data=NewData)
+
+  EventsInTheGate <- flowWorkspace::gs_pop_get_data(gs[[specimenIndex]], subset,
+   inverse.transform=inverse.transform)
+  flowFrame <- EventsInTheGate[[1, returnType = "flowFrame"]]
+  OriginalParameters <- flowCore::parameters(flowFrame)
+  OriginalDescription <- flowCore::keyword(flowFrame)
+
+  NewKeywords <- purrr::flatten(Dictionaries)
+  NewDescriptions <- c(OriginalDescription, NewKeywords)
+
+  TranslatedNewData <- KeywordTranslate(data=NewData, DictionaryList=Dictionaries)
+
+  NewDataMatrix <- as.matrix(TranslatedNewData)
+  OldDataMatrix <- as.matrix(OldData)
+
+  new_fcs <- new("flowFrame", exprs=OldDataMatrix, parameters=OriginalParameters,
+                 description=NewDescriptions)
+
+  NewParameters <- ParameterUpdate(flowFrame=new_fcs, NewColumns=NewDataMatrix)
+
+  pd <- pData(parameters(new_fcs))
+  pd <- rbind(pd, NewParameters)
+  new_fcs@exprs <- cbind(exprs(new_fcs), NewDataMatrix)
+  pData(parameters(new_fcs)) <- pd
+  new_pid <- rownames(pd)
+  new_kw <- new_fcs@description
+
+  for (i in new_pid){
+    new_kw[paste0(i,"B")] <- new_kw["$P1B"] #Unclear Purpose
+    new_kw[paste0(i,"E")] <- "0,0"
+    new_kw[paste0(i,"N")] <- pd[[i,1]]
+    #new_kw[paste0(i,"V")] <- new_kw["$P1V"] # Extra Unclear Purpose
+    new_kw[paste0(i,"R")] <- pd[[i,5]]
+    new_kw[paste0(i,"DISPLAY")] <- "LIN"
+    new_kw[paste0(i,"TYPE")] <- "Identity"
+    new_kw[paste0("flowCore_", i,"Rmax")] <- pd[[i,5]]
+    new_kw[paste0("flowCore_", i,"Rmin")] <- pd[[i,4]]
+  }
+
+  UpdatedParameters <- parameters(new_fcs)
+  UpdatedExprs <- exprs(new_fcs)
+
+  UpdatedFCS <- new("flowFrame", exprs=UpdatedExprs, parameters=UpdatedParameters, description=new_kw)
+
+  AssembledName <- paste0(filename, ".fcs")
+  UpdatedFCS@description$GUID <- AssembledName
+  UpdatedFCS@description$`$FIL` <- AssembledName 
+  #UpdatedFCS@description$CREATOR <- "CytometryInR_2026"
+  #UpdatedFCS@description$GROUPNAME <- filename
+  #UpdatedFCS@description$TUBENAME <- filename
+  #UpdatedFCS@description$USERSETTINGNAME <- filename
+  #Date <- Sys.time()
+  #Date <- as.Date(Date)
+  #UpdatedFCS@description$`$DATE` <- Date
+
+  if (is.null(StorageLocation)){StorageLocation <- getwd()}
+
+  StoreFCSFileHere <- file.path(StorageLocation, AssembledName)
+
+  if (returnType == "fcs"){
+    flowCore::write.FCS(UpdatedFCS, filename = StoreFCSFileHere, delimiter="#") # Write out .fcs file
+  } else if (returnType == "data.frame"){
+    return(Downsampled_DataFrame) #Return data.frame without metadata
+  } else {
+    return(UpdatedFCS) #All other criterias return a flowFrame with metadata
+    }
+}

course/10_Downsampling/R/Downsampling.R

@@ -0,0 +1,66 @@
+#' This function downsamples from a designated gate to our desired number
+#' of cells, returning as a new .fcs file
+#' 
+#' @param x A GatingSet object, typically iterated in.
+#' @param subset The gate from which to retrieve cell counts from 
+#' @param inverse.transform Whether to revert values back to their
+#' original untransformed values before export as an .fcs file, default
+#' is set to TRUE
+#' @param DownsampleCount The desired number of cells to downsample from
+#' each gated population. If value is less than 1, subsets out the 
+#' equivalent proportion from that specimen
+#' @param addon An additional character value to add before .fcs in the GUID
+#' keyword to tell the downsampled file apart from the original. 
+#' @param StorageLocation A file.path to the folder you want to store the new downsampled
+#' fcs file to. Default NULL results in .fcs file being stored in current working directory
+#' @param returnType Whether to return as a "fcs" file (default), or "flowFrame" or "data.frame"
+#' 
+#' @importFrom flowWorkspace gs_pop_get_data
+#' @importFrom flowCore parameters keyword write.FCS
+#' @importFrom Biobase exprs
+#' @importFrom dplyr slice_sample
+#'  
+#' 
+Downsampling <- function(x, subset, inverse.transform=TRUE, DownsampleCount,
+  addon, StorageLocation=NULL, returnType="fcs"){
+  EventsInTheGate <- flowWorkspace::gs_pop_get_data(x, subset,
+   inverse.transform=inverse.transform)
+  MeasurementData <- Biobase::exprs(EventsInTheGate[[1]])
+  MeasurementDataFramed <- as.data.frame(MeasurementData, check.names = FALSE)
+
+  if (DownsampleCount < 1) {
+      Count <- nrow(EventsInTheGate) # Original Count
+      Count <- as.numeric(Count) #Sanity Check on Value Type
+      Count <- Count*DownsampleCount # Target Cells
+      Count <- round(Count, 0)
+      DownsampleCount <- Count # Over-writting DownsampleCount used for downsampling
+    }
+
+  Downsampled_DataFrame <- dplyr::slice_sample(MeasurementDataFramed, n = DownsampleCount, replace = FALSE)
+
+  DownsampledMatrix <- as.matrix(Downsampled_DataFrame)
+
+  flowFrame <- EventsInTheGate[[1, returnType = "flowFrame"]]
+  OriginalParameters <- flowCore::parameters(flowFrame)
+  OriginalDescription <- flowCore::keyword(flowFrame)
+
+  OriginalName <- OriginalDescription$`GUID`
+  UpdatedName <- paste0("_", addon, ".fcs")
+  UpdatedGUID <- sub(".fcs", UpdatedName, OriginalName) #Swtiching out .fcs for Updated Name via the sub function
+  OriginalDescription$`GUID` <- UpdatedGUID
+
+  NewFCS <- new("flowFrame", exprs=DownsampledMatrix, parameters=OriginalParameters, description=OriginalDescription)
+
+  if (is.null(StorageLocation)){StorageLocation <- getwd()}
+
+  StoreFCSFileHere <- file.path(StorageLocation, UpdatedGUID)
+
+  if (returnType == "fcs"){
+    flowCore::write.FCS(NewFCS, filename = StoreFCSFileHere, delimiter="#") # Write out .fcs file
+  } else if (returnType == "data.frame"){
+    return(Downsampled_DataFrame) #Return data.frame without metadata
+  } else {
+    return(NewFCS) #All other criterias return a flowFrame with metadata
+    }
+
+}

course/10_Downsampling/concatenate.qmd

@@ -0,0 +1,22 @@
+---
+title: "Walk-through: Concatenate"
+author: "David Rach"
+date: 04-28-2026
+format: html
+toc: true
+toc-depth: 5
+---
+
+![](/images/WebsiteBanner.png)
+
+::: {style="text-align: right;"}
+[![AGPL-3.0](https://img.shields.io/badge/license-AGPLv3-blue)](https://www.gnu.org/licenses/agpl-3.0.en.html) [![CC BY-SA 4.0](https://img.shields.io/badge/License-CC%20BY--SA%204.0-lightgrey.svg)](http://creativecommons.org/licenses/by-sa/4.0/)
+:::
+
+For the YouTube livestream schedule, see [here](https://www.youtube.com/@cytometryinr)
+
+For screen-shot slides, click [here](/course/10_Downsampling/slides.qmd)
+
+<br>
+
+---

course/10_Downsampling/data/Metadata.csv

@@ -0,0 +1,4 @@
+name,condition,infant_sex,HEU_status
+2025_07_26_AB_02-INF052-00_Ctrl_Unmixed__Tcells.fcs,Ctrl,Male,HEU-hi
+2025_07_26_AB_02-INF100-00_Ctrl_Unmixed__Tcells.fcs,Ctrl,Female,HEU-lo
+2025_07_26_AB_02-INF179-00_Ctrl_Unmixed__Tcells.fcs,Ctrl,Male,HU

course/10_Downsampling/data/SFCGatingSet.gs/c2d7178d-e5b5-4803-aed4-3703bedddc66.gs

@@ -0,0 +1,4 @@
+�

+32025_07_26_AB_02-INF052-00_Ctrl_Unmixed__Tcells.fcs
+32025_07_26_AB_02-INF100-00_Ctrl_Unmixed__Tcells.fcs
+32025_07_26_AB_02-INF179-00_Ctrl_Unmixed__Tcells.fcs2$c2d7178d-e5b5-4803-aed4-3703bedddc66:2.22.0B3008000J1.10.7