From 368ca3c7f67cb51552e19f80def179496fe57227 Mon Sep 17 00:00:00 2001 From: Dillon Hammill Date: Wed, 18 Feb 2026 15:51:09 -0800 Subject: [PATCH] Support custom plot order in ggcyto. --- R/autoplot.R | 105 ++-- R/compute_stats.R | 22 +- R/fortify.R | 79 +-- R/ggcyto.R | 36 +- R/ggcyto_flowSet.R | 118 ++-- man/autoplot.Rd | 5 +- man/compute_stats.Rd | 11 +- man/fortify.filterList.Rd | 4 +- man/fortify.flowSet.Rd | 8 +- man/ggcyto.Rd | 11 +- .../custom-pData/ggcyto-fs-custom-order.svg | 534 ++++++++++++++++++ .../custom-pData/ggcyto-fs-default-order.svg | 534 ++++++++++++++++++ tests/testthat/test-custom-pData.R | 83 +++ 13 files changed, 1388 insertions(+), 162 deletions(-) create mode 100644 tests/testthat/_snaps/custom-pData/ggcyto-fs-custom-order.svg create mode 100644 tests/testthat/_snaps/custom-pData/ggcyto-fs-default-order.svg create mode 100644 tests/testthat/test-custom-pData.R diff --git a/R/autoplot.R b/R/autoplot.R index b7d5bef..76c2e01 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -9,6 +9,7 @@ #' @param y define the y dimension of the plot. Default is NULL, which means 1d densityplot. #' @param bins passed to geom_hex #' @param axis_inverse_trans logical flag indicating whether to add \link{axis_x_inverse_trans} and axis_x_inverse_trans layers. +#' @param pData Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order. The original pData is not modified. #' @param ... other arguments passed to ggplot #' #' @rdname autoplot @@ -44,26 +45,26 @@ #' #autoplot(gh , strip.text = "gate") #' @export #' @export autoplot -autoplot.flowSet <- function(object, x, y = NULL, bins = 30, ...){ - +autoplot.flowSet <- function(object, x, y = NULL, bins = 30, pData = NULL, ...){ + # check the dimensions if(missing(x)) stop("'x' must be supplied to ggplot!") if(is.null(y)){ - p <- ggcyto(object, aes_q(x = as.symbol(x)), ...) #aes_string doesn't play well with special character (e.g. '-') + p <- ggcyto(object, aes_q(x = as.symbol(x)), pData = pData, ...) #aes_string doesn't play well with special character (e.g. '-') p <- p + geom_density(fill = "black") }else{ - p <- ggcyto(object, aes_q(x = as.symbol(x), y = as.symbol(y)), ...) + p <- ggcyto(object, aes_q(x = as.symbol(x), y = as.symbol(y)), pData = pData, ...) p <- p + geom_hex(bins = bins) - + } - + # apply boundary filter to remove outliers -# if(margin){ -# g <- boundaryFilter(x = dims, tol = 1e-5) -# object <- Subset(object, g) -# } - + # if(margin){ + # g <- boundaryFilter(x = dims, tol = 1e-5) + # object <- Subset(object, g) + # } + p } @@ -94,33 +95,33 @@ autoplot.flowFrame <- function(object, x, ...){ object <- fortify_fs(object) autoplot(object, x = x, ...) } - + } density_fr_all <- function(fr, strip.text = c("both", "channel", "marker"), ...){ #plot each individual channel Objs <- sapply(colnames(fr), function(chnl){ - p <- autoplot(fr, chnl, ...) - p <- p + labs(title = NULL) - myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8) - , axis.text = element_text(color = gray(0.3), size = 6) - , axis.title.y = element_blank() - , strip.text = element_blank() - , plot.margin = unit(c(0,0,0,0), "cm") - , panel.spacing = unit(0, "cm") - ) - p <- p + myTheme - attr(p$data, "strip.text") <- chnl - p - }, simplify = FALSE) + p <- autoplot(fr, chnl, ...) + p <- p + labs(title = NULL) + myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8) + , axis.text = element_text(color = gray(0.3), size = 6) + , axis.title.y = element_blank() + , strip.text = element_blank() + , plot.margin = unit(c(0,0,0,0), "cm") + , panel.spacing = unit(0, "cm") + ) + p <- p + myTheme + attr(p$data, "strip.text") <- chnl + p + }, simplify = FALSE) #convert it to a special class to dispatch the dedicated print method Objs <- as(Objs, "ggcyto_GatingLayout") Objs@arrange.main <- identifier(fr) - - + + Objs @@ -135,7 +136,7 @@ autoplot.GatingSetList <- function(object, ...){ #' @param gate the gate to be plotted #' @export #' @rdname autoplot -autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, axis_inverse_trans = TRUE, ...){ +autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, axis_inverse_trans = TRUE, pData = NULL, ...){ if(missing(gate)) stop("Must specifiy 'gate'!") g <- gh_pop_get_gate(object[[1]], gate[1]) @@ -160,15 +161,15 @@ autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, }else stop("invalid nDims: ", nDims) } - + mapping <- aes_q(x = as.symbol(x), y = as.symbol(y)) - - p <- ggcyto(object, mapping, ...) + geom_hex(bins = bins) + geom_gate(gate) + geom_stats() + + p <- ggcyto(object, mapping, pData = pData, ...) + geom_hex(bins = bins) + geom_gate(gate) + geom_stats() p <- p + ggcyto_par_set(limits = "instrument") if(axis_inverse_trans) p <- p + axis_x_inverse_trans() + axis_y_inverse_trans() p - + } #' @param bool whether to plot boolean gates @@ -182,11 +183,11 @@ autoplot.GatingSet <- function(object, gate, x = NULL, y = "SSC-A", bins = 30, #' @export #' @rdname autoplot autoplot.GatingHierarchy <- function(object, gate, y = "SSC-A", bool=FALSE - , arrange.main = sampleNames(object), arrange=TRUE, merge=TRUE - , projections = list() - , strip.text = c("parent", "gate") - , path = "auto" - , ...){ + , arrange.main = sampleNames(object), arrange=TRUE, merge=TRUE + , projections = list() + , strip.text = c("parent", "gate") + , path = "auto" + , ...){ strip.text <- match.arg(strip.text) if(missing(gate)){ gate <- gs_get_pop_paths(object, path = path) @@ -194,35 +195,35 @@ autoplot.GatingHierarchy <- function(object, gate, y = "SSC-A", bool=FALSE }else if (is.numeric(gate)){ gate <- gs_get_pop_paths(object, path = path)[gate] } - + #match given axis to channel names fr <- gh_pop_get_data(object, use.exprs = FALSE) projections <- lapply(projections, function(thisPrj){ sapply(thisPrj, function(thisAxis)getChannelMarker(fr, thisAxis)[["name"]]) }) - - + + plotList <- flowWorkspace:::.mergeGates(object, gate, bool, merge, projections = projections) Objs <- lapply(plotList,function(plotObjs){ - + if(is.list(plotObjs)){ gate <- plotObjs[["popIds"]] parent <- plotObjs[["parentId"]] myPrj <- projections[[as.character(gate[1])]] - + }else{ gate <- plotObjs parent <- gs_pop_get_parent(object, gate, path = path) myPrj <- projections[[as.character(gate)]] } - - + + if(is.null(myPrj)){ p <- autoplot.GatingSet(object, gate, y = y, ...) }else{ p <- autoplot.GatingSet(object, gate, x = myPrj[["x"]], y = myPrj[["y"]], ...) } - + p <- p + labs(title = NULL) myTheme <- theme(axis.title = element_text(color = gray(0.3), size = 8) , axis.text = element_text(color = gray(0.3), size = 6) @@ -232,26 +233,26 @@ autoplot.GatingHierarchy <- function(object, gate, y = "SSC-A", bool=FALSE , legend.position = 'none' ) p <- p + myTheme - + #rename sample name with parent or current pop name in order to display it in strip - + if(strip.text == "parent"){ popName <- parent }else{ popName <- paste(gate, collapse = "|") } attr(p$data, "strip.text") <- popName - + p - + }) - + if(arrange){ #convert it to a special class to dispatch the dedicated print method Objs <- as(Objs, "ggcyto_GatingLayout") Objs@arrange.main <- arrange.main } - + Objs - + } diff --git a/R/compute_stats.R b/R/compute_stats.R index 7ffc980..b7c58d9 100644 --- a/R/compute_stats.R +++ b/R/compute_stats.R @@ -9,6 +9,7 @@ #' @param gates a list of filters #' @param type a vector of strings to specify the stats types. can be any or multiple values of "percent", "count", "gate_name", or "MFI" (MFI is currently not supported yet). #' @param value the pre-calculated stats value. when supplied, the stats computing is skipped. +#' @param pData Optional custom pData to use instead of pData(fs) to control the plot order. #' @param ... other arguments passed to stat_position function #' @return #' a data.table that contains percent and centroid locations as well as pData @@ -21,7 +22,7 @@ #' rect.gates <- sapply(sampleNames(fs), function(sn)rect.g) #' compute_stats(fs, rect.gates) #' compute_stats(fs, rect.gates, type = c("gate_name", "percent")) -compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...){ +compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, pData = NULL, ...){ if(is.null(fs)&&(is.null(value))) stop("fs must be provided when 'value' is not supplied!") @@ -46,12 +47,17 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...) stats <- Reduce(function(x,y){ val <- paste(x[, value], y[, value], sep = "\n") x[, value := val] - }, x = stats.list) + }, x = stats.list) centroids <- stat_position(gates, ...) stats <- merge(centroids, stats, by = ".rownames") # merge stats with centroid - merge(stats, .pd2dt(pData(fs)), by = ".rownames") # merge with pdata + + # Get pData and use data.table join to preserve factor levels + pd <- .pd2dt(pData(fs), pData = pData) + setkeyv(pd, ".rownames") + setkeyv(stats, ".rownames") + pd[stats, on = ".rownames"] } .stat_gate_name <- function(fs, gates, value = NULL, ...){ @@ -76,14 +82,14 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...) if(negated) p = 1 - p p - }, simplify = FALSE) + }, simplify = FALSE) } sn <- names(value) value <- unlist(value) #format the calculated stats values value <- paste(format(value *100,digits=digits),"%",sep="") stats <- data.table(value = value, .rownames = sn) - + stats } @@ -99,12 +105,12 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...) if(negated) ind <- !ind sum(ind) - }, simplify = FALSE) + }, simplify = FALSE) } sn <- names(value) value <- unlist(value) stats <- data.table(value = value, .rownames = sn) - + stats } @@ -115,5 +121,5 @@ compute_stats <- function(fs = NULL, gates, type = "percent", value = NULL, ...) .stat_MFI <- function(fs, gates, digits = 3, negated = FALSE, ...){ stop("MFI not supported yet!") fs_sub <- Subset(fs, gates) - + } \ No newline at end of file diff --git a/R/fortify.R b/R/fortify.R index 1d54ccc..5413383 100644 --- a/R/fortify.R +++ b/R/fortify.R @@ -44,7 +44,7 @@ } x <- Subset(x, thisFilter) } - + df.list <- .fsdply(x, .fr2dt, mapping = dims, .id = ".rownames") } @@ -67,9 +67,15 @@ fortify.flowFrame <- function(model, data, ...){ #' convert pData to data.table #' @noRd -.pd2dt <- function(pd){ +.pd2dt <- function(pd, pData = NULL){ + # Use custom pData if provided, otherwise use the original pd + if (!is.null(pData)) { + pd <- pData + } + pd <- as.data.table(pd, keep.rownames = TRUE) setnames(pd, "rn", ".rownames") + pd } #' Convert a flowFrame/flowSet/GatingSet to a ggplot-compatible data.table @@ -80,6 +86,7 @@ fortify.flowFrame <- function(model, data, ...){ #' @param data not used. #' @param ... not used. #' +#' @param pData Optional custom pData to use instead of pData(model) #' @export #' @aliases fortify #' @return data.table @@ -95,15 +102,18 @@ fortify.flowFrame <- function(model, data, ...){ #' #' fr <- fs[[1]] #' fortify(fr)#fr is a flowFrame -fortify.flowSet <- function(model, data, ...){ +fortify.flowSet <- function(model, data, pData = NULL, ...){ #convert to data.table - df <- .fs2dt(model) - - #merge with pData - pd <- .pd2dt(pData(model)) + df <- .fs2dt(model, ...) + + #get pData + pd <- .pd2dt(pData(model), pData = pData) + + # Use data.table join to preserve factor levels from pd + setkeyv(pd, ".rownames") + setkeyv(df, ".rownames") + pd[df, on = ".rownames"] - merge(pd, df, by = ".rownames") - } #' @export @@ -124,12 +134,11 @@ fortify.GatingSetList <- function(model, ...){ } #' @export -#' @return data.table #' @rdname fortify.flowSet -fortify.GatingSet <- function(model, ...){ +fortify.GatingSet <- function(model, pData = NULL, ...){ fs <- fortify_fs(model, ...) - fortify(fs) + fortify(fs, pData = pData) } #' Convert a polygonGate to a data.table useful for ggplot @@ -207,10 +216,11 @@ fortify.ellipsoidGate <- function(model, data = NULL, ...){ #' Convert a filterList to a data.table useful for ggplot #' #' It tries to merge with pData that is associated with filterList as attribute 'pd' - + #' @param model filterList #' @param data not used #' @param nPoints not used +#' @param pData Optional custom pData to use #' @param ... not used. #' #' @importFrom plyr name_rows @@ -222,25 +232,30 @@ fortify.ellipsoidGate <- function(model, data = NULL, ...){ #' gates <- gs_pop_get_gate(gs, "CD4") #' gates <- as(gates, "filterList") #must convert list to filterList in order for the method to dispatch properly #' fortify(gates) -fortify.filterList <- function(model, data = NULL, nPoints = NULL, ...){ - # convert each filter to df - df <- .ldply(model, fortify - # , data = data - # , nPoints = nPoints - , .id = ".rownames") +fortify.filterList <- function(model, data = NULL, nPoints = NULL, pData = NULL, ...){ + # convert each filter to df + df <- .ldply(model, fortify + # , data = data + # , nPoints = nPoints + , .id = ".rownames") + + pd <- attr(model,"pd") + if(!is.null(pd)){ + # get pd - pd <- attr(model,"pd") - if(!is.null(pd)){ - # merge with pd - - if(!is(pd, "data.table")) - pd <- .pd2dt(pd) - df <- merge(df, pd, by = ".rownames") - attr(df, "annotated") <- TRUE - } - # attr(df, "nPoints") <- nPoints - - df + if(!is(pd, "data.table")) + pd <- .pd2dt(pd, pData = pData) + + # Use data.table join to preserve factor levels from pd + setkeyv(pd, ".rownames") + setkeyv(df, ".rownames") + df <- pd[df, on = ".rownames"] + + attr(df, "annotated") <- TRUE + } + # attr(df, "nPoints") <- nPoints + + df } #' Convert a rectangleGate to a data.table useful for ggplot @@ -279,6 +294,6 @@ fortify.rectangleGate <- function(model, data = NULL, ...){ df }else stop("rectangelGate with dimension ", nDim, "is not supported!") - + } diff --git a/R/ggcyto.R b/R/ggcyto.R index d7f9602..9bbbd7f 100644 --- a/R/ggcyto.R +++ b/R/ggcyto.R @@ -23,6 +23,7 @@ #' @param subset character that specifies the node path or node name in the case of GatingSet. #' Default is "_parent_", which will be substituted with the actual node name #' based on the geom_gate layer to be added later. +#' @param pData Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order in faceted plots. The original pData is not modified. #' @param ... other arguments passed to specific methods #' @return ggcyto object #' @examples @@ -114,10 +115,10 @@ ggcyto.default <- function(data = NULL, mapping = aes(), ...) { #' @method print ggcyto print.ggcyto <- function(x, ...) { - - x <- ggplot2:::plot_clone(x) #clone plot to avoid tampering original x due to ther referenceClass x$scales - x <- as.ggplot(x) - NextMethod() + + x <- ggplot2:::plot_clone(x) #clone plot to avoid tampering original x due to ther referenceClass x$scales + x <- as.ggplot(x) + NextMethod() } #' @rdname print.ggcyto @@ -163,7 +164,7 @@ setMethod("show", "ggcyto", show.ggcyto) #' @importFrom hexbin hexbin hcell2xy #' @export as.ggplot <- function(x, pre_binning = FALSE){ - + ##################### #lazy-fortifying the plot data ##################### @@ -184,7 +185,8 @@ as.ggplot <- function(x, pre_binning = FALSE){ }else fs <- x[["data"]] - x[["data"]] <- fortify(fs) + # Get pData from plot object + x[["data"]] <- fortify(fs, pData = x[["pData"]]) data_range <- apply(x[["data"]][, chnls, with = FALSE], 2, range) rownames(data_range) <- c("min", "max") }else @@ -220,15 +222,15 @@ as.ggplot <- function(x, pre_binning = FALSE){ pd <- pData(fs) df <- x[["data"]] cols <- c(".rownames", colnames(pd)) - + df <- df[, { - + binned <- hexbin::hexbin(.SD, xbins = e2$stat_params[["bins"]]) sd <- hexbin::hcell2xy(binned) names(sd) <- colnames(.SD) data.table(data.frame(sd,hex_cell_id = binned@cell, count=binned@count, check.names = FALSE)) }, by = cols] - + x[["data"]] <- df e2 <- geom_hex(stat="identity",aes(fill=count)) x$layers[[i]] <- e2 @@ -269,7 +271,7 @@ as.ggplot <- function(x, pre_binning = FALSE){ }else if(!is.null(par_limits)) stop("How did you end up here?") - + stats_limits[[dim]] <- x$coordinates[["limits"]][[this_aes]] #update breaks and labels thisBreaks <- breaks[[this_aes]] @@ -333,8 +335,8 @@ as.ggplot <- function(x, pre_binning = FALSE){ #parse the gate from the each gate layer if it is not present in the current geom_stats layer if(is.null(gate)) { - - pd <- .pd2dt(pData(fs)) + # Get pData from plot object + pd <- .pd2dt(pData(fs), pData = x[["pData"]]) gates_parsed <- lapply(x$layers, function(layer){ if(is.geom_gate_filterList(layer))#restore filter from fortified data.frame @@ -357,7 +359,7 @@ as.ggplot <- function(x, pre_binning = FALSE){ value <- e2[["value"]] stat_type <- e2[["type"]] - + #add default density range #In order to ensure the stats visiblity #try to put it closer to zero because we don't know the actual density range @@ -390,7 +392,8 @@ as.ggplot <- function(x, pre_binning = FALSE){ #bypass stats_postion computing to use data_range as gate_range(as a hack for now) location <- "data" } - + + # Get pData from plot object stats <- compute_stats(fs, gate , type = stat_type , value = value @@ -399,7 +402,8 @@ as.ggplot <- function(x, pre_binning = FALSE){ , negated = negated , adjust = adjust , digits = digits - , location = location) + , location = location + , pData = x[["pData"]]) #restore the stats dimensions to raw scale if(length(trans)>0) @@ -412,7 +416,7 @@ as.ggplot <- function(x, pre_binning = FALSE){ } } - + # instantiate the new stats layer thisCall <- quote(geom_label(data = stats)) # copy all the other parameters diff --git a/R/ggcyto_flowSet.R b/R/ggcyto_flowSet.R index 15472aa..02d9fc5 100644 --- a/R/ggcyto_flowSet.R +++ b/R/ggcyto_flowSet.R @@ -3,12 +3,34 @@ ggcyto.cytoset <- function(data, ...){ getS3method("ggcyto", "flowSet")(data, ...) } #' @rdname ggcyto +#' @param pData Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order. The original pData is not modified. #' @export -ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, ...){ +ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, pData = NULL, ...){ #add empty layers recording fs <- data + # If pData is supplied, validate and store in plot object + # Don't replace pData(fs) directly as it converts factors to characters + if (!is.null(pData)) { + pd <- pData(fs) + + # Validate that rownames match + if (!identical(sort(rownames(pData)), sort(rownames(pd)))) { + stop("Supplied pData rownames must match the sample names in the flowSet") + } + + # Validate that columns exist (allow additional columns in supplied pData) + missing_cols <- setdiff(colnames(pd), colnames(pData)) + if (length(missing_cols) > 0) { + warning("Some columns from original pData are missing in supplied pData: ", + paste(missing_cols, collapse = ", ")) + } + + # Reorder supplied pData to match sample order in flowSet + pData <- pData[rownames(pd), , drop = FALSE] + } + #instead of using ggplot.default method to construct the ggplot object # we call the underlining s3 method directly to avoid fortifying data at this stage p <- ggplot.data.frame( @@ -23,7 +45,7 @@ ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, # dims may reference channels, markers or pData variables dims <- sapply(mapping, quo_name) - + # update aes mapped parameters with actual channel name frm <- getFlowFrame(fs) dims.tbl <- .ldply( @@ -67,7 +89,7 @@ ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, }else stop("mapping must be supplied to ggplot!") - + #init axis inversed labels and breaks p[["axis_inverse_trans"]] <- list() # prepend the ggcyto class attribute @@ -78,6 +100,9 @@ ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, p[["GeomStats"]] <- list() + # Store pData in the plot object + p[["pData"]] <- pData + p <- p + ggcyto_par_default() # the counts at legend could be reflecting the subsampled data and we want to hide this from user to avoid confusion p <- p + theme(legend.position = 'none') @@ -154,13 +179,13 @@ is.ggcyto_flowSet <- function(x){ #' p + theme(strip.text = element_text(size = 14)) #' @export `+.ggcyto_flowSet` <- function(e1, e2){ - # Get the name of what was passed in as e2, and pass along so that it - # can be displayed in error messages - e2name <- deparse(substitute(e2)) - - if (is.ggcyto_par(e1)) add_par(e1, e2, e2name) - else if (is.ggcyto_flowSet(e1)) add_ggcyto(e1, e2, e2name) - + # Get the name of what was passed in as e2, and pass along so that it + # can be displayed in error messages + e2name <- deparse(substitute(e2)) + + if (is.ggcyto_par(e1)) add_par(e1, e2, e2name) + else if (is.ggcyto_flowSet(e1)) add_ggcyto(e1, e2, e2name) + } #' @export @@ -172,7 +197,7 @@ add_ggcyto <- function(e1, e2, e2name){ fs <- e1[["data"]] dims <- attr(fs, "dims") chnl <- dims[, name] - + is.recorded <- attr(e2, "is.recorded") if(is.null(is.recorded)) is.recorded <- FALSE @@ -188,7 +213,8 @@ add_ggcyto <- function(e1, e2, e2name){ }else if(is.ggproto(e2)){ layer_data <- e2$data if(!is.null(layer_data)){ - pd <- .pd2dt(pData(fs)) + # Get pData from plot object + pd <- .pd2dt(pData(fs), pData = e1[["pData"]]) } if(is(layer_data, "filterList")){ @@ -275,7 +301,7 @@ add_ggcyto <- function(e1, e2, e2name){ e1[["GeomStats"]] <- NULL return(e1) }else if (is.ggcyto_par(e2)) { - + for(element in names(e2)){ #skip hex_fill for 1d plot @@ -284,35 +310,35 @@ add_ggcyto <- function(e1, e2, e2name){ e2.new <- e2[[element]] #apply instrument range to limits if(element == "limits" ){ - instrument_range <- e1[["instrument_range"]] - if(is.list(e2.new)) - { - this_limits <- e2.new - }else if(is.character(e2.new)) - { - this_limits <- list() - if(e2.new == "instrument") - { - for(aes_name in dims[, axis]) - this_limits[[aes_name]] <- instrument_range[, dims[axis == aes_name, name]] - }else if(e2.new == "data") - { - # store the ggcyto pars for the lazy-eval elements for we may not have the final version of data yet at this stage - e1$ggcyto_pars <- add_par(e1$ggcyto_pars, e2, deparse(substitute(e2))) - next - }else - stop("invalid 'limits' setting!") - - } - #clear the lazy element (i.e. limits = "data") for non-lazy limits setting - #so that it won't be applied later on - e1$ggcyto_pars <- modifyList(e1$ggcyto_pars, list(limits = NULL)) - e2.new <- coord_cartesian(xlim = this_limits[["x"]], ylim = this_limits[["y"]]) + instrument_range <- e1[["instrument_range"]] + if(is.list(e2.new)) + { + this_limits <- e2.new + }else if(is.character(e2.new)) + { + this_limits <- list() + if(e2.new == "instrument") + { + for(aes_name in dims[, axis]) + this_limits[[aes_name]] <- instrument_range[, dims[axis == aes_name, name]] + }else if(e2.new == "data") + { + # store the ggcyto pars for the lazy-eval elements for we may not have the final version of data yet at this stage + e1$ggcyto_pars <- add_par(e1$ggcyto_pars, e2, deparse(substitute(e2))) + next + }else + stop("invalid 'limits' setting!") + + } + #clear the lazy element (i.e. limits = "data") for non-lazy limits setting + #so that it won't be applied later on + e1$ggcyto_pars <- modifyList(e1$ggcyto_pars, list(limits = NULL)) + e2.new <- coord_cartesian(xlim = this_limits[["x"]], ylim = this_limits[["y"]]) } attr(e2.new, "is.recorded") <- TRUE e1 <- e1 + e2.new } - + return(e1) @@ -325,18 +351,18 @@ add_ggcyto <- function(e1, e2, e2name){ marker <- thisDim[, desc] chnl <- thisDim[, name] lab_txt[[axis_name]] <- switch(e2[["labels"]] - , "marker" = ifelse(is.na(marker), chnl, marker) - , "channel" = chnl - , "both" = paste0(chnl, ifelse(is.na(marker), "", paste0(" ", marker))) - ) - + , "marker" = ifelse(is.na(marker), chnl, marker) + , "channel" = chnl + , "both" = paste0(chnl, ifelse(is.na(marker), "", paste0(" ", marker))) + ) + } e2 <- labs(!!!lab_txt) }else if(is.theme(e2)){ #have to take care of theme object since it inherits gg class and will #cause the dispatch conflicts due to the special rule of groupGeneric - ggplot_add(e2, e1) + ggplot_add(e2, e1) }else if(is(e2, "logicalGates")){ if(is(fs, "GatingSet")){ @@ -425,8 +451,8 @@ is.geom_gate_filterList <- function(layer){ verts <- sapply(markers, function(marker)unique(df[[marker]]), simplify = FALSE) if(all(sapply(verts, length) == 2)) { - - rectangleGate(verts) + + rectangleGate(verts) }else polygonGate(df) diff --git a/man/autoplot.Rd b/man/autoplot.Rd index 82bfc04..5983dbe 100644 --- a/man/autoplot.Rd +++ b/man/autoplot.Rd @@ -12,7 +12,7 @@ \alias{autoplot.GatingHierarchy} \title{Plot cytometry data in one or two dimension with the ggcyto package.} \usage{ -\method{autoplot}{flowSet}(object, x, y = NULL, bins = 30, ...) +\method{autoplot}{flowSet}(object, x, y = NULL, bins = 30, pData = NULL, ...) \method{autoplot}{ncdfFlowList}(object, ...) @@ -31,6 +31,7 @@ y = "SSC-A", bins = 30, axis_inverse_trans = TRUE, + pData = NULL, ... ) @@ -57,6 +58,8 @@ \item{bins}{passed to geom_hex} +\item{pData}{Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order. The original pData is not modified.} + \item{...}{other arguments passed to ggplot} \item{gate}{the gate to be plotted} diff --git a/man/compute_stats.Rd b/man/compute_stats.Rd index e5dc3ab..067d08d 100644 --- a/man/compute_stats.Rd +++ b/man/compute_stats.Rd @@ -4,7 +4,14 @@ \alias{compute_stats} \title{compute the statistics of the cell population defined by gates} \usage{ -compute_stats(fs = NULL, gates, type = "percent", value = NULL, ...) +compute_stats( + fs = NULL, + gates, + type = "percent", + value = NULL, + pData = NULL, + ... +) } \arguments{ \item{fs}{flowSet. can be NULL when precaculated 'value' is provided} @@ -15,6 +22,8 @@ compute_stats(fs = NULL, gates, type = "percent", value = NULL, ...) \item{value}{the pre-calculated stats value. when supplied, the stats computing is skipped.} +\item{pData}{Optional custom pData to use instead of pData(fs) to control the plot order.} + \item{...}{other arguments passed to stat_position function} } \value{ diff --git a/man/fortify.filterList.Rd b/man/fortify.filterList.Rd index d0d35d8..b70c778 100644 --- a/man/fortify.filterList.Rd +++ b/man/fortify.filterList.Rd @@ -4,7 +4,7 @@ \alias{fortify.filterList} \title{Convert a filterList to a data.table useful for ggplot} \usage{ -\method{fortify}{filterList}(model, data = NULL, nPoints = NULL, ...) +\method{fortify}{filterList}(model, data = NULL, nPoints = NULL, pData = NULL, ...) } \arguments{ \item{model}{filterList} @@ -13,6 +13,8 @@ \item{nPoints}{not used} +\item{pData}{Optional custom pData to use} + \item{...}{not used.} } \value{ diff --git a/man/fortify.flowSet.Rd b/man/fortify.flowSet.Rd index 509deaa..6bb611a 100644 --- a/man/fortify.flowSet.Rd +++ b/man/fortify.flowSet.Rd @@ -15,7 +15,7 @@ \method{fortify}{flowFrame}(model, data, ...) -\method{fortify}{flowSet}(model, data, ...) +\method{fortify}{flowSet}(model, data, pData = NULL, ...) \method{fortify}{cytoset}(model, ...) @@ -23,7 +23,7 @@ \method{fortify}{GatingSetList}(model, ...) -\method{fortify}{GatingSet}(model, ...) +\method{fortify}{GatingSet}(model, pData = NULL, ...) } \arguments{ \item{model}{flowFrame, flowSet or GatingSet} @@ -31,12 +31,12 @@ \item{...}{not used.} \item{data}{not used.} + +\item{pData}{Optional custom pData to use instead of pData(model)} } \value{ data.table -data.table - data.table } \description{ diff --git a/man/ggcyto.Rd b/man/ggcyto.Rd index e879cf1..3c80923 100644 --- a/man/ggcyto.Rd +++ b/man/ggcyto.Rd @@ -23,7 +23,14 @@ ggcyto(data = NULL, ...) \method{ggcyto}{GatingHierarchy}(data, ...) -\method{ggcyto}{flowSet}(data, mapping, filter = NULL, max_nrow_to_plot = 50000, ...) +\method{ggcyto}{flowSet}( + data, + mapping, + filter = NULL, + max_nrow_to_plot = 50000, + pData = NULL, + ... +) } \arguments{ \item{data}{The data source. A core cytometry data structure. (flowSet, flowFrame, ncdfFlowSet, GatingSet or GatingHierarchy)} @@ -41,6 +48,8 @@ based on the geom_gate layer to be added later.} The gate is used to filter the flow data before it is plotted.} \item{max_nrow_to_plot}{the maximum number of cells to be plotted. When the actual data exceeds it, The subsampling process will be triggered to speed up plotting. Default is 5e4. To turn off the subsampling, simply set it to a large enough number or Inf.} + +\item{pData}{Optional data.frame to use in place of the flowSet/GatingSet pData during plotting. Must have the same sample names (rownames) as the original pData. Columns can have different classes (e.g., factors with custom levels) to control plotting order. The original pData is not modified.} } \value{ ggcyto object diff --git a/tests/testthat/_snaps/custom-pData/ggcyto-fs-custom-order.svg b/tests/testthat/_snaps/custom-pData/ggcyto-fs-custom-order.svg new file mode 100644 index 0000000..1f7147a --- /dev/null +++ b/tests/testthat/_snaps/custom-pData/ggcyto-fs-custom-order.svg @@ -0,0 +1,534 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +6 + + + + + + + + + + +6 + + + + + + + + + + +7 + + + + + + + + + + +5 + + + + + + + + + + +7 + + + + + + + + + + +6 + + + + + + + + + + +5 + + + + + + + + + + +5 + + + + + + + + + + +5 + + + + + + + + + + +6 + + + + + + + + + + +6 + + + + + + + + + + +5 + + + + + + +250 +500 +750 +1000 + + + + +250 +500 +750 +1000 + + + + +250 +500 +750 +1000 +0 +2500 +5000 +7500 + + + + +0 +2500 +5000 +7500 + + + + +FSC-H FSC-Height +count +ggcyto-fs-custom-order + + diff --git a/tests/testthat/_snaps/custom-pData/ggcyto-fs-default-order.svg b/tests/testthat/_snaps/custom-pData/ggcyto-fs-default-order.svg new file mode 100644 index 0000000..6ce92cf --- /dev/null +++ b/tests/testthat/_snaps/custom-pData/ggcyto-fs-default-order.svg @@ -0,0 +1,534 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +6 + + + + + + + + + + +6 + + + + + + + + + + +7 + + + + + + + + + + +5 + + + + + + + + + + +7 + + + + + + + + + + +6 + + + + + + + + + + +5 + + + + + + + + + + +5 + + + + + + + + + + +5 + + + + + + + + + + +6 + + + + + + + + + + +6 + + + + + + + + + + +5 + + + + + + +250 +500 +750 +1000 + + + + +250 +500 +750 +1000 + + + + +250 +500 +750 +1000 +0 +2500 +5000 +7500 + + + + +0 +2500 +5000 +7500 + + + + +FSC-H FSC-Height +count +ggcyto-fs-default-order + + diff --git a/tests/testthat/test-custom-pData.R b/tests/testthat/test-custom-pData.R new file mode 100644 index 0000000..cbff1c2 --- /dev/null +++ b/tests/testthat/test-custom-pData.R @@ -0,0 +1,83 @@ +context("fortify") +test_that("fortify -- ggcyto-fs-custom-order", { + # Create a subset of the data + fs <- GvHD[subset(pData(GvHD), Patient %in% 5:7 & Visit %in% c(5:6))[["name"]]] + + # Create custom pData with Patient as factor in custom order + custom_pd <- pData(fs) + custom_pd$Patient <- factor(custom_pd$Patient, levels = c("7", "6", "5")) + custom_pd$Visit <- factor(custom_pd$Visit, levels = c("6", "5")) + + # Original plot order + p1 <- ggcyto(fs, aes(x = `FSC-H`)) + + geom_histogram(bins = 30) + + facet_wrap(~Patient + Visit) + + # Manual plot order + p2 <- ggcyto(fs, aes(x = `FSC-H`), pData = custom_pd) + + geom_histogram(bins = 30) + + facet_wrap(~Patient + Visit) + + suppressWarnings( + expect_doppelganger( + "ggcyto-fs-default-order", + p1 + ) + ) + suppressWarnings( + expect_doppelganger( + "ggcyto-fs-custom-order", + p1 + ) + ) + +}) + +test_that("fortify-- pData-rownames", { + fs <- GvHD[1:3] + + # Create pData with wrong rownames + wrong_pd <- data.frame( + name = c("a", "b", "c"), + Patient = c("1", "2", "3"), + row.names = c("wrong1", "wrong2", "wrong3") + ) + + # Should error because rownames don't match + expect_error( + ggcyto(fs, aes(x = `FSC-H`), pData = wrong_pd), + "rownames must match" + ) +}) + +test_that("fortify-- pData-columns", { + fs <- GvHD[1:3] + + # Create pData with only some columns + partial_pd <- data.frame( + name = sampleNames(fs), + row.names = sampleNames(fs) + ) + + # Should warn about missing columns + expect_warning( + ggcyto(fs, aes(x = `FSC-H`), pData = partial_pd), + "missing in supplied pData" + ) +}) + +test_that("fortify-- pData-sample-order", { + fs <- GvHD[1:3] + + # Create pData with samples in different order + custom_pd <- pData(fs) + # Reverse the order of rows + custom_pd <- custom_pd[rev(rownames(custom_pd)), , drop = FALSE] + custom_pd$Test <- factor(rownames(custom_pd), levels = rownames(custom_pd)) + + # Should reorder to match flowSet + p <- ggcyto(fs, aes(x = `FSC-H`), pData = custom_pd) + + # The pData in the flowSet should match the original order + expect_equal(rownames(pData(p$data)), sampleNames(fs)) +}) \ No newline at end of file