Related
I want to make a legend for the color annotation blocks at right-side of the complexheatmap graph
library(ComplexHeatmap)
x11()
#list = c("R","H","K","D",'E','S','T','N','Q','C','G','P','A','V','I','L','M','F','Y','W','O','U','B','Z','X','J')
A = rep("group1", 26)
A[4:5] = "group2"
A[6:9] = "group3"
A[10:12] = "group4"
A[13:20] = "group5"
A[21:26] = "group6"
rnames <- c("+","+","+", "-", "-","δ","δ","δ","δ", "*","*","*","h","h","h","h","h","h","h","h","u","u","u","u","u","u")
ha = rowAnnotation(foo = anno_block(gp = gpar(fill = 2:7)), annotation_legend_param = list(foo = list(labels = c("+ve", "-ve", "polar", "special","hydrophobic","unique"))))
names(rnames) = unique(A)
ht = Heatmap(data2,
name = "Occurance",
cluster_rows = FALSE,
cluster_columns = FALSE,
column_title = "Amino Acid Occurance in Overlapped Region in LCD in Known RBP genes",
row_title = "AA",
column_names_gp = gpar(fontsize = 10),
row_title_gp = gpar(fontsize = 20),
column_names_rot = 90,
row_split = A,
right_annotation = ha,
row_names_side = "left",
row_names_gp = gpar(fontsize = 10),
heatmap_width = unit(12, "cm"),
heatmap_height = unit(12, "cm")
)
ht
and the result of graph is shown at below
As you can see there are 6 different color annotation block shown at right side, I want to make the legend for these 6 block named in order as "+ve", "-ve", "polar", "special","hydrophobic" and "unique". However, the above codes only result in an error of 'Error: Amount of legend params is larger than the number of simple annotations.'
Can anyone tell me and teach me how to do it?
I am creating forest plots using the meta package in R. I have added a line of text using text.addline1 (see bottom of plot). How do I make that text bold? It says see "gpar" in the cran documentation but I can't work it out.
library(meta)
## make data
df1 <- data.frame(matrix(, nrow=14, ncol=6))
colnames(df1) <- c("estimate", "std.error", "N", "study", "Exposure", "or" )
df1$estimate <- c("1.0588634", "1.0210044", "1.0484577", "0.9872621", "1.0122652",
"0.9934573", "0.9429622", "1.0320382", "0.9654555", "1.0499671", "1.0400071",
"1.0208341", "0.9954885", "0.9879208")
df1$std.error <- c(0.054092871, 0.037674050, 0.093067276, 0.054198110, 0.008714173, 0.010266589,
0.056993648, 0.058017078, 0.058050610, 0.089878607, 0.056951120, 0.011041428,
0.013533755, 0.090526260)
df1$N <- 500
df1$study <- "Study"
df1$Exposure <- "Smoker"
df1$Exposure[7:14] <- "Non smoker"
df1$or <- c(0.057196058, 0.020786829, 0.047320225, -0.012819723, 0.012190549, -0.006564245,
-0.058729114, 0.031535708, -0.035155279, 0.048758876, 0.039227559, 0.020620087,
-0.004521733, -0.012152786)
meta_obj <- metagen(or, std.error, sm = "OR", data = df1,
studlab = study, comb.fixed = TRUE, comb.random = FALSE, byvar = Exposure)
# FOREST ------------------------------------------------------------------
forest(meta_obj, smlab = "Text here", spacing = 1.5,
xlab = "Odds ratio",
xlim = c(0.5, 2),
leftcols = c("studlab", "N"),
col.diamond = "red", col.by = "black",
overall.hetstat = FALSE,
print.I2 = TRUE, print.tau2 = FALSE,
subgroup = T, overall = F,
text.addline1 = "HOW DO I MAKE THIS BOLD?",
ref = 1)
See argument 'ff.addline':
forest(meta_obj, smlab = "Text here", spacing = 1.5,
xlab = "Odds ratio",
xlim = c(0.5, 2),
leftcols = c("studlab", "N"),
col.diamond = "red", col.by = "black",
overall.hetstat = FALSE,
print.I2 = TRUE, print.tau2 = FALSE,
subgroup = T, overall = F,
ref = 1,
text.addline1 = "USE ARGUMENT 'ff.addline = \"bold\"'",
ff.addline = "bold",
fs.addline = 12,
colgap.left = "2.8cm")
I am conducting "convergent cross mapping" analysis for a multivariate data series. Unfortunately, I am struggeling with the function "ccm_means" of the R-package "rEDM". It is "deprecated" and I did not find a proper alternative so far. Do you know any alternative package or function for conducting CCM = convergent cross mapping analysis?
Explicitely, I am talking about this piece of code:
library(rEDM)
data(sardine_anchovy_sst)
anchovy_xmap_sst <- ccm(sardine_anchovy_sst, E = 3, lib_column = "anchovy",
target_column = "np_sst", lib_sizes = seq(10, 80, by = 10), num_samples = 100,
random_libs = TRUE, replace = TRUE, silent = TRUE)
sst_xmap_anchovy <- ccm(sardine_anchovy_sst, E = 3, lib_column = "np_sst", target_column = "anchovy",
lib_sizes = seq(10, 80, by = 10), num_samples = 100, random_libs = TRUE,
replace = TRUE, silent = TRUE)
str(anchovy_xmap_sst)
a_xmap_t_means <- ccm_means(anchovy_xmap_sst)
t_xmap_a_means <- ccm_means(sst_xmap_anchovy)
#####--------> ERROR POPS UP HERE
plot(a_xmap_t_means$lib_size, pmax(0, a_xmap_t_means$rho), type = "l", col = "red",
xlab = "Library Size", ylab = "Cross Map Skill (rho)", ylim = c(0, 1))
lines(t_xmap_a_means$lib_size, pmax(0, t_xmap_a_means$rho), col = "blue")
legend(x = "topleft", legend = c("anchovy xmap SST", "SST xmap anchovy"), col = c("red",
"blue"), lwd = 1, bty = "n", inset = 0.02, cex = 0.8)*
Thank you very much for ur help.
KR,
Chris
I like the package EnhancedVolcano. My data is RNAseq and I analyse it with DESeq2. I want to plot the results as a volcanoplot where I highlight a list of genes of my choice picked_genes. I have succeded in changing pointSize and I am using SelectLab to highlight but when I want to give the chosen genes another color I get stuck. I have added a logical vector to my results file specifying which genes to highlight. I have tried
col = ifelse...
It doesn't work, all dots are grey.
EnhancedVolcano(res_complete,
lab = res_complete$gene_name,
x = "log2FoldChange",
y = "pvalue",
pCutoff = 10e-3,
FCcutoff = 1,
xlim = c(-10, 10),
ylim = c(0, -log10(10e-12)),
col = (ifelse(res_complete$picked_genes == T, "forestgreen", "grey60")),
pointSize = (ifelse(res_complete$picked_genes == T, 5, 0.5)),
labSize = 2.5,
selectLab = picked_genes,
shape = 16,
shade = res_complete$picked_genes == T,
shadeFill = "forestgreen",
shadeSize = 5,
shadeLabel = res_complete$picked_genes,
boxedLabels = TRUE,
title = "DESeq2 results",
subtitle = "Differential expression HC vs RA",
caption = "FC cutoff, 1; p-value cutoff, 10e-3",
legendPosition = "right",
legendLabSize = 14,
colAlpha = 0.9,
drawConnectors = TRUE,
hline = c(10e-8),
widthConnectors = 0.2)
I have also tried:
colCustom =ifelse...
But I get an error message...
Error: Aesthetics must be either length 1 or the same as the data (58735): colour
EnhancedVolcano(res_complete,
lab = res_complete$gene_name,
x = "log2FoldChange",
y = "pvalue",
pCutoff = 10e-3,
FCcutoff = 1,
xlim = c(-10, 10),
ylim = c(0, -log10(10e-12)),
colCustom = (ifelse(res_complete$picked_genes == T, "forestgreen", "grey60")),
pointSize = (ifelse(res_complete$picked_genes == T, 5, 0.5)),
labSize = 2.5,
selectLab = picked_genes,
shape = 16,
shade = res_complete$picked_genes == T,
shadeFill = "forestgreen",
shadeSize = 5,
shadeLabel = res_complete$picked_genes,
boxedLabels = TRUE,
title = "DESeq2 results",
subtitle = "Differential expression HC vs RA",
caption = "FC cutoff, 1; p-value cutoff, 10e-3",
legendPosition = "right",
legendLabSize = 14,
colAlpha = 0.9,
drawConnectors = TRUE,
hline = c(10e-8),
widthConnectors = 0.2)
Can someone come up with a solution to this problem?
I found it, finally I understood it. colCustom needs a pair for each point, a color and a name. I created the matrix keyvals
keyvals <- ifelse(
res_complet$picked_genes < T, 'grey60',
'forestgreen')
names(keyvals)[keyvals == 'forestgreen'] <- 'picked'
names(keyvals)[keyvals == 'grey60'] <- 'rest'
`
Than I used it to replace the col=
`
EnhancedVolcano(res_complete,
lab = res_complete$gene_name,
x = "log2FoldChange",
y = "pvalue",
pCutoff = 10e-3,
FCcutoff = 1,
xlim = c(-10, 10),
ylim = c(0, -log10(10e-12)),
pointSize = (ifelse(res_complete$picked_genes == T, 5, 0.5)),
labSize = 2.5,
shape = c(19, 19, 19, 19),
selectLab = picked_genes,
boxedLabels = TRUE,
title = "DESeq2 results",
subtitle = "Differential expression HC vs RA",
caption = "FC cutoff, 1; p-value cutoff, 10e-3",
legendPosition = "right",
legendLabSize = 14,
colCustom = keyvals,
colAlpha = 0.9,
drawConnectors = TRUE,
hline = c(10e-8),
widthConnectors = 0.2)
`
In order to get all points visible I sorted my results dataframe after the logical column res_complete$picked_genes and made the volcano again. Voilá
How to label edges in ggplot's geom_net library?
library(geomnet)
library(ggplot2)
x <- structure(list(from = c("a", "b", "d", "f", "g", "e", "c", "i",
"e", "h", "i", "i", "j", "j"), to = c("", "", "", "", "", "a",
"b", "c", "d", "e", "f", "g", "h", "i"), edge_val = c(NA, NA,
NA, NA, NA, 1.6, 2.25, 1.75, 0.95, 1.8, 3.2, 2.6, 2.95, 2.45)), .Names = c("from",
"to", "edge_val"), class = "data.frame", row.names = c(NA, -14L
))
ggplot(x, aes(from_id = from, to_id = to, linewidth = edge_val)) +
geom_net(layout.alg = "fruchtermanreingold", labelgeom = "text",repel = TRUE,
size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
directed = FALSE, fontsize = 4, ealpha = 0.5) +
theme_net()
The idea would be to plot the edge value on the edges as:
I made some modifications to the code used for geom_net() (found here). It can be used like this:
# similar code as question, with linelabel = edge_val added to aes() & geom_net2
ggplot(x,
aes(from_id = from, to_id = to, linewidth = edge_val, linelabel = edge_val)) +
geom_net2(layout.alg = "fruchtermanreingold", labelgeom = "text", repel = TRUE,
size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
directed = FALSE, fontsize = 4, ealpha = 0.5) +
theme_net()
To create geom_net2():
Step 1: Create a modified version of the draw_panel function used by geomnet::GeomNet, with line labels if aes(...) includes a mapping for linelabel.
old.draw_panel <- environment(GeomNet$draw_panel)$f
new.draw_panel <- old.draw_panel
# convert function body to a list, for easier code chunk insertions
body(new.draw_panel) <- as.list(body(new.draw_panel))
# geomnet code includes usage of %||%, which is an unexported function
# (it is identical to the exported version in rlang / purrr, so you can skip
# this step if you have one of those packages loaded)
body(new.draw_panel) <-
append(body(new.draw_panel),
substitute(
"%||%" <- function(a, b) {if (!is.null(a)) a else b}
), after = 1)
# remove the last chunk of code, which returns a grobTree for the geom layer
# (we'll add on a new grobTree later)
body(new.draw_panel) <-
body(new.draw_panel)[-length(body(new.draw_panel))]
# define label_line as NULL
body(new.draw_panel) <-
append(body(new.draw_panel),
substitute(
label_line <- NULL
))
# if aes(...) includes a mapping for linelabel, use it for label_line, positioned at the
# midpoint of each line
body(new.draw_panel) <-
append(body(new.draw_panel),
substitute(
if (!is.null(data$linelabel)){
label_line.df <- subset(data, to != "")
label_line.df$x <- (label_line.df$x + label_line.df$xend) / 2
label_line.df$y <- (label_line.df$y + label_line.df$yend) / 2
label_line.df$label <- label_line.df$linelabel
label_line <- ggplot2::GeomText$draw_panel(label_line.df,
panel_scales, coord)
}
))
# return a grobTree, with label_line added
body(new.draw_panel) <-
append(body(new.draw_panel),
substitute(
ggplot2:::ggname("geom_net2",
grid::grobTree(edges_draw, selfies_draw, selfies_arrows,
GeomPoint$draw_panel(vertices, panel_scales, coord),
label_grob, label_line))
))
body(new.draw_panel) <- as.call(body(new.draw_panel))
rm(old.draw_panel)
Step 2: Create GeomNet2 ggproto, which inherits from geomnet::GeomNet, but uses the modified draw_panel function.
GeomNet2 <- ggproto(`_class` = "GeomNet2",
`_inherit` = geomnet::GeomNet,
draw_panel = new.draw_panel)
Step 3: Create geom_net2 function, which is similar to geomnet::geom_net, except that it uses GeomNet2 as its geom.
geom_net2 <- function (
mapping = NULL, data = NULL, stat = "net", position = "identity", show.legend = NA,
na.rm = FALSE, inherit.aes = TRUE, layout.alg="kamadakawai", layout.par=list(),
directed = FALSE, fiteach=FALSE, selfloops = FALSE, singletons = TRUE, alpha = 0.25,
ecolour=NULL, ealpha=NULL, arrow=NULL, arrowgap=0.01, arrowsize=1, labelon=FALSE,
labelcolour=NULL, labelgeom = 'text', repel = FALSE,
vertices=NULL, ...) {
ggplot2::layer(
geom = GeomNet2, mapping = mapping, data = data, stat = stat,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, layout.alg=layout.alg, layout.par=layout.par,
fiteach=fiteach, labelon=labelon, labelgeom=labelgeom, ecolour = ecolour,
ealpha=ealpha, arrow=arrow, arrowgap=arrowgap, directed=directed, repel=repel,
arrowsize=arrowsize, singletons=singletons, labelcolour=labelcolour,
vertices=vertices, selfloops = selfloops,
...)
)
}
You can use the ggplot_build object to get the positions for the text labels. You need to set the seed so that the plot is not redrawn with a new layout.
library(geomnet)
library(ggplot2)
set.seed(1)
p <- ggplot(x, aes(from_id = from, to_id = to, linewidth = edge_val)) +
geom_net(layout.alg = "fruchtermanreingold", labelgeom = "text",repel = TRUE,
size = 4, labelon = TRUE, vjust = -1, ecolour = "grey80",
directed = FALSE, fontsize = 4, ealpha = 0.5) +
theme_net()
# grab plot data
g <- ggplot_build(p)
edgeData <- subset(g$data[[1]], !is.na(linewidth))
# draw labels
# x and y coords are mid between vertices
set.seed(1) # use the same seed
p + geom_text(data=edgeData,
aes(x=(xend+x)/2, y=(yend+y)/2, label=linewidth),
inherit.aes = FALSE)
If it's not compulsory geomnet package, we can take a look to ggraph package.
Here something to think about:
library(tidyverse)
library(tidytext)
library(tidygraph)
library(ggraph)
library(ggrepel)
# first we have to give to ggraph data as it likes:
edges <- x[-c(1:5),] # edges
colnames(edges) <- c('a','b','edge_val') # colnames
# second the nodes, taking all the nodes in the edges. You can also give them a weight.
nodes <- rbind(data.frame(node = edges$a, n = 1),data.frame(node = edges$b, n = 1)) %>% group_by(node) %>% summarise(n = sum(n))
Now you have to avoid a possible bug in the package, as stated here:
# here the fix
edges$a <- match(edges$a, nodes$node)
edges$b <- match(edges$b, nodes$node)
# you have to give to the graph data in this way
tidy <- tbl_graph(nodes = nodes, edges = edges, directed = T)
tidy <- tidy %>%
activate(nodes)
# lastly, the plot
set.seed(1)
ggraph(tidy, layout = "gem") +
geom_node_point(aes(size=1, color = 1)) +
geom_edge_link(alpha = 0.8,aes(label = edge_val)) +
scale_edge_width(range = c(0.2, 2)) +
geom_text_repel(aes(x = x, y=y , label=node), size = 6) +
# here some warnings about font...
theme_graph()