R/faust_gating_plot.R

In RGLab/ggcyto: Visualize Cytometry data with ggplot

#' plot faust gating schemes
#' @param start_node faust start node
#' @param end_node the terminal leaf node generated by faust
#' @export
#' @examples 
#' \dontrun{
#' gs=load_gs("~/Downloads/ics")
#' 
#' end_node = "/S/LV/L/CD4+/CD3+/CD8-/TNF+/CD107a-/IL4-/IFNg+/IL2+/CD154-/IL17a-"
#' start_node = "/S/LV/L"
#' gh=gs[[1]]
#' p = faust_gating_plot(gh, start_node, end_node, bins=128)
#' plot(ggcyto_arrange(p, nrow=1))
#' }
faust_gating_plot <- function(gh, start_node, end_node, ...){
	#normalize node path
	start_node = gh_pop_get_full_path(gh, start_node)
	end_node = gh_pop_get_full_path(gh, end_node)
	#strip parent path
	end_node = sub(paste0("^\\Q",start_node,"/\\E"),"", end_node)
	#n_node = length(strsplit(end_node, "/")[[1]])
	#bottom up assemble 2d plots
	plots=list()
	parent_names=NULL
	while (end_node!=start_node) {
	  marker_expressions = basename(end_node)
	  x_gate = gh_pop_get_gate(gh, end_node)
		x_axis = parameters(x_gate)
		stopifnot(length(x_axis)==1)
		end_node = gh_pop_get_parent(gh, end_node)
		if(end_node==start_node)#reach to the end, plot 1d gate
		{
			data = gh_pop_get_data(gh, end_node)
			p = autoplot(data, x_axis) + geom_gate(x_gate)
	
		}else{
			#otherwise plot 2d 
		  marker_expressions = c(basename(end_node), marker_expressions)
		  y_gate = gh_pop_get_gate(gh, end_node)
			y_axis = parameters(y_gate)
			stopifnot(length(y_axis)==1)
			end_node = gh_pop_get_parent(gh, end_node)
			data = gh_pop_get_data(gh, end_node)
			p = autoplot(data, x_axis, y_axis, ...) + geom_gate(x_gate) + geom_gate(y_gate)
		}
		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)
		                 , strip.text = element_text(size = 10)
		                 , plot.margin = unit(c(0,0,0,0), "cm")
		                 , panel.spacing = unit(0, "cm")
		                 , legend.position = 'none'
		)
		p <- p + myTheme
		parent_names <- c(parent_names, paste0(marker_expressions, collapse = ","))
		plots[[end_node]] <- p
	}
	parent_names <- c(parent_names[-1], "All Cells")
	#add parent protections as title
	plots = mapply(function(p, name){
	                          attr(p$data, "strip.text") <- name
                          	p
                          	}
	               , plots, parent_names,SIMPLIFY = FALSE)
	plots = rev(plots)
	plots <- as(plots, "ggcyto_GatingLayout")
	plots
}