How to remove dots ggwithinstats in the package ggstatsplot - r

I use the example from the site, but I want to remove the points so that only the connection of the medians remains.
My code.
# for reproducibility
set.seed(123)
library(ggstatsplot)
df_disgust <- dplyr::filter(bugs_long, condition %in% c("LDHF", "HDHF"))
p2 <-
ggstatsplot::ggwithinstats(
data = df_disgust,
x = condition,
y = desire,
xlab = "Condition",
ylab = "Desire to kill bugs",
type = "np",
conf.level = 0.99,
title = "Non-parametric Test",
package = "ggsci",
palette = "uniform_startrek",
point.args = list(size = 0, alpha = 0.5),
point.path = FALSE,
centrality.plotting = TRUE,
outlier.tagging = T,
ggtheme = ggthemes::theme_map()
)
ggstatsplot::combine_plots(
plotlist = list(p2),
plotgrid.args = list(nrow = 2),
annotation.args = list(
title = "Effect of disgust on desire to kill bugs ",
caption = "Source: Bugs dataset from `jmv` R package"
)
)
The parameter that is responsible for the points, as I understood point.args = list(size = 3, alpha = 0.5),but when I set size = 0 the dots don't disappear.
I didn't find any other parameters that would be responsible for the points

You can just set the transparency for respective geometric layers to 0.
library(ggstatsplot)
df_disgust <- dplyr::filter(bugs_long, condition %in% c("LDHF", "HDHF"))
ggwithinstats(df_disgust,
condition,
desire,
point.args = list(alpha = 0),
centrality.point.args = list(alpha = 0),
point.path = FALSE
)
grouped_ggwithinstats(df_disgust,
condition,
desire,
grouping.var = gender,
point.args = list(alpha = 0),
centrality.point.args = list(alpha = 0),
point.path = FALSE
)
Created on 2022-05-13 by the reprex package (v2.0.1.9000)

Related

How to make a legend based on the color annotation blocks?

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?

How to make extra line of text using text.addline1 bold using the meta package in R?

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")

R package "rEDM": ccm_means function for convergent cross mapping?

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

How can I highlight specific genes in Bioconductor Enhancedvolcano?

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á

Label edges in geom_net in r

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()

Resources