Skip to content

Commit

Permalink
Merge pull request #40 from ParkerICI/data-table
Browse files Browse the repository at this point in the history
Data table
pfgherardini authored Dec 26, 2021
2 parents 8e98c65 + 0983d18 commit 735567e
Showing 19 changed files with 124 additions and 30 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
Package: premessa
Type: Package
Title: R package for pre-processing of flow and mass cytometry data
Version: 0.2.6
Author: "Pier Federico Gherardini <pfgherardini@parkerici.org> [aut, cre]"
Version: 0.3.0
Author: "Pier Federico Gherardini <federico.gherardini@gmail.com> [aut, cre]"
Description: This package includes panel editing/renaming for FCS files, bead-based normalization and debarcoding.
Imports: shiny (>= 0.14), flowCore, reshape, ggplot2, hexbin, gridExtra, rhandsontable, jsonlite
Imports: shiny (>= 0.14), flowCore, reshape, ggplot2, hexbin, gridExtra, rhandsontable, jsonlite, data.table, shinyjqui
License: GPL v3
LazyData: TRUE
RoxygenNote: 6.1.0
RoxygenNote: 7.1.1
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -23,3 +23,4 @@ export(rename_fcs_parameters_desc)
export(rename_fcs_parameters_name)
export(rename_parameters_in_files)
export(write_flowFrame)
import(data.table)
16 changes: 11 additions & 5 deletions R/debarcode_cytof.R
Original file line number Diff line number Diff line change
@@ -26,12 +26,12 @@ get_barcode_channels_names <- function(m, bc.key) {


sort_rows <- function(m) {
x <- data.table::as.data.table(m)
x <- as.data.table(m)
x$row.id <- 1:nrow(x)

x <- dcast(melt(setDT(x), id.var='row.id')[order(-value),
.SD, row.id][, N:=1:.N , .(row.id)],
row.id~N, value.var=c("value"))
row.id~N, value.var = c("value"))
x$row.id <- NULL
return(as.matrix(x))

@@ -58,7 +58,8 @@ sort_rows <- function(m) {
#' @param expected.positive A single number. The expected number of positive barcode channels for each event
calculate_bcs_separation <- function(m, bc.channels, expected.positive, cutoff) {
m.bcs <- m[, bc.channels]
m.bcs <- t(apply(m.bcs, 1, sort, decreasing = T))
#m.bcs <- t(apply(m.bcs, 1, sort, decreasing = T))
m.bcs <- sort_rows(m.bcs)
deltas <- m.bcs[, expected.positive] - m.bcs[, expected.positive + 1]

lowest.bc <- m.bcs[, expected.positive]
@@ -255,7 +256,8 @@ debarcode_data_matrix <- function(m, bc.channels, bc.key) {
#'
#' @param m The data matrix
#' @param bc.key The barcode key, as returned by \code{read_barcode_key}
#'
#' @param downsample.to Optional. If provided the data will be downsampled to the
#' specified number of events before debarcoding
#' @return Returns a list with the following components
#' \itemize{
#' \item{\code{m.normed}}{ matrix with \code{nrow(m)} rows. The normalized barcode intensities}
@@ -266,7 +268,11 @@ debarcode_data_matrix <- function(m, bc.channels, bc.key) {
#' }
#'
#' @export
debarcode_data <- function(m, bc.key) {
debarcode_data <- function(m, bc.key, downsample.to = NULL) {
if(!is.null(downsample.to) && nrow(m) > downsample.to) {
message(sprintf("Downsampling data to %d", downsample.to))
m <- m[sample(1:nrow(m), downsample.to), ]
}
barcode.channels <- get_barcode_channels_names(m, bc.key)


1 change: 1 addition & 0 deletions R/debarcoder_plotting.R
Original file line number Diff line number Diff line change
@@ -90,6 +90,7 @@ plot_barcode_yields <- function(bc.results, sep.threshold, mahal.threshold = NUL
+ ggplot2::scale_y_continuous("Cell count")
+ ggplot2::scale_x_discrete("Sample")
+ ggplot2::labs(title = title.string)
#+ ggplot2::theme(axis.text.y = ggplot2::element_blank())
)

return(p)
2 changes: 2 additions & 0 deletions R/package.R
Original file line number Diff line number Diff line change
@@ -6,4 +6,6 @@
#'
#' @docType package
#' @name premessa
#'
#' @import data.table
NULL
6 changes: 4 additions & 2 deletions README.md
Original file line number Diff line number Diff line change
@@ -4,10 +4,12 @@

Copyright 2016. Parker Institute for Cancer Immunotherapy

**Please contact us with bugs/feature requests**

**---> Make sure to have a backup copy of your data before you use the software! <---**

**New in version 0.3.0**:
- Added UI for file concatenation under the normalizer GUI
- Much faster debarcoding. Note that for the purpose of debarcoder plotting, data will now be downsampled to 100000 events. This means that absolute cell numbers in the plots will not reflect the absolute cell numbers in the final data (but the ratios and trends will be correct). The final debarcoded data will always include **all** events


# Installation

5 changes: 5 additions & 0 deletions inst/debarcoder_shinyGUI/server.R
Original file line number Diff line number Diff line change
@@ -78,6 +78,11 @@ shinyServer(function(input, output, session) {
ret <- NULL
if(!is.null(fcs)) {
m <- flowCore::exprs(fcs)
downsample.to <- 100000
if(nrow(m) > downsample.to) {
message(sprintf("Downsampling data to %d", downsample.to))
m <- m[sample(1:nrow(m), downsample.to), ]
}
ret <- asinh(m / 10)
}

43 changes: 42 additions & 1 deletion inst/normalizer_shinyGUI/server.R
Original file line number Diff line number Diff line change
@@ -2,8 +2,26 @@ gatePlot <- function (outputId) {
HTML(paste("<div id=\"", outputId, "\" class=\"shiny-gateplot\"><canvas id=\"gatePlotCanvas\"></canvas></div>", sep=""))
}

render_concatenate_ui <- function(working.directory, ...) {renderUI({
fluidPage(
fluidRow(
column(12,
#selectizeInput("concatenateui_selected_files", multiple = T, width = "100%", choices = c()),
shinyjqui::orderInput("concatenateui_available_files", "Available files", connect = "concatenateui_files_order",
items = list.files(working.directory, pattern = "*.fcs$", ignore.case = TRUE), width = "100%"),
shinyjqui::orderInput("concatenateui_files_order", "File order", placeholder = "Drag files here",
items = NULL, connect = "concatenateui_available_files", width = "100%"),
actionButton("concatenateui_concatenate_files", "Concatenate files")

)
)
)




})}


render_beadremoval_ui <- function(working.directory, ...) {renderUI({
fluidPage(
@@ -26,7 +44,6 @@ render_beadremoval_ui <- function(working.directory, ...) {renderUI({


render_normalizer_ui <- function(working.directory, ...){renderUI({
#Remove this fluidpage?
fluidPage(
fluidRow(
column(12,
@@ -82,11 +99,35 @@ shinyServer(function(input, output, session) {
beads.removed.dir <- file.path(normed.dir, "beads_removed")
beadremovalui.plots.number <- 3

output$concatenateUI <- render_concatenate_ui(working.directory)
output$normalizerUI <- render_normalizer_ui(working.directory, input, output, session)
output$normalizerUI_plot_outputs <- generate_normalizerui_plot_outputs(5)
output$beadremovalUI <- render_beadremoval_ui(working.directory, input, output, session)
output$beadremovalUI_plot_outputs <- generate_beadremovalui_plot_outputs(beadremovalui.plots.number)

#concatenateUI functions

observe({
if(!is.null(input$concatenateui_concatenate_files) && input$concatenateui_concatenate_files != 0) {
input.files <- file.path(working.directory, input$concatenateui_files_order)
out.file <- file.path(working.directory, gsub(".fcs$", "_concat.fcs", input$concatenateui_files_order[[1]], ignore.case = TRUE))
showModal(modalDialog(
title = "Normalizer report",
"File concatenation started, please wait..."
))
premessa::concatenate_fcs_files(input.files, out.file)
showModal(modalDialog(
title = "Normalizer report",
p("Files concatenated in this order:", br(),
lapply(input$concatenateui_files_order, function(x) list(x, br())),
br(), "Outuput file: ", basename(out.file)
)
))
updateSelectizeInput(session, "normalizerui_selected_fcs",
choices = c("", list.files(working.directory, pattern = "*.fcs$", ignore.case = T)))
}
})

#beadremovalUI functions

get_beadremovalui_fcs <- reactive({
6 changes: 6 additions & 0 deletions inst/normalizer_shinyGUI/ui.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,11 @@
shinyUI(
navbarPage("premessa",
tabPanel("Concatenate files",
fluidPage(
fluidRow(
uiOutput("concatenateUI")
)
)),
tabPanel("Normalize data",
tags$head(tags$script(src = "gate-plot.js")),
tags$head(tags$script(src = "d3.min.js")),
8 changes: 6 additions & 2 deletions man/calculate_baseline.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 7 additions & 2 deletions man/correct_data_channels.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/debarcode_data.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 8 additions & 2 deletions man/debarcode_fcs.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

8 changes: 6 additions & 2 deletions man/get_assignments_at_threshold.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 7 additions & 2 deletions man/get_sample_idx.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

8 changes: 6 additions & 2 deletions man/get_well_abundances.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 1 addition & 2 deletions man/normalize_folder.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

8 changes: 6 additions & 2 deletions man/plot_barcode_yields.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 0 additions & 1 deletion man/premessa.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 735567e

Please sign in to comment.