##' @rdname cnetplot
##' @exportMethod cnetplot
setMethod("cnetplot", signature(x = "enrichResult"),
function(x, ...) {
cnetplot.enrichResult(x, ...)
})
##' @rdname cnetplot
##' @exportMethod cnetplot
setMethod("cnetplot", signature(x = "list"),
function(x, ...) {
cnetplot.enrichResult(x, ...)
})
##' @rdname cnetplot
##' @exportMethod cnetplot
setMethod("cnetplot", signature(x = "gseaResult"),
function(x, ...) {
cnetplot.enrichResult(x, ...)
})
##' @rdname cnetplot
##' @exportMethod cnetplot
setMethod("cnetplot", signature(x = "compareClusterResult"),
function(x, ...) {
cnetplot.compareClusterResult(x, ...)
})
##' @rdname cnetplot
##' @param colorEdge Logical, whether coloring edge by enriched terms, the default value is FALSE.
##' Will be removed in the next version.
##' @param circular Logical, whether using circular layout, the default value is FALSE.
##' Will be removed in the next version.
##' @param node_label Select which labels to be displayed.
##' one of 'category', 'gene', 'all'(the default) and 'none'.
##' @param cex_category Number indicating the amount by which plotting category
##' nodes should be scaled relative to the default, the default value is 1.
##' Will be removed in the next version.
##' @param cex_gene Number indicating the amount by which plotting gene nodes
##' should be scaled relative to the default, the default value is 1.
##' Will be removed in the next version.
##' @param cex_label_category Scale of category node label size, the
##' default value is 1.
##' Will be removed in the next version.
##' @param cex_label_gene Scale of gene node label size, the default value is 1.
##' Will be removed in the next version.
##' @param color_category Color of category node.
##' Will be removed in the next version.
##' @param color_gene Color of gene node.
##' Will be removed in the next version.
##' @param shadowtext select which node labels to use shadow font,
##' one of 'category', 'gene', 'all' and 'none', default is 'all'.
##' @param color.params list, the parameters to control the attributes of highlighted nodes and edges.
##' see the color.params in the following.
##' color.params control the attributes of highlight, it can be referred to the following parameters:
##' \itemize{
##' \item \code{foldChange} Fold Change of nodes for enrichResult, or size of nodes for compareClusterResult,
##' the default value is NULL.
##' \item \code{edge} Logical, whether coloring edge by enriched terms, the default value is FALSE.
##' \item \code{category} Color of category node.
##' \item \code{gene} Color of gene node.
##' }
##' @param cex.params list, the parameters to control the size of nodes and lables.
##' see the cex.params in the following.
##' cex.params control the attributes of highlight, it can be referred to the following parameters:
##' \itemize{
##' \item \code{foldChange} only used in compareClusterResult object, fold Change of nodes, the default value is NULL.
##' If the user provides the Fold Change value of the nodes,
##' it can be used to set the size of the gene node.
##' \item \code{category_node} Number indicating the amount by which plotting category
##' nodes should be scaled relative to the default, the default value is 1.
##' \item \code{gene_node} Number indicating the amount by which plotting gene nodes
##' should be scaled relative to the default, the default value is 1.
##' \item \code{category_label} Scale of category node label size, the
##' default value is 1.
##' \item \code{gene_label} Scale of gene node label size, the default value is 1.
##' }
##' @param hilight.params list, the parameters to control the attributes of highlighted nodes and edges.
##' see the hilight.params in the following.
##' hilight.params control the attributes of highlight, it can be referred to the following parameters:
##' \itemize{
##' \item \code{category} category nodes to be highlight.
##' \item \code{alpha_hilight} alpha of highlighted nodes.
##' \item \code{alpha_no_hilight} alpha of unhighlighted nodes.
##' }
##' @importFrom ggraph geom_edge_arc
##' @importFrom ggplot2 scale_colour_gradient2
##' @importFrom rlang enquo
##' @author Guangchuang Yu
cnetplot.enrichResult <- function(x,
showCategory = 5,
foldChange = NULL,
layout = "kk",
colorEdge = FALSE,
circular = FALSE,
node_label = "all",
cex_category = 1,
cex_gene = 1,
cex_label_category = 1,
cex_label_gene = 1,
color_category = "#E5C494",
color_gene = "#B3B3B3",
shadowtext = "all",
color.params=list(
foldChange = NULL,
edge = FALSE,
category = "#E5C494",
gene = "#B3B3B3"
),
cex.params=list(
category_node = 1,
gene_node = 1,
category_label = 1,
gene_label = 1
),
hilight.params=list(
category = NULL,
alpha_hilight = 1,
alpha_no_hilight = 0.3
),
...) {
label_size_category <- 5
label_size_gene <- 5
node_label <- match.arg(node_label, c("category", "gene", "all", "none"))
params_df <- as.data.frame(rbind(
c("foldChange", "color.params", "foldChange"),
c("colorEdge", "color.params", "edge"),
c("color_category", "color.params", "category"),
c("color_gene", "color.params", "gene"),
c("cex_category", "cex.params", "category_node"),
c("cex_gene", "cex.params", "gene_node"),
c("cex_label_category", "cex.params", "category_label"),
c("cex_label_gene", "cex.params", "gene_label"))
)
colnames(params_df) <- c("original", "listname", "present")
rownames(params_df) <- params_df$original
default.color.params <- list(
foldChange = NULL,
edge = FALSE,
category = "#E5C494",
gene = "#B3B3B3"
)
default.cex.params <- list(
category_node = 1,
gene_node = 1,
category_label = 1,
gene_label = 1
)
default.hilight.params <- list(
category = NULL,
alpha_hilight = 1,
alpha_no_hilight = 0.3
)
# use modifyList to change the values of parameter
color.params <- modifyList(default.color.params, color.params)
cex.params <- modifyList(default.cex.params, cex.params)
hilight.params <- modifyList(default.hilight.params, hilight.params)
params_list <- list(x = x,
showCategory = showCategory,
foldChange = foldChange,
layout = layout,
colorEdge = colorEdge,
circular = circular,
node_label = node_label,
cex_category = cex_category,
cex_gene = cex_gene,
cex_label_category = cex_label_category,
cex_label_gene = cex_label_gene,
color_category = color_category,
color_gene = color_gene,
shadowtext = shadowtext,
color.params = color.params,
cex.params = cex.params,
hilight.params = hilight.params
)
# get all parameters value
args <- as.list(match.call())
removed_params <- intersect(params_df$original, names(args))
if (length(removed_params) > 0) {
for (i in removed_params) {
params_list[[params_df[i, 2]]][[params_df[i, 3]]] <- get(i)
warn <- get_param_change_message(i, params_df)
warning(warn)
}
}
color.params <- params_list[["color.params"]]
cex.params <- params_list[["cex.params"]]
hilight.params <- params_list[["hilight.params"]]
foldChange <- color.params[["foldChange"]]
colorEdge <- color.params[["edge"]]
color_category <- color.params[["category"]]
color_gene <- color.params[["gene"]]
cex_category <- cex.params[["category_node"]]
cex_gene <- cex.params[["gene_node"]]
cex_label_category <- cex.params[["category_label"]]
cex_label_gene <- cex.params[["gene_label"]]
hilight_category <- hilight.params[["category"]]
alpha_hilight <- hilight.params[["alpha_hilight"]]
alpha_nohilight <- hilight.params[["alpha_no_hilight"]]
if (circular) {
layout <- "linear"
geom_edge <- geom_edge_arc
} else {
geom_edge <- geom_edge_link
}
if (is.logical(shadowtext)) {
shadowtext <- ifelse(shadowtext, "all", "none")
}
shadowtext_category <- shadowtext_gene <- FALSE
if (shadowtext == "all") shadowtext_category <- shadowtext_gene <- TRUE
if (shadowtext == "category") shadowtext_category <- TRUE
if (shadowtext == "gene") shadowtext_gene <- TRUE
geneSets <- extract_geneSets(x, showCategory)
g <- list2graph(geneSets)
if (!inherits(x, "list")) {
foldChange <- fc_readable(x, foldChange)
}
size <- sapply(geneSets, length)
V(g)$size <- min(size)/2
n <- length(geneSets)
V(g)$size[1:n] <- size
node_scales <- c(rep(cex_category, n), rep(cex_gene, (length(V(g)) - n)))
# add edge alpha
hilight_category <- intersect(hilight_category, names(geneSets))
if (!is.null(hilight_category) && length(hilight_category) > 0) {
edges <- attr(E(g), "vnames")
E(g)$alpha <- rep(alpha_nohilight, length(E(g)))
hilight_edge <- grep(paste(hilight_category, collapse = "|"), edges)
hilight_gene <- edges[hilight_edge]
hilight_gene <- gsub(".*\\|", "", hilight_gene)
E(g)$alpha[hilight_edge] <- min(0.8, alpha_hilight)
} else {
E(g)$alpha <- rep(0.8, length(E(g)))
}
show_legend <- c(FALSE, TRUE)
names(show_legend) <- c("alpha", "color")
if (colorEdge) {
E(g)$category <- rep(names(geneSets), sapply(geneSets, length))
edge_layer <- geom_edge(aes_(color = ~category, alpha = ~I(alpha)),
show.legend = show_legend)
} else {
edge_layer <- geom_edge(aes_(alpha = ~I(alpha)), colour='darkgrey',
show.legend = FALSE)
}
if (!is.null(foldChange)) {
fc <- foldChange[V(g)$name[(n+1):length(V(g))]]
V(g)$color <- NA
# V(g)$color[1:n] <- color_category
V(g)$color[(n+1):length(V(g))] <- fc
show_legend <- c(TRUE, FALSE)
names(show_legend) <- c("color", "size")
p <- ggraph(g, layout=layout, circular = circular)
p$data[-(1:n), "size"] <- 3 * cex_gene
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
alpha_category <- c(rep(1, n), rep(0, nrow(p$data)-n))
alpha_gene <- c(rep(0, n), rep(1, nrow(p$data)-n))
if (!is.null(hilight_category) && length(hilight_category) > 0) {
alpha_category <- c(rep(alpha_nohilight, n), rep(0, nrow(p$data)-n))
alpha_gene <- c(rep(0, n), rep(alpha_nohilight, nrow(p$data)-n))
alpha_gene[match(hilight_gene, p$data$name)] <- alpha_hilight
alpha_gene[match(hilight_category, p$data$name)] <- alpha_hilight
}
p <- p + edge_layer +
geom_node_point(aes_(size=~size), color=I(color_category),
data = NULL, show.legend = show_legend,
alpha = I(alpha_category)) +
ggnewscale::new_scale_color() +
geom_node_point(aes_(color=~as.numeric(as.character(color)), size=~size),
data = NULL, alpha = I(alpha_gene)) +
scale_size(range=c(3, 8) * cex_category) +
# scale_colour_gradient2(name = "fold change") +
set_enrichplot_color(colors = get_enrichplot_color(3), name = "fold change")
} else {
V(g)$color <- color_gene
V(g)$color[1:n] <- color_category
p <- ggraph(g, layout=layout, circular=circular)
p$data[-(1:n), "size"] <- 3 * cex_gene
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
p <- p + edge_layer +
geom_node_point(aes_(color=~I(color), size=~size, alpha=~I(alpha)))+
scale_size(range=c(3, 8) * cex_category)
}
p <- p + theme_void()
if (node_label == "category") {
p$data[-c(1:n), "name"] <- NA
p <- add_node_label(p = p, data = NULL, label_size_node = label_size_category,
cex_label_node = cex_label_category, shadowtext = shadowtext_category)
} else if (node_label == "gene") {
p$data[1:n, "name"] <- NA
p <- add_node_label(p = p, data = NULL, label_size_node = label_size_gene,
cex_label_node = cex_label_gene, shadowtext = shadowtext_gene)
} else if (node_label == "all") {
p <- add_node_label(p = p, data = NULL,
label_size_node = c(rep(label_size_category, n), rep(label_size_gene, nrow(p$data)-n)),
cex_label_node = c(rep(cex_label_category, n), rep(cex_label_gene, nrow(p$data)-n)),
shadowtext = shadowtext_gene)
}
if (!is.null(foldChange)) {
p <- p + guides(size = guide_legend(order = 1),
color = guide_colorbar(order = 2))
}
return(p + guides(alpha = "none"))
}
##' @param split Separate result by 'category' variable.
##' @param pie Proportion of clusters in the pie chart, one of 'equal' (default) and 'Count'.
##' Will be removed in the next version.
##' @param legend_n Number of circle in legend, the default value is 5.
##' Will be removed in the next version.
##' @param x_loc,y_loc The location of scatterpie legend.
##' Will be removed in the next version.
##' @param pie.params list, the parameters to control the attributes of pie nodes.
##' see the pie.params in the following.
##' pie.params control the attributes of pie nodes, it can be referred to the following parameters:
##' \itemize{
##' \item \code{pie} proportion of clusters in the pie chart, one of 'equal' (default) and 'Count'.
##' \item \code{legend_n} number of circle in legend.
##' \item \code{legend_loc_x, legend_loc_y} The location of scatterpie legend.
##' }
##' @importFrom ggraph geom_edge_arc
##' @noRd
cnetplot.compareClusterResult <- function(x,
showCategory = 5,
foldChange = NULL,
layout = "kk",
circular = FALSE,
node_label = "all",
split=NULL,
pie = "equal",
cex_category = 1,
cex_gene = 1,
legend_n = 5,
x_loc = NULL,
y_loc = NULL,
cex_label_category = 1,
cex_label_gene = 1,
shadowtext = "all",
pie.params = list(
pie = "equal",
legend_n = 5,
legend_loc_x = NULL,
legend_loc_y = NULL
),
cex.params=list(
foldChange = NULL,
category_node = 1,
gene_node = 1,
category_label = 1,
gene_label = 1
),
hilight.params=list(
category = NULL,
alpha_hilight = 1,
alpha_no_hilight = 0.3
),
...) {
label_size_category <- 2.5
label_size_gene <- 2.5
range_category_size <- c(3, 8)
range_gene_size <- c(3, 3)
# change parameter name
##############################################################
params_df <- as.data.frame(rbind(
c("pie", "pie.params", "pie"),
c("legend_n", "pie.params", "legend_n"),
c("x_loc", "pie.params", "legend_loc_x"),
c("y_loc", "pie.params", "legend_loc_y"),
c("foldChange", "cex.params", "foldChange"),
c("cex_category", "cex.params", "category_node"),
c("cex_gene", "cex.params", "gene_node"),
c("cex_label_category", "cex.params", "category_label"),
c("cex_label_gene", "cex.params", "gene_label"))
)
colnames(params_df) <- c("original", "listname", "present")
rownames(params_df) <- params_df$original
default.pie.params <- list(
pie = "equal",
legend_n = 5,
legend_loc_x = NULL,
legend_loc_y = NULL
)
default.cex.params <- list(
foldChange = NULL,
category_node = 1,
gene_node = 1,
category_label = 1,
gene_label = 1
)
default.hilight.params <- list(
category = NULL,
alpha_hilight = 1,
alpha_no_hilight = 0.3
)
# use modifyList to change the values of parameter
pie.params <- modifyList(default.pie.params, pie.params)
cex.params <- modifyList(default.cex.params, cex.params)
hilight.params <- modifyList(default.hilight.params, hilight.params)
params_list <- list(x = x,
showCategory = showCategory,
foldChange = foldChange,
layout = layout,
circular = circular,
node_label = node_label ,
split = split,
pie = pie,
cex_category = cex_category,
cex_gene = cex_gene,
legend_n = legend_n,
x_loc = x_loc,
y_loc = y_loc,
cex_label_category = cex_label_category,
cex_label_gene = cex_label_gene,
shadowtext = shadowtext,
pie.params = pie.params,
cex.params = cex.params,
hilight.params = hilight.params
)
# get all parameters value
args <- as.list(match.call())
removed_params <- intersect(params_df$original, names(args))
if (length(removed_params) > 0) {
for (i in removed_params) {
params_list[[params_df[i, 2]]][[params_df[i, 3]]] <- get(i)
warn <- get_param_change_message(i, params_df)
warning(warn)
}
}
pie.params <- params_list[["pie.params"]]
cex.params <- params_list[["cex.params"]]
hilight.params <- params_list[["hilight.params"]]
pie <- pie.params[["pie"]]
legend_n <- pie.params[["legend_n"]]
x_loc <- pie.params[["legend_loc_x"]]
y_loc <- pie.params[["legend_loc_y"]]
foldChange <- cex.params[["foldChange"]]
cex_category <- cex.params[["category_node"]]
cex_gene <- cex.params[["gene_node"]]
cex_label_category <- cex.params[["category_label"]]
cex_label_gene <- cex.params[["gene_label"]]
# default.hilight.params <- list(
# category = NULL,
# alpha_hilight = 1,
# alpha_no_hilight = 0.3
# )
# hilight.params <- reset_params(defaultp=default.hilight.params,
# inputp=enquo(hilight.params))
hilight_category <- hilight.params[["category"]]
alpha_hilight <- hilight.params[["alpha_hilight"]]
alpha_nohilight <- hilight.params[["alpha_no_hilight"]]
if (is.logical(shadowtext)) {
shadowtext <- ifelse(shadowtext, "all", "none")
}
shadowtext_category <- shadowtext_gene <- FALSE
if (shadowtext == "all") shadowtext_category <- shadowtext_gene <- TRUE
if (shadowtext == "category") shadowtext_category <- TRUE
if (shadowtext == "gene") shadowtext_gene <- TRUE
## If showCategory is a number, keep only the first showCategory of each group,
## otherwise keep the total showCategory rows
# y <- get_selected_category(showCategory, x, split)
y <- fortify(x, showCategory = showCategory,
includeAll = TRUE, split = split)
y$Cluster <- sub("\n.*", "", y$Cluster)
if ("core_enrichment" %in% colnames(y)) { ## for GSEA result
y$geneID <- y$core_enrichment
}
## Data structure transformation, combining the same ID (Description) genes
y_union <- merge_compareClusterResult(y)
hilight_category <- intersect(hilight_category, y$Description)
node_label <- match.arg(node_label, c("category", "gene", "all", "none"))
if (circular) {
layout <- "linear"
geom_edge <- geom_edge_arc
} else {
geom_edge <- geom_edge_link
}
#geneSets <- extract_geneSets(x, showCategory)
geneSets <- setNames(strsplit(as.character(y_union$geneID), "/",
fixed = TRUE), y_union$Description)
n <- length(geneSets)
g <- list2graph(geneSets)
edge_layer <- geom_edge(aes_(alpha = ~I(alpha)), colour='darkgrey',
show.legend = FALSE)
if(is.null(dim(y)) | nrow(y) == 1) {
V(g)$size <- 1
V(g)$size[1] <- 3
V(g)$color <- "#B3B3B3"
V(g)$color[1] <- "#E5C494"
title <- y$Cluster
p <- ggraph(g, layout=layout, circular=circular)
p <- p + edge_layer + theme_void() +
geom_node_point(aes_(color=~I(color), size=~size),
data = p$data[1:n, ]) +
scale_size(range = range_category_size * cex_category) +
ggnewscale::new_scale("size") +
geom_node_point(aes_(color=~I(color), size=~size),
data = p$data[-(1:n), ], show.legend = FALSE) +
scale_size(range = range_gene_size * cex_gene) +
labs(title= title) +
theme(legend.position="none")
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
p <- add_node_label(p = p, data = p$data[-c(1:n),], label_size_node = label_size_gene,
cex_label_node = cex_label_gene, shadowtext = shadowtext_gene)
p <- add_node_label(p = p, data = p$data[1:n,], label_size_node = label_size_category,
cex_label_node = cex_label_category, shadowtext = shadowtext_category)
return(p)
}
if(is.null(dim(y_union)) | nrow(y_union) == 1) {
p <- ggraph(g, "tree") + edge_layer
} else if (length(unique(y$Cluster)) == 1) {
color_category = "#E5C494"
color_gene = "#B3B3B3"
size <- sapply(geneSets, length)
V(g)$size <- min(size)/2
n <- length(geneSets)
V(g)$size[1:n] <- size
V(g)$color <- color_gene
V(g)$color[1:n] <- color_category
if (!is.null(hilight_category) && length(hilight_category) > 0) {
edges <- attr(E(g), "vnames")
E(g)$alpha <- rep(alpha_nohilight, length(E(g)))
hilight_edge <- grep(paste(hilight_category, collapse = "|"), edges)
hilight_gene <- edges[hilight_edge]
hilight_gene <- gsub(".*\\|", "", hilight_gene)
E(g)$alpha[hilight_edge] <- min(0.8, alpha_hilight)
} else {
E(g)$alpha <- rep(0.8, length(E(g)))
}
p <- ggraph(g, layout=layout, circular=circular)
p$data[-(1:n), "size"] <- 3 * cex_gene
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
p <- p + edge_layer +
geom_node_point(aes_(color=~I(color), size=~size, alpha=~I(alpha)))+
scale_size(range=c(3, 8) * cex_category)
} else {
if (!is.null(hilight_category) && length(hilight_category) > 0) {
edges <- attr(E(g), "vnames")
E(g)$alpha <- rep(alpha_nohilight, length(E(g)))
hilight_edge <- grep(paste(hilight_category, collapse = "|"), edges)
hilight_gene <- edges[hilight_edge]
hilight_gene <- gsub(".*\\|", "", hilight_gene)
E(g)$alpha[hilight_edge] <- min(0.8, alpha_hilight)
} else {
E(g)$alpha <- rep(0.8, length(E(g)))
}
p <- ggraph(g, layout=layout, circular=circular) + edge_layer
}
#pie chart begin
#obtain the cluster distribution of each GO term and gene
ID_Cluster_mat <- prepare_pie_category(y, pie=pie)
gene_Cluster_mat <- prepare_pie_gene(y)
if(ncol(ID_Cluster_mat) > 1) {
clusters <- match(colnames(ID_Cluster_mat),colnames(gene_Cluster_mat))
ID_Cluster_mat <- ID_Cluster_mat[,clusters]
gene_Cluster_mat <- gene_Cluster_mat[,clusters]
}
ID_Cluster_mat2 <- rbind(ID_Cluster_mat,gene_Cluster_mat)
#add the coordinates
aa <- p$data
ii <- match(rownames(ID_Cluster_mat2), aa$name)
ID_Cluster_mat2$x <- aa$x[ii]
ID_Cluster_mat2$y <- aa$y[ii]
#add the radius of the pie chart, the radius of go terms mean the number of genes
ii <- match(rownames(ID_Cluster_mat2)[1:n], y_union$Description)
node_scales <- c(rep(cex_category, n), rep(cex_gene, (length(V(g)) - n)))
# sum_yunion <- sum(y_union[ii,9])
sum_yunion <- sum(y_union[ii, "Count"])
sizee <- sqrt(y_union[ii, "Count"] / sum_yunion)
ID_Cluster_mat2$radius <- min(sizee)/2 * sqrt(cex_gene)
ID_Cluster_mat2$radius[1:n] <- sizee * sqrt(cex_category)
if(is.null(x_loc)) x_loc <- min(ID_Cluster_mat2$x)
if(is.null(y_loc)) y_loc <- min(ID_Cluster_mat2$y)
#node_label
if (node_label == "category") {
p$data$name[(n+1):nrow(p$data)] <- ""
} else if (node_label == "gene") {
p$data$name[1:n] <- ""
} else if (node_label == "none") {
p$data$name <- ""
}
if(ncol(ID_Cluster_mat2) > 4) {
## should not have foldChange
if (!is.null(foldChange)) {
log_fc <- abs(foldChange)
genes <- rownames(ID_Cluster_mat2)[(n+1):nrow(ID_Cluster_mat2)]
gene_fc <- rep(1,length(genes))
gid <- names(log_fc)
#Turn the id of gid into gene symbols
ii <- gid %in% names(x@gene2Symbol)
gid[ii] <- x@gene2Symbol[gid[ii]]
ii <- match(genes,gid)
gene_fc <- log_fc[ii]
gene_fc[is.na(gene_fc)] <- 1
gene_fc2 <- c(rep(1,n),gene_fc)
#Assign value to the size of the genes
# ID_Cluster_mat2$radius <- min(sizee)/2*gene_fc2
# ID_Cluster_mat2$radius[1:n] <- sizee
ID_Cluster_mat2$radius <- min(sizee)/2*gene_fc2 * sqrt(cex_gene)
ID_Cluster_mat2$radius[1:n] <- sizee * sqrt(cex_category)
# p <- p + geom_scatterpie(aes_(x=~x,y=~y,r=~radius),
# data=ID_Cluster_mat2,
# cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-3)],
# color=NA) +
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
ID_Cluster_mat2$alpha <- p$data$alpha
p <- p + geom_scatterpie(aes_(x=~x,y=~y,r=~radius,alpha=~I(alpha)),
data=ID_Cluster_mat2[1:n, ],
cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-4)],
color=NA) +
geom_scatterpie_legend(ID_Cluster_mat2$radius[1:n],
x=x_loc, y=y_loc + 3, n = legend_n, labeller=function(x) round(x^2 * sum_yunion / cex_category)) +
geom_scatterpie(aes_(x=~x,y=~y,r=~radius,alpha=~I(alpha)),
data=ID_Cluster_mat2[-(1:n), ],
cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-4)],
color=NA,
show.legend = FALSE) +
coord_equal()+
geom_scatterpie_legend(ID_Cluster_mat2$radius[(n+1):nrow(ID_Cluster_mat2)],
x=x_loc, y=y_loc, n = legend_n,
labeller=function(x) round(x*2/(min(sizee))/sqrt(cex_gene),1)) +
ggplot2::annotate("text", x = x_loc + 3, y = y_loc, label = "log2FC") +
ggplot2::annotate("text", x = x_loc + 3, y = y_loc + 3, label = "gene number")
p <- add_node_label(p = p, data = p$data[-c(1:n),], label_size_node = label_size_gene,
cex_label_node = cex_label_gene, shadowtext = shadowtext_gene)
p <- add_node_label(p = p, data = p$data[1:n,], label_size_node = label_size_category,
cex_label_node = cex_label_category, shadowtext = shadowtext_category)
p <- p + theme_void() + labs(fill = "Cluster")
return(p)
}
## should not have foldChange
# p <- p + geom_scatterpie(aes_(x=~x,y=~y,r=~radius), data=ID_Cluster_mat2,
# cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-3)],
# color=NA) +
# coord_equal()
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
ID_Cluster_mat2$alpha <- p$data$alpha
p <- p + geom_scatterpie(aes_(x=~x,y=~y,r=~radius,alpha=~I(alpha)),
data=ID_Cluster_mat2[1:n, ],
cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-4)], color=NA) +
geom_scatterpie(aes_(x=~x,y=~y,r=~radius,alpha=~I(alpha)),
data=ID_Cluster_mat2[-(1:n), ],
cols=colnames(ID_Cluster_mat2)[1:(ncol(ID_Cluster_mat2)-4)],
color=NA, show.legend = FALSE) +
coord_equal() +
geom_scatterpie_legend(ID_Cluster_mat2$radius[1:n],
x=x_loc, y=y_loc, n = legend_n, labeller=function(x) round(x^2 * sum_yunion / cex_category)) +
ggplot2::annotate("text", x = x_loc + 3, y = y_loc, label = "gene number")
## add node label
p <- add_node_label(p = p, data = p$data[-c(1:n),], label_size_node = label_size_gene,
cex_label_node = cex_label_gene, shadowtext = shadowtext_gene)
p <- add_node_label(p = p, data = p$data[1:n,], label_size_node = label_size_category,
cex_label_node = cex_label_category, shadowtext = shadowtext_category)
p <- p + theme_void() + labs(fill = "Cluster")
return(p)
}
title <- colnames(ID_Cluster_mat2)[1]
# V(g)$size <- ID_Cluster_mat2$radius
# V(g)$color <- "#B3B3B3"
# V(g)$color[1:n] <- "#E5C494"
p <- node_add_alpha(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight)
p <- add_node_label(p = p, data = p$data[-c(1:n),], label_size_node = label_size_gene,
cex_label_node = cex_label_gene, shadowtext = shadowtext_gene)
p <- add_node_label(p = p, data = p$data[1:n,], label_size_node = label_size_category,
cex_label_node = cex_label_category, shadowtext = shadowtext_category) + theme_void()
if (length(unique(y$Cluster)) > 1) {
p <- p + theme(legend.position="none")
}
p
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.