Add more functions (5ea762e9) · Commits · github_fork / Plot1cell

NAMESPACE

+4 −3

Original line number	Original line	Diff line number	Diff line
	# Generated by roxygen2: do not edit by hand		# Generated by roxygen2: do not edit by hand

	export(add_sliding_windows)		export(add_sliding_windows)
	export(add_tract)		export(add_track)
	export(cell_order)		export(cell_order)
			export(change_strip_background)
			export(complex_dotplot_multiple)
			export(complex_dotplot_single)
	export(complex_vlnplot_single)		export(complex_vlnplot_single)
	export(convert_geneid)		export(convert_geneid)
	export(creat_cellphonedb_file)		export(creat_cellphonedb_file)
	@@ -18,9 +21,7 @@ export(modified_coverageplot)
	export(modified_dimplot)		export(modified_dimplot)
	export(modified_dotplot)		export(modified_dotplot)
	export(plot_circlize)		export(plot_circlize)
	export(plot_multigene_group)
	export(plot_qpcr)		export(plot_qpcr)
	export(plot_singlegene_group)
	export(plot_upset)		export(plot_upset)
	export(prepare_circlize_data)		export(prepare_circlize_data)
	export(run_correlation)		export(run_correlation)

R/plot_circlize.R

+3 −3

R/plot_gene_group.R→R/plot_dot.R

+164 −0

Original line number	Original line	Diff line number	Diff line
	@@ -11,41 +11,96 @@
	#'		#'
	#' @param seu_obj A complete Seurat object		#' @param seu_obj A complete Seurat object
	#' @param feature Gene name. Only one gene is allowed.		#' @param feature Gene name. Only one gene is allowed.
	#' @param splitby One of the column names in the meta.data slot of the Seurat object.		#' @param groupby The group to show on x axis. One of the column names in meta.data.
			#' @param splitby The group to separate the gene expression. One of the column names in meta.data.
			#' @param scale.by Methods to scale the dot size. "radius" or "size"
			#' @param strip.color Colors for the strip background
	#' @return A ggplot object		#' @return A ggplot object
	#' @export		#' @export
	plot_singlegene_group<-function(		complex_dotplot_single <- function(
	seu_obj,		seu_obj,
	feature,		feature,
	splitby		groupby,
			splitby=NULL,
			strip.color=NULL,
			scale.by='radius'
	){		){
			if (is.null(levels(seu_obj@meta.data[,groupby]))){
			seu_obj@meta.data[,groupby] <-factor(seu_obj@meta.data[,groupby], levels = names(table(seu_obj@meta.data[,groupby])))
			}
			groupby_level<-levels(seu_obj@meta.data[,groupby])
			levels(seu_obj)<-rev(levels(seu_obj))
			celltypes<-levels(seu_obj)
			celltypes<-gsub("_", ".", celltypes)
			seu_obj@meta.data$celltype<-as.character(seu_obj@active.ident)
			seu_obj@meta.data$celltype<-gsub("_", ".", seu_obj@meta.data$celltype)
			seu_obj<-SetIdent(seu_obj, value='celltype')
			levels(seu_obj)<-celltypes
			if(!is.null(splitby)){
	if (is.null(levels(seu_obj@meta.data[,splitby]))){		if (is.null(levels(seu_obj@meta.data[,splitby]))){
	seu_obj@meta.data[,splitby] <-factor(seu_obj@meta.data[,splitby], levels = names(table(seu_obj@meta.data[,splitby])))		seu_obj@meta.data[,splitby] <-factor(seu_obj@meta.data[,splitby], levels = names(table(seu_obj@meta.data[,splitby])))
	}		}
	dataplot<-DotPlot(seu_obj, features = feature, split.by = splitby, cols = scales::hue_pal()(length((levels(seu_obj@meta.data[,splitby])))))		splitby_level<-levels(seu_obj@meta.data[,splitby])
	dataplot<-dataplot$data		count_df<-extract_gene_count(seu_obj, features = feature, meta.groups = c(groupby,splitby))
	dataplot$avg.exp<-scale(dataplot$avg.exp)		count_df$new_group<-paste(count_df[,groupby], count_df[,"celltype"], count_df[,splitby],sep = "_")
	dataplot$Cluster<-gsub("_[^_]*$", "", dataplot$id )		exp_df<-aggregate(.~new_group, data=count_df[,c('new_group',feature)], FUN=function(x){mean(expm1(x))})
	dataplot$Disease<-gsub( ".*_", "", dataplot$id )		pct_df<-aggregate(.~new_group, data=count_df[,c('new_group',feature)], FUN=function(x){length(x[x > 0]) / length(x)})
	dataplot$Disease<-factor(dataplot$Disease, levels = levels(seu_obj@meta.data[,splitby]))		colnames(exp_df)[2]<-"avg.exp"
	dataplot$Cluster<-factor(dataplot$Cluster, levels = levels(seu_obj))		colnames(pct_df)[2]<-"pct.exp"
	colnames(dataplot)[1:2]<-c('Avg.Exp', 'Pct.Exp')		data_plot<-merge(exp_df, pct_df, by='new_group')
	p<-ggplot(dataplot, aes(y = Cluster, x = Disease)) +		data_plot$groupby <- as.character(lapply(X=strsplit(data_plot$new_group, split = "_"),FUN = function(x){x[[1]]}))
			data_plot$celltype <- as.character(lapply(X=strsplit(data_plot$new_group, split = "_"),FUN = function(x){x[[2]]}))
			data_plot$splitby <- as.character(lapply(X=strsplit(data_plot$new_group, split = "_"),FUN = function(x){x[[3]]}))
			data_plot$groupby <- factor(data_plot$groupby, levels = groupby_level)
			data_plot$splitby <- factor(data_plot$splitby, levels = splitby_level)
			data_plot$celltype <- factor(data_plot$celltype, levels = celltypes)
			} else {
			count_df<-extract_gene_count(seu_obj, features = feature, meta.groups = groupby)
			count_df$new_group<-paste(count_df[,groupby], count_df[,"celltype"],sep = "_")
			exp_df<-aggregate(.~new_group, data=count_df[,c('new_group',feature)], FUN=function(x){mean(expm1(x))})
			pct_df<-aggregate(.~new_group, data=count_df[,c('new_group',feature)], FUN=function(x){length(x[x > 0]) / length(x)})
			colnames(exp_df)[2]<-"avg.exp"
			colnames(pct_df)[2]<-"pct.exp"
			data_plot<-merge(exp_df, pct_df, by='new_group')
			data_plot$groupby <- as.character(lapply(X=strsplit(data_plot$new_group, split = "_"),FUN = function(x){x[[1]]}))
			data_plot$celltype <- as.character(lapply(X=strsplit(data_plot$new_group, split = "_"),FUN = function(x){x[[2]]}))
			data_plot$groupby <- factor(data_plot$groupby, levels = groupby_level)
			data_plot$celltype <- factor(data_plot$celltype, levels = celltypes)
			}
			scale.func <- switch(
			EXPR = scale.by,
			'size' = scale_size,
			'radius' = scale_radius,
			stop("'scale.by' must be either 'size' or 'radius'")
			)
			data_plot$pct.exp <- round(100 * data_plot$pct.exp, 2)
			data_plot$avg.exp <- scale(data_plot$avg.exp)
			p<-ggplot(data_plot, aes(y = celltype, x = groupby)) +
	geom_tile(fill="white", color="white") +		geom_tile(fill="white", color="white") +
	geom_point(aes( colour=Avg.Exp, size =Pct.Exp)) +		geom_point(aes( colour=avg.exp, size =pct.exp)) +
	scale_color_gradientn(colours = colorRampPalette(c('grey80','lemonchiffon1','indianred1','darkred'))(255))+		scale_color_gradientn(colours = colorRampPalette(c('grey80','lemonchiffon1','indianred1','darkred'))(255))+
	scale_size(range = c(0, 10))+
	theme(axis.line = element_blank(),		theme(axis.line = element_blank(),
	axis.text.x = element_text(angle = 45, hjust = 1),		axis.text.x = element_text(angle = 45, hjust = 1),
	plot.title = element_text(size = 16,hjust = 0.5, face = 'bold'),		plot.title = element_text(size = 16,hjust = 0.5, face = 'bold'),
	axis.text = element_text(size = 12),		axis.text = element_text(size = 12),
	axis.title=element_text(size=8),		axis.title=element_text(size=8),
	legend.text=element_text(size=8),		legend.text=element_text(size=8),
	legend.title = element_text(size = 8),		legend.title = element_text(size = 12),
	legend.position="right")+		legend.position="right")+
	ylab("")+xlab("")+ggtitle(feature)		ylab("")+xlab("")+ggtitle(feature)
			if(max(data_plot$pct.exp)>=20){
			p = p + scale_size(range = c(0, 10))
			} else {
			p = p + scale.func(range = c(0, 10), limits = c(0, 20))
			}
			if(!is.null(splitby)){
			p <- p +facet_wrap(~splitby, scales = 'free_x')
			g <- change_strip_background(p, type = 'top', n.color = length(levels(seu_obj)), strip.color = strip.color)
			print(grid.draw(g))
			} else {
	p		p
	}		}
			}


	#' Plot multiple genes across groups		#' Plot multiple genes across groups
	@@ -57,13 +112,14 @@ plot_singlegene_group<-function(
	#'		#'
	#' @param seu_obj A complete Seurat object		#' @param seu_obj A complete Seurat object
	#' @param features A vector of gene names.		#' @param features A vector of gene names.
	#' @param splitby Group ID Must be one of the column names in the meta.data slot of the Seurat object.		#' @param groupby Group ID Must be one of the column names in the meta.data slot of the Seurat object.
			#' @param strip.color Colors for the strip background
	#' @return A ggplot object		#' @return A ggplot object
	#' @export		#' @export
	plot_multigene_group<-function(		complex_dotplot_multiple <- function(
	seu_obj,		seu_obj,
	features,		features,
	splitby,		groupby,
	strip.color = NULL		strip.color = NULL
	){		){
	pb <- progress_bar$new(		pb <- progress_bar$new(
	@@ -73,17 +129,20 @@ plot_multigene_group<-function(
	plot_list<-list()		plot_list<-list()
	for(i in 1:length(features)){		for(i in 1:length(features)){
	pp<-invisible(		pp<-invisible(
	plot_singlegene_group(seu_obj = seu_obj, feature = features[i], splitby = splitby)		complex_dotplot_single(seu_obj = seu_obj, feature = features[i], groupby = groupby)
	)		)
	plot_list[[i]]<-pp$data		pp<-pp$data
			pp$gene <- features[i]
			plot_list[[i]]<-pp
	pb$tick()		pb$tick()
	Sys.sleep(1 / length(features))		Sys.sleep(1 / length(features))
	}		}
	all_data<-do.call('rbind', plot_list)		all_data<-do.call('rbind', plot_list)
			all_data$celltype <- factor(all_data$celltype, levels = levels(seu_obj))
	p <- invisible(		p <- invisible(
	ggplot(all_data, aes(x = Disease, y = features.plot)) +		ggplot(all_data, aes(x = groupby, y = gene)) +
	geom_tile(fill="white", color="white") +		geom_tile(fill="white", color="white") +
	geom_point(aes( colour=Avg.Exp, size =Pct.Exp), alpha=0.9) +		geom_point(aes( colour=avg.exp, size =pct.exp), alpha=0.9) +
	scale_color_gradientn(colours = grDevices::colorRampPalette(c('grey80','lemonchiffon1','indianred1','darkred'))(255))+		scale_color_gradientn(colours = grDevices::colorRampPalette(c('grey80','lemonchiffon1','indianred1','darkred'))(255))+
	scale_size(range = c(0, 10))+		scale_size(range = c(0, 10))+
	theme( axis.line = element_blank(),		theme( axis.line = element_blank(),
	@@ -92,25 +151,13 @@ plot_multigene_group<-function(
	axis.text = element_text(size = 12),		axis.text = element_text(size = 12),
	axis.title=element_text(size=8),		axis.title=element_text(size=8),
	legend.text=element_text(size=8),		legend.text=element_text(size=8),
	legend.title = element_text(size = 8),		legend.title = element_text(size = 12),
	legend.position="right",		legend.position="right",
	strip.text = element_text(size = 14,colour = 'black',face = 'bold'))+		strip.text = element_text(size = 14,colour = 'black',face = 'bold'))+
	ylab("")+xlab("")+ggtitle('')+		ylab("")+xlab("")+ggtitle('')+
	facet_wrap(~Cluster, ncol = length(levels(seu_obj)))		facet_wrap(~celltype, ncol = length(levels(seu_obj)))
	)		)
	g <- ggplot_gtable(ggplot_build(p))		g <- change_strip_background(p, type = 'top', n.color = length(levels(seu_obj)), strip.color = strip.color)
	strip_both <- which(grepl('strip-t', g$layout$name))
	celltypes <-levels(seu_obj)
	fills <- strip.color
	if(is.null(strip.color)){
	fills<- scales::hue_pal()(length(celltypes))
	}
	k <- 1
	for (i in strip_both) {
	j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
	g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
	k <- k+1
	}
	print(grid.draw(g))		print(grid.draw(g))
	}		}

R/plot_violin.R

+3 −4

R/utils.R

+34 −1

Original line number	Original line	Diff line number	Diff line
	@@ -365,7 +365,7 @@ extract_gene_count <- function(
	}		}


	#' A function to change gene name into first letter capital		#' A function to make gene name first letter capital
	#'		#'
	#' The function is modified from this thread: https://stackoverflow.com/questions/18509527/first-letter-to-upper-case/18509816		#' The function is modified from this thread: https://stackoverflow.com/questions/18509527/first-letter-to-upper-case/18509816
	#'		#'
	@@ -380,3 +380,36 @@ firstup <- function(
	substr(x, 1, 1) <- toupper(substr(x, 1, 1))		substr(x, 1, 1) <- toupper(substr(x, 1, 1))
	x		x
	}		}

			#' A function to change the strip background color in ggplot
			#' @param ggplt_obj A ggplot object
			#' @param n.color Number of colors.
			#' @param strip.color A color vector
			#' @export
			#'
			change_strip_background <- function(
			ggplt_obj,
			type = "top",
			n.color,
			strip.color=NULL
			){
			g <- ggplot_gtable(ggplot_build(ggplt_obj))
			if(type == "top"){
			strip_both <- which(grepl('strip-t', g$layout$name))
			} else {
			strip_t <- which(grepl('strip-t', g$layout$name))
			strip_r <- which(grepl('strip-r', g$layout$name))
			strip_both<-c(strip_t, strip_r)
			}
			fills <- strip.color
			if(is.null(strip.color)){
			fills<- scales::hue_pal()(n.color)
			}
			k <- 1
			for (i in strip_both) {
			j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
			g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
			k <- k+1
			}
			g
			}

Original line number	Original line	Diff line number	Diff line
	@@ -8,7 +8,7 @@
	#' polar coordinates.		#' polar coordinates.
	#'		#'
	#' @param coord_data Cartesian coordinates from tSNE, UMAP, etc.		#' @param coord_data Cartesian coordinates from tSNE, UMAP, etc.
	#' @param zoom value from c(0,1) to adjust the coordinates.		#' @param zoom Value from c(0,1) to adjust the coordinates.
	#' @return A matrix with polar coordinates		#' @return A matrix with polar coordinates
	#' @export		#' @export
	transform_coordinates <- function(		transform_coordinates <- function(
	@@ -215,11 +215,11 @@ plot_circlize <- function(
	#'		#'
	#' This function allows users to add more tracks into the circlize plot		#' This function allows users to add more tracks into the circlize plot
	#' @param data_plot Data for circlize plot		#' @param data_plot Data for circlize plot
	#' @param group The group for showing on the new track		#' @param group The group to be shown on the new track
	#' @param colors Color palette to color the group		#' @param colors Color palette to color the group
	#' @return A new circlize track adding to the current circlize plot		#' @return A new circlize track adding to the current circlize plot
	#' @export		#' @export
	add_tract <- function(data_plot, group, colors = NULL){		add_track <- function(data_plot, group, colors = NULL){
	circos.track(data_plot$Cluster, data_plot$x_polar2, y=data_plot$dim2, bg.border=NA)		circos.track(data_plot$Cluster, data_plot$x_polar2, y=data_plot$dim2, bg.border=NA)
	celltypes<-names(table(data_plot$Cluster))		celltypes<-names(table(data_plot$Cluster))
	group_names<-names(table(data_plot[,group]))		group_names<-names(table(data_plot[,group]))

Admin message