Nothing
## prepared-for-plot Tool function####################
coordinate_rotate <- function(pos, theta=0){# counter-clock rotation
pos_new <- pos
pos_new[,1] <- pos[,1]*cos(theta) - pos[,2]*sin(theta)
pos_new[,2] <- pos[,1]*sin(theta) + pos[,2]*cos(theta)
return(pos_new)
}
get_indexList <- function(alist){
nsample <- length(alist)
nr <- 0
indexList <- list()
for(i in 1:nsample){
indexList[[i]] <- (nr+1):(nrow(alist[[i]] )+nr)
nr <- nr + nrow(alist[[i]] )
}
return(indexList)
}
get_sampleID <- function(XList){
sampleID <- list()
r_max <- length(XList)
for(r in 1:r_max){
sampleID[[r]] <- rep(r, nrow(XList[[r]]))
}
sampleID <- unlist(sampleID)
return(sampleID)
}
firstup <- function(x) {
## First letter use upper capital
x <- tolower(x)
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
matlist2mat <- function(XList){
# transfer a matrix list to a matrix stacked by rows.
r_max <- length(XList)
X0 <- XList[[1]]
if(is.null(dim(X0)) || any(dim(X0)==1)){
if(r_max>1){
for(r in 2:r_max){
X0 <- c(X0, XList[[r]])
}
}
return(matrix(X0, ncol=1))
}
if(r_max>1){
for(r in 2:r_max){
X0 <- rbind(X0, XList[[r]])
}
}
return(X0)
}
# Vector based plot function##############################
barPlot <- function(vec, ylabel='ARI', cols=NULL,...){
# require(ggplot2)
## filter vec
N <- length(vec)
vec_use <-vec[!is.na(vec)]
df_use <- data.frame(value=vec_use,
Method=names(vec_use))
df_use$Method <- factor(df_use$Method, levels=names(vec_use))
## CCor
p1 <- ggplot(df_use, aes(x=aes_string('Method'), y=aes_string('value'),
fill=aes_string('Method'))) +
geom_bar(position = "dodge", stat="identity",width = 1, ...) + # , ...
#geom_errorbar( aes(ymin=value-sd, ymax=value+sd), width=0.4, colour="orange", size=1.3, position=position_dodge(.9)) +
#facet_grid(beta~Error , scales="fixed",labeller = label_bquote(beta == .(beta)))
labs(y=ylabel, x=NULL)+
scale_x_discrete(breaks = NULL)
if(is.null(cols)){
return(p1)
}else{
p1 + scale_fill_manual(values = cols)
}
}
# Matrix based plot function -------------------------------------------------------
plot_RGB <- function(position, embed_3d, pointsize=2,textsize=15){
# suppressMessages(require(ggplot2))
info = as.data.frame(position)
colnames(info) = c("sdimx","sdimy")
r = (embed_3d[,1]-min(embed_3d[,1]))/(max(embed_3d[,1])-min(embed_3d[,1]))
g = (embed_3d[,2]-min(embed_3d[,2]))/(max(embed_3d[,2])-min(embed_3d[,2]))
b = (embed_3d[,3]-min(embed_3d[,3]))/(max(embed_3d[,3])-min(embed_3d[,3]))
x = info$sdimx
y = info$sdimy
dat = data.frame(x,y,r,g,b)
p1=ggplot(data=dat, aes(x=x, y=y, col=rgb(r,g,b))) +
geom_point(size=pointsize) +
scale_color_identity()+
theme_void()+
theme(plot.title = element_text(size = textsize),
text = element_text(size = textsize),
#axis.title = element_text(face="bold"),
#axis.text.x=element_text(size = 22) ,
legend.position = "bottom")
p1
}
plot_scatter <- function (
embed_use, meta_data, label_name, xy_names=c('tSNE1', 'tSNE2'), no_guides = FALSE,
cols = NULL,
point_size = 0.5, point_alpha=1,
base_size = 12, do_points = TRUE, do_density = FALSE, border_col='gray',
legend_pos='right', legend_dir='vertical', nrow.legend=NULL) {
# require(dplyr)
# require(ggthemes)
# require(ggrepel)
# require(data.table)
plt_df <- embed_use %>% data.frame() %>% cbind(meta_data) %>%
dplyr::sample_frac(1L)
plt_df$given_name <- plt_df[[label_name]]
if(is.null(cols)){
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
cluster <- as.vector(plt_df$given_name)
ngrp <- length(unique(cluster))
cols <- gg_color_hue(ngrp)
}
plt <- plt_df %>% ggplot(aes_string(colnames(plt_df)[1],colnames(plt_df)[2], col = label_name,
fill = label_name)) + # + theme_tufte(base_size = base_size, ticks= show_ticks)
theme(axis.text.x=element_text(size=base_size, color=1),
axis.text.y=element_text(size=base_size, color=1),
axis.title.x = element_text(size=base_size+2, color='black'),
axis.title.y = element_text(size=base_size+2, color='black'),
strip.text = element_text(size=base_size, color='black'),
strip.background = element_rect(
linetype = 'solid', color='gray3'
),
legend.direction = legend_dir, legend.position = legend_pos,
legend.text=element_text(size=base_size+1),
legend.title=element_text(size=base_size+2),
panel.background= element_rect(fill = 'white', color=border_col))+
scale_color_manual(values = cols) + scale_fill_manual(values = cols) +
theme(plot.title = element_text(hjust = 0.5)) + labs(x = xy_names[1],
y = xy_names[2])
if (!is.null(nrow.legend)){
plt <- plt + guides(color = guide_legend(nrow = nrow.legend,override.aes = list(stroke = 1,
alpha = 1, shape = 16, size = 4)))
}else{
plt <- plt + guides(color = guide_legend(override.aes = list(stroke = 1,
alpha = 1, shape = 16, size = 4)),
alpha = "none")
}
if (do_points)
plt <- plt + geom_point( size = point_size, alpha=point_alpha)
if (do_density)
plt <- plt + geom_density_2d()
if (no_guides)
plt <- plt + guides(col = 'none', fill = 'none', alpha = 'none')
return(plt)
}
volinPlot <- function(mat, ylabel='ARI', cols=NULL){
# require(ggplot2)
## filter mat
N <- nrow(mat)
mat_use <- mat[,which(colSums(is.na(mat)) != N)]
df_use <- data.frame(value=as.vector(mat_use), Method=rep(colnames(mat_use), each=N))
df_use$Method <- factor(df_use$Method, levels=colnames(mat_use))
p1 <- ggplot(df_use, aes_string(x = 'Method', y = 'value',
fill = 'Method')) +
geom_violin(aes_string(fill = 'Method' ), color = "transparent", alpha = 0.5) +
geom_boxplot(outlier.alpha = 0, coef = 0, color = "gray40", width = 0.4) +
labs(x = "", y = ylabel) +
theme_classic() + theme( axis.text.x = element_blank() ) + theme(text = element_text(size=20))
if(is.null(cols)){
p1
}else{
pal <- cols
p1+scale_fill_manual(values = pal, name = "")
}
}
boxPlot <- function(mat, ylabel='ARI', cols=NULL, ...){
# require(ggplot2)
## filter mat
N <- nrow(mat)
mat_use <- mat[,which(colSums(is.na(mat)) != N)]
df_use <- data.frame(value=as.vector(mat_use), Method=rep(colnames(mat_use), each=N))
df_use$Method <- factor(df_use$Method, levels=colnames(mat_use))
p1 <- ggplot(df_use, aes_string(x="Method", y="value",
fill="Method") ) +
geom_boxplot(...) +
# facet_grid(beta~Error,scales= "fixed",labeller = label_bquote(beta == .(beta)) )+
labs(x=NULL, y= ylabel) + scale_x_discrete(breaks = NULL)
if(is.null(cols)){
return(p1)
}else{
p1 + scale_fill_manual(values = cols)
}
}
# Seurat based Plot function -----------------------------------------------------------
doHeatmap <- function(seu, features=NULL, cell_label='Cell type', grp_label = FALSE,
pt_size=4, grp_color=NULL, ...){
# require(ggplot2)
ngrp <- nlevels(Idents(seu))
if(is.null(grp_color)){
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
grp_color <- gg_color_hue(ngrp)
}
Seurat::DoHeatmap(object = seu, features=features, group.colors = grp_color[1:ngrp], label = grp_label, ...) +
guides(color = guide_legend(title=cell_label,override.aes = list(stroke = 1,
alpha = 1, shape = 16, size = pt_size, color=grp_color[1:ngrp])),
alpha = "none")
}
featurePlot <- function(seu, feature=NULL, cols=NULL, pt_size=1, title_size=16,
quant=0.5, assay='RNA', reduction="position"){
#dat <- as.data.frame(seu[[reduction]]@cell.embeddings)
dat <- as.data.frame(Embeddings(seu, reduction = reduction))
colnames(dat) <- c("Spatial_1", "Spatial_2")
if(is.null(feature)) feature <- row.names(seu)[1]
#dat$Expression <- seu[[assay]]@scale.data[feature,]
dat$Expression <- GetAssayData(seu, slot='scale.data')[feature,]
if(is.null(cols)) cols <- c("#0571B0", "#CA0020")
med <- quantile(dat$Expression, quant)
ggplot(data=dat, aes_string(x='Spatial_1', y='Spatial_2', color='Expression')) + geom_point(size=pt_size) +
scale_colour_gradient2(
low = cols[1],
mid = "white",
high = cols[2], midpoint = med) + mytheme_graybox() +
ggtitle(feature) + theme(title =element_text(size=title_size, color=1, face='italic'))
}
# Plot Theme -------------------------------------------------------------------
doHeatmap.matrix <- function(corMat, cluster_orderd,legend_title='Cell type', grp_label = FALSE,
pt_size=4, grp_color=NULL){
doHeatmap <- function(seu, features=NULL, cell_label='Cell type', grp_label = FALSE,
pt_size=4, grp_color=NULL, ...){
# require(ggplot2)
ngrp <- nlevels(Idents(seu))
if(is.null(grp_color)){
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
grp_color <- gg_color_hue(ngrp)
}
Seurat::DoHeatmap(object = seu, features=features, group.colors = grp_color[1:ngrp], label = grp_label, ...) +
guides(color = guide_legend(title=cell_label,override.aes = list(stroke = 1,
alpha = 1, shape = 16, size = pt_size, color=grp_color[1:ngrp])),
alpha = "none")
}
# require(Seurat)
seu <- CreateSeuratObject(counts=corMat)
Idents(seu) <- factor(cluster_orderd, levels=1: max(cluster_orderd))
seu[["RNA"]]@scale.data <- corMat
doHeatmap(seu, features = row.names(seu), cell_label=legend_title, pt_size=pt_size,
grp_color=grp_color, grp_label=grp_label)
}
# barPlot_enrich <- function(top_dat, source='Ont', term_name="Term", nlog10P='nlog10P',
# bar_width=0.8, base_size=20, font_family='serif', cols= ggthemes::canva_pal()(4)){
# # source='Ont'; term_name="Term"; nlog10P='nlog10P'
# require(ggplot2) # y=term_name,
# order_idx <- order(top_dat[,nlog10P])
# top_dat <- top_dat[order_idx,]
# top_dat[, term_name] <- factor(top_dat[, term_name], levels=top_dat[order_idx,term_name])
# p1 <- ggplot(data=top_dat, aes_string(x=term_name,y=nlog10P, fill=source)) +
# scale_fill_manual(values=cols)+
# geom_bar(position = "dodge", stat="identity",width =bar_width)+ coord_flip() +
# theme_classic() + theme(text=element_text(size=base_size, family=font_family))
# return(p1)
# }
mytheme_graybox <- function (base_size = 11, base_family = "", base_line_size = base_size/22,
base_rect_size = base_size/22, border_color = 'gray10', bg_fill='white')
{
half_line <- base_size/2
t <- theme(panel.background = element_rect(fill = bg_fill,
colour = NA), panel.border = element_rect(fill = NA,
colour = border_color),
#line = element_blank(), #rect = element_blank(),
panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
text = element_text(family = base_family, face = "plain",
colour = "black", size = base_size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE), axis.text = element_blank(), axis.title = element_blank(),
axis.ticks.length = unit(0, "pt"), axis.ticks.length.x = NULL,
axis.ticks.length.x.top = NULL, axis.ticks.length.x.bottom = NULL,
axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL,
axis.ticks.length.y.right = NULL, legend.box = NULL,
legend.key.size = unit(1.2, "lines"), legend.position = "right",
legend.text = element_text(size = rel(0.8)), legend.title = element_text(hjust = 0),
strip.text = element_text(size = rel(0.8)), strip.switch.pad.grid = unit(half_line/2,
"pt"), strip.switch.pad.wrap = unit(half_line/2,
"pt"), panel.ontop = FALSE,
panel.spacing = unit(half_line/2, "pt"), plot.margin = unit(rep(0.2,4), "lines"),
plot.title = element_text(size = rel(1.2), hjust = 0,
vjust = 1, margin = margin(t = half_line)), plot.title.position = "panel",
plot.subtitle = element_text(hjust = 0, vjust = 1, margin = margin(t = half_line)),
plot.caption = element_text(size = rel(0.8), hjust = 1,
vjust = 1, margin = margin(t = half_line)), plot.caption.position = "panel",
plot.tag = element_text(size = rel(1.2), hjust = 0.5,
vjust = 0.5), plot.tag.position = "topleft",
complete = TRUE)
#ggplot2:::ggplot_global$theme_all_null %+replace% t
t
}
mytheme_void <- function (base_size = 11, base_family = "", base_line_size = base_size/22,
base_rect_size = base_size/22)
{
half_line <- base_size/2
t <- theme(panel.background = element_rect(fill = "white",
colour = NA), panel.border = element_rect(fill = NA,
colour = "grey"),
line = element_blank(), #rect = element_blank(),
text = element_text(family = base_family, face = "plain",
colour = "black", size = base_size, lineheight = 0.9,
hjust = 0.5, vjust = 0.5, angle = 0, margin = margin(),
debug = FALSE), axis.text = element_blank(), axis.title = element_blank(),
axis.ticks.length = unit(0, "pt"), axis.ticks.length.x = NULL,
axis.ticks.length.x.top = NULL, axis.ticks.length.x.bottom = NULL,
axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL,
axis.ticks.length.y.right = NULL, legend.box = NULL,
legend.key.size = unit(1.2, "lines"), legend.position = "right",
legend.text = element_text(size = rel(0.8)), legend.title = element_text(hjust = 0),
strip.text = element_text(size = rel(0.8)), strip.switch.pad.grid = unit(half_line/2,
"pt"), strip.switch.pad.wrap = unit(half_line/2,
"pt"), panel.ontop = FALSE, panel.spacing = unit(half_line,
"pt"), plot.margin = unit(c(0, 0, 0, 0), "lines"),
plot.title = element_text(size = rel(1.2), hjust = 0,
vjust = 1, margin = margin(t = half_line)), plot.title.position = "panel",
plot.subtitle = element_text(hjust = 0, vjust = 1, margin = margin(t = half_line)),
plot.caption = element_text(size = rel(0.8), hjust = 1,
vjust = 1, margin = margin(t = half_line)), plot.caption.position = "panel",
plot.tag = element_text(size = rel(1.2), hjust = 0.5,
vjust = 0.5), plot.tag.position = "topleft",
complete = TRUE)
#ggplot2:::ggplot_global$theme_all_null %+replace% t
t
}
mytheme <- function(legend.direction = "horizontal",
legend.position = "bottom", type = 'rect'){
if(type=='rect'){
th <- theme(axis.text.x=element_text(size=16, color=1, face='plain'),
axis.text.y=element_text(size=16, color=1, face='plain'),
axis.title.x = element_text(size=18, color='black', face='plain'),
axis.title.y = element_text(size=18, color='black',face='plain'),
strip.text = element_text(size=16, color='black', face='plain'),
strip.background = element_rect(
linetype = 'solid', color='gray3'
),
legend.direction = legend.direction, legend.position = legend.position,
legend.text=element_text(size=17, face='plain'),
legend.title=element_text(size=18, face='bold'),
panel.background= element_rect(fill = 'white', color='gray'))
}
return(th)
}
# Other plots -------------------------------------------------------------
drawFigs <- function(pList, layout.dim = NULL, common.legend=FALSE,legend.position='right', ...){
if(!is.list(pList)) stop('drawFigs: pList must be a list!')
if(is.null(layout.dim) && length(pList)>1){
layout.dim <- c(2, round(length(pList)/2) )
}
if(is.null(layout.dim) && length(pList) == 1){
layout.dim <- c(1,1)
}
ggpubr::ggarrange(plotlist = pList, ncol = layout.dim[2],
nrow = layout.dim[1], common.legend = common.legend,
legend = legend.position, ...)
}
chooseColors <- function(palettes_name= c("Nature 10", "Light 13", "Classic 20", "Blink 23", "Hue n"), n_colors = 7,
alpha=1, plot_colors=FALSE){
# require(colorspace)
palettes_name <- match.arg(palettes_name)
colors <- if(palettes_name == "Classic 20"){
# require(ggthemes)
# palettes <- ggthemes_data[["tableau"]][["color-palettes"]][["regular"]]
pal1 <- tableau_color_pal(palettes_name)
pal1(n_colors)
}else if(palettes_name == "Nature 10"){
cols <- c("#E04D50", "#4374A5", "#F08A21","#2AB673", "#FCDDDE",
"#70B5B0", "#DFE0EE" ,"#DFCDE4", "#FACB12", "#f9decf")
cols[1:n_colors]
}else if(palettes_name == "Blink 23"){
cols <- c("#c10023", "#008e17", "#fb8500", "#f60000", "#FE0092", "#bc9000","#4ffc00", "#00bcac", "#0099cc",
"#D35400", "#00eefd", "#cf6bd6", "#99cc00", "#aa00ff", "#ff00ff", "#0053c8",
"#f2a287","#ffb3ff", "#800000", "#77a7b7", "#00896e", "#00cc99", "#007CC8")
cols[1:n_colors]
}else if(palettes_name == "Light 13"){
cols <-c( "#FD7446" ,"#709AE1", "#31A354","#9EDAE5",
"#DE9ED6" ,"#BCBD22", "#CE6DBD" ,"#DADAEB" ,
"#FF9896","#91D1C2", "#C7E9C0" ,
"#6B6ECF", "#7B4173" )
cols[1:n_colors]
}else if(palettes_name == "Hue n"){
gg_color_hue(n_colors)
}else{
stop(paste0("chooseColors: check palettes_name! Unsupported palettes_name: ", palettes_name))
}
#require(colorspace)
colors_new = adjust_transparency(colors, alpha = alpha)
if(plot_colors){
barplot(rep(1, length(colors_new)), axes = FALSE, space = 0, col = colors_new)
}
return(colors_new)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.