Merge pull request #92 from djhammill/devel

Pass all channel-related aesthetics to fortify

R/fortify.R

@@ -7,8 +7,17 @@
 #' @import data.table
 #' @export
 #' @noRd 
-.fr2dt <- function(x, ...){
-  as.data.table(exprs(x))
+.fr2dt <- function(x, mapping = NULL, ...){
+  dt <- as.data.table(exprs(x))
+  # sort values by order aesthetic mapping
+  if("order" %in% mapping$axis) {
+    # variable to use for ordering
+    setorderv(
+      dt,
+      cols = mapping[axis == "order", name]
+    )
+  }
+  return(dt)
 }
 
 #' coerce the flowSet to a data.table
@@ -27,16 +36,16 @@
   # subset by columns if applicable
   dims <- attr(x, "dims")
   if(!is.null(dims))
-    x <- x[, dims[, name]]
+    x <- x[, unique(dims[, name])]
 
   if(!is.null(thisFilter)){
     if(is.function(thisFilter)){
-      thisFilter <- thisFilter(x, dims[, name])
+      thisFilter <- thisFilter(x, unique(dims[, name]))
     }
     x <- Subset(x, thisFilter)
   }
 
-  df.list <- .fsdply(x, .fr2dt, .id = ".rownames")
+  df.list <- .fsdply(x, .fr2dt, mapping = dims, .id = ".rownames")
 
 }
 

R/ggcyto.R

@@ -168,6 +168,8 @@ as.ggplot <- function(x, pre_binning = FALSE){
   #lazy-fortifying the plot data
   #####################
   dims <- attr(x[["data"]], "dims")
+  # drop order aesthetic if present (no scale required)
+  dims <- dims[axis != "order", ]
   aes_names <- dims[, axis]
   chnls <- dims[, name]
 

R/ggcyto_flowSet.R

@@ -7,31 +7,55 @@ ggcyto.cytoset <- function(data, ...){
 ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4, ...){
   #add empty layers recording
 
-
   fs <- data
-  #instead of using ggplot.default method to contruct the ggplot object
-  # we call the underlining s3 method directly to avoid foritying data at this stage
-  p <- ggplot.data.frame(fs, mapping, ...)
+
+  #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(
+    fs,
+    mapping[!names(mapping) %in% "order"], # order aes not passed to ggplot
+    ...
+  )
   p[["layer.history"]] <- list()
 
   if(!missing(mapping)){
     p[["layer.history"]][["mapping"]] = mapping  
 
-    dims <- mapping[grepl("[x|y]", names(mapping))]
-    dims <- sapply(dims,quo_name)
-
-
-    #update x , y with actual channel name
+    # 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(dims, function(dim)getChannelMarker(frm, dim), .id = "axis")
-    chnl <- dims.tbl[, name]
+    dims.tbl <- .ldply(
+      dims,
+      function(dim) {
+        # handle pData variables alone or interaction
+        if (grepl("interaction", dim) | dim %in% colnames(pData(fs))) {
+          data.frame(
+            "name" = NA,
+            "desc" = NA
+          )
+        } else {
+          getChannelMarker(frm, dim)
+        }
+      },
+      .id = "axis"
+    )
+
+    # drop pData mapping from dim.tbl
+    dims.tbl <- dims.tbl[!is.na(dims.tbl$name), ]
+    chnl <- unique(dims.tbl[axis %in% c("x", "y"), name])
 
-    for(axis_name in names(dims))
+    # prepare mapping variables - bypass order aesthetic
+    for(axis_name in dims.tbl$axis) {
       mapping[[axis_name]] <- as.symbol(dims.tbl[axis == axis_name, name])
-    #update dims
-    p$mapping <- mapping
+    }
+
+    # drop order from mapping
+    mapping[["order"]] <- NULL
 
-    nDims <- length(dims)
+    # update dims
+    p$mapping <- mapping
 
     #attach dims to data for more efficient fortify
     attr(fs, "dims") <- dims.tbl
@@ -41,10 +65,8 @@ ggcyto.flowSet <- function(data, mapping, filter = NULL, max_nrow_to_plot = 5e4,
     p[["data"]] <- fs #update data as well
     p[["instrument_range"]] <- range(frm)[, chnl, drop = FALSE]
 
-
   }else
     stop("mapping must be supplied to ggplot!")
-
 
   #init axis inversed labels and breaks
   p[["axis_inverse_trans"]] <- list()

R/utility.R

@@ -11,7 +11,6 @@
     index <- seq_along(.data)
     .id <- NULL
   }
-
 
   res <- .do_loop(index = index, .data = .data, ..., .id = .id)
   res <- rbindlist(res)

vignettes/Top_features_of_ggcyto.Rmd

@@ -22,15 +22,15 @@ library(ggcyto)
 dataDir <- system.file("extdata",package="flowWorkspaceData")
 ```
 
-## 1: suppoort `3` types of plot constructor 
+## 1: support `3` types of plot constructor 
 
 * represent different levels of complexity and flexibility
 * meet the needs of various plot applications
 * suitable for users at different levels of coding skills.
 
 ### low level: `ggplot`
 
-The overloaded `fority` methods empower `ggplot`  to work with all the major Cytometry data structures right away, which allows users to do all kinds of highly customized and versitled plots.
+The overloaded `fority` methods empower `ggplot`  to work with all the major Cytometry data structures right away, which allows users to do all kinds of highly customized and versatile plots.
 
 #### `GatingSet`
 ```{r}