Positioning nodes and edges in network graph using ggraph/ggplot2 - r

I'm trying to plot a network with ggraph and I'd like to add a circle around the graph, with the edges and nodes lying centered inside the circle.
Drawing the circle works just fine with the following code (adapted from Draw a circle with ggplot2)
gg_circle <- function(r, xc, yc, color = "black", fill = NA, lty = NA, size = NA, ...) {
x <- xc + r*cos(seq(0, pi, length.out = 100))
ymax <- yc + r*sin(seq(0, pi, length.out = 100))
ymin <- yc + r*sin(seq(0, -pi, length.out = 100))
annotate("ribbon", x = x, ymin = ymin, ymax = ymax,
color = color, fill = fill, lty = lty, size = size, ...)
}
But I can't manage to match the position of the network layer(s) with the position of the circle, which results in both nodes and edges lying partially outside the circle:
That's the crucial part of the code as it is right now (using highschool from ggraph as an example dataset for reproducibility purposes):
library(ggraph)
library(igraph)
graph <- graph_from_data_frame(highschool)
ggraph(graph, layout = "fr") +
geom_edge_link() +
geom_node_point() +
geom_node_text(aes(label = name),
check_overlap = TRUE, repel = TRUE,
nudge_x = 0.1, nudge_y = 0.1) +
gg_circle(r = 11, xc = 0, yc = 0, lty = 1, size = 0.2) +
theme(axis.ticks.length = unit(0, "cm"),
legend.position = "none",
plot.margin = unit(c(0, 0, 0, 0), "cm"),
panel.spacing = unit(c(0, 0, 0, 0), "cm")) +
coord_fixed()
Any ideas or suggestions on how to fix this? Thanks in advance!

I would try to use the node positions to find acceptable values for r, xc, and yc.
Step 1. Create plot (without the circle):
set.seed(9) # for reproducibility
p <- ggraph(graph, layout = "fr") +
geom_edge_link() +
geom_node_point() +
geom_node_text(aes(label = name),
check_overlap = TRUE,
repel = TRUE,
nudge_x = 0.1,
nudge_y = 0.1) +
theme(axis.ticks.length = unit(0, "cm"),
legend.position = "none",
plot.margin = unit(c(0, 0, 0, 0), "cm"),
panel.spacing = unit(c(0, 0, 0, 0), "cm")) +
coord_fixed()
Step 2. Get data from the plot's geom_node_point() layer (the 2nd layer in this case). Modify the gg_circle code to take this dataframe as input, & calculate the appropriate circle centre coordinates / radius:
p.positions <- layer_data(p, i = 2L)
gg_circle_from_position <- function(data,
color = "black", fill = NA,
lty = NA, size = NA, ...){
coord.x <- data[, 'x']
coord.y <- data[, 'y']
xc = mean(range(coord.x))
yc = mean(range(coord.y))
r = max(sqrt((coord.x - xc)^2 + (coord.y - yc)^2)) * 1.05
# expand radius by 5% so that no node sits exactly on the line;
# increase from 1.05 to some larger number if more buffer is desired.
# no change to this part
x <- xc + r*cos(seq(0, pi, length.out = 100))
ymax <- yc + r*sin(seq(0, pi, length.out = 100))
ymin <- yc + r*sin(seq(0, -pi, length.out = 100))
annotate("ribbon", x = x, ymin = ymin, ymax = ymax,
color = color, fill = fill, lty = lty, size = size, ...)
}
Step 3. Add circle to plot:
p + gg_circle_from_position(data = p.positions, lty = 1, size = 0.2)

Related

Plotting angular data in ggplot

I have a set of angles that I want to plot, compare and visualise in a circular scale and then patch them into a comparative figure panel. I understand the plot function does what I want for an individual dataset. However, I have multiple of them and want to compare and visualise them with better aesthetics (like in ggplots). Primarily I want to overlay 2 circles on each other and compare them. Here is a sample of my data
a<-c(289.25, 279.61, 288.09, 208.22, 295.74, 214.48, 192.51, 269.93, 225.89, 215.65)
a
ap<-circular(a, template = "geographics", modulo = "2pi")
plot(ap)
arrows.circular(ap, col = "blue", length = 0.25, angle = 30)
enter image description here
I tried the as.ggplot function from the ggplotify package as suggested here. However, I cannot add arrows or layers to my base plot by using as.ggplot (i.e) It converts the plot(ap)part in my example into a ggplot object but the next part (arrows.circular(ap, col = "blue", length = 0.25, angle = 30) is not working.
Is there a way I can draw these plots in ggplot or is there a way to convert the layers of base plots into ggplots using as.ggplot??
Any suggestions would be helpful. Thanks in advance!
You can recreate the plot using ggplot like this:
library(ggplot2)
ggplot(data.frame(a = a %% (2 * pi))) +
geom_segment(aes(x = a, xend = a, y = 0, yend = 1), color = 'blue',
arrow = arrow()) +
geom_hline(yintercept = 1) +
annotate('text', x = 0:3 * pi/2, y = 0.9, label = c('N', 'E', 'S', 'W'),
size = 5) +
geom_point(aes(x = a, y = 1)) +
scale_x_continuous(limits = c(0, 2 * pi)) +
coord_polar() +
theme_void()
And it's certainly possible to alter its appearance to make it look a bit 'softer' and more professional, though this is of course a matter of taste:
library(ggplot2)
ggplot(data.frame(a = a %% (2 * pi))) +
annotate('rect', xmin = -Inf, xmax = Inf, ymin = 0, ymax = 1,
fill = 'gray97') +
geom_hline(yintercept = 1, color = 'gray60') +
geom_segment(aes(x = a, xend = a, y = 0, yend = 1),
color = 'deepskyblue4', size = 1, alpha = 0.5,
arrow = arrow(angle = 25, length = unit(4, 'mm'))) +
annotate('text', x = 0:3 * pi/2, y = 0.9, label = c('N', 'E', 'S', 'W'),
size = 7, fontface = 2, color = 'gray30') +
geom_point(aes(x = a, y = 1)) +
scale_x_continuous(limits = c(0, 2 * pi)) +
coord_polar() +
theme_void() +
theme(plot.background = element_rect(color = NA, fill = '#ecf1f4'))

annotate ggplot above plot

I tried lately to annotate a graph with boxes above a ggplot.
Here is what I want:
I found a way using grid, but I find it too complicated, and I am quite sure there is a better way to do it, more ggplot2 friendly. Here is the example and my solution:
the data:
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
plot
the main plot
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)+
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"))+
coord_cartesian(clip = 'off')
the annotation part
Here is the part I am not happy with:
for (i in 1:dim(mesure_pol)[1]) {
text <- textGrob(label = mesure_pol[i,"politique"], gp = gpar(fontsize=7,fontface="bold"),hjust = 0.5)
rg <- rectGrob(x = text$x, y = text$y, width = stringWidth(text$label) - unit(3,"mm") ,
height = stringHeight(text$label) ,gp = gpar(fill=colorpal[i],alpha = 0.3))
p <- p + annotation_custom(
grob = rg,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"]) +
annotation_custom(
grob = text,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"])
}
Is there a simplier/nicer way to obtain similar result ? I tried with annotate, label but without any luck.
An alternative approach to achieve the desired result would be to make the annotations via a second ggplot which could be glued to the main plot via e.g. patchwork.
For the annotation plot I basically used your code for the main plot, added a geom_text layer, get rid of the axix, etc. via theme_void and set the limits in line with main plot. Main difference is that I restrict the y-axis to a 0 to 1 scale. Besides that I shifted the xmin, xmax, ymin and ymax values to add some space around the rectangels (therefore it is important to set the limits).
library(ggplot2)
library(patchwork)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)
ann <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1 + 1,
xmax = x2 - 1,
ymin = 0.2,
ymax = 0.8,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2) +
geom_text(aes(x = x_median, y = .5, label = politique), vjust = .8, fontface = "bold", color = "black") +
coord_cartesian(xlim = c(1, 10), ylim = c(0, 1)) +
theme_void()
ann / p +
plot_layout(heights = c(1, 4))
By setting a second x-axis and filling the background of the new axis labels with element_markdown from the ggtext package. You may achieve this:
Here is the code:
library(ggtext)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = c("yellow", "red", "black"),
color = "black",
size = 0.3,
alpha = 0.2) +
scale_x_continuous(sec.axis = dup_axis(name = "",
breaks = c(2.5, 5.5, 8.5),
labels = c("Phase 1", "Phase 2", "Phase 3"))) +
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"),
axis.ticks.x.top = element_blank(),
axis.text.x.top = element_markdown(face = "bold",
size = 12,
fill = adjustcolor(c("yellow", "red", "black"),
alpha.f = .2)))+
coord_cartesian(clip = 'off')

Blend Colours from Different Layers

I'm trying to create a Venn diagram where each circle has a unique colour, and the intersections blend those colours.
I can make the circles with the ggforce package. And I can blend the colours by setting the alpha values to, say, 0.75:
library(ggplot2)
library(ggforce)
propositions <- data.frame(
cirx = c(-.75 , .75),
ciry = c(0 , 0),
r = c(1.5 , 1.5),
labx = c(-2.25 , 2.25),
laby = c(1 , 1),
labl = c("A", "B")
)
ggplot(propositions) +
theme_void() + coord_fixed() +
xlim(-3,3) + ylim(-2,2) +
theme(panel.border = element_rect(colour = "black", fill = NA, size = 1)) +
geom_circle(aes(x0 = cirx, y0 = ciry, r = r), fill = "red", alpha = .6, data = propositions[1,]) +
geom_circle(aes(x0 = cirx, y0 = ciry, r = r), fill = "blue", alpha = .6, data = propositions[2,]) +
geom_text(aes(x = labx, y = laby, label = labl),
fontface = "italic", size = 10, family = "serif")
But the results are pretty poor:
The colours are washed out, and the intersection's colour isn't as distinct from the right-side circle's as I'd like. I want something closer to this (photoshopped) result:
I could do this if there was some way to designate and fill the intersection. In principle, this could be done with geom_ribbon(), I think. But that seems painful, and hacky. So I'm hoping for a more elegant solution.
Here's the workaround using geom_ribbon(). It's not a proper solution though, since it won't generalize to other shapes and intersections without manually redefining the boundaries of the ribbon, which can get real hairy fast.
There's gotta be a way to get ggplot2 to automatically do the work of blending colours across layers, right?
library(ggplot2)
library(ggforce)
x <- seq(-.75, .75, 0.01)
upper <- function(x) {
a <- sqrt(1.5^2 - (x[x < 0] - .75)^2)
b <- sqrt(1.5^2 - (x[x >= 0] + .75)^2)
c(a,b)
}
lower <- function(x) {
-upper(x)
}
ggplot() +
coord_fixed() + theme_void() +
xlim(-3,3) + ylim(-2,2) +
geom_circle(aes(x0 = -.75, y0 = 0, r = 1.5), fill = "red") +
geom_circle(aes(x0 = .75, y0 = 0, r = 1.5), fill = "blue") +
geom_ribbon(aes(x = x, ymin = upper(x), ymax = lower(x)), fill = "purple", colour = "black") +
theme(panel.border = element_rect(colour = "black", fill = NA, size = 1)) +
geom_text(aes(x = c(-2.25, 2.25), y = c(1, 1), label = c("A", "B")),
fontface = "italic", size = 10, family = "serif")

Turning off ggplot clipping deletes line segment

I'm trying to draw some arrows in the margin of a ggplot. From what I've read, you have to turn off the plot clipping to do that. However, when I do that, it deletes a line segment I have on my graph.
library(ggplot2)
library(ggrepel)
library(grid)
#----------------- Fake data practice --------------------- #
mydata <- data.frame(Labels = letters[1:14],
X_Values = seq(1, 14, 1),
Y_Values = rnorm(14, mean = 0, sd = 1),
Influence = seq(1, 14, 1))
mydata$Influencer <- factor(ifelse(mydata$Influence <= 3, 1, 0))
# --- Get min/max from data and use to set range at -1to1 or -2to2
chartMax <- ifelse(min(mydata$Y_Values) < -1 | max(mydata$Y_Values) > 1, 2, 1)
chartMin <- ifelse(chartMax == 1, -1, -2)
yTitle = "Some Title"
# --- Label setting, if greater than 0 nudge up, else nudge down
mydata$Nudger <- ifelse(mydata$Y_Values >= 0, .1, -.1)
p <- ggplot(mydata, aes(x = X_Values, y = Y_Values, group = Influencer)) +
geom_point(aes(size = Influencer, color = Influencer), shape = 18) +
geom_segment(x = 0, xend = 14, y = 0, yend = 0, color = "red", linetype = "dashed", size = 1.2, alpha = .5) +
geom_text_repel(aes(x = X_Values, y = Y_Values, label = Labels),
box.padding = .4,
point.padding = .2,
nudge_y = .1) +
scale_color_manual(values = c("grey", "blue")) +
scale_size_manual(values = c(4, 6)) +
scale_y_continuous(name = "", limits = c(chartMin, chartMax)) +
scale_x_continuous(name = yTitle,
limits = c(1, 15),
breaks = c(2,13),
labels = c("Lower", "Higher")) +
theme_classic() + theme(plot.margin = unit(c(1,3,1,2), "lines"),
legend.position="none",
axis.ticks.x=element_blank(),
axis.text.x = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
axis.line.x = element_line(color = "blue"
,size = 1
,arrow =
arrow(length = unit(0.5, "cm"),
ends = "both"))) +
annotation_custom(
grob = linesGrob(arrow=arrow(type="open", ends="both", length=unit(0.5, "cm")), gp=gpar(col="blue", lwd=2)),
xmin = -1.4, xmax = -1.4, ymin = chartMin, ymax = chartMax
)
p
# Here it works and you see the red dashed line
# Turn off panel clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)
Ideally, I want a blue arrow that runs alongside the y-axis in the margins. I think I've got that, but I can't loose my dashed red line that runs along the inside the graph.
I can't explain why this is happening (seems like a bug, I suggest raising an issue here), but I can confirm that the issue is related to the line alpha. If we delete the alpha = 0.5 argument from geom_segment then the clipping=off works without deleting the line:

Creating a half-donut, or parliamentary seating, chart

I'd like to create a chart displaying the size of the seats to a parliament, such as the one below, in ggplot2. My main problem is, essentially, how do I turn a donut chart to a half-donut chart (half-circle arc)?
Using the picture above as an example, I don't know where to go from here:
df <- data.frame(Party = c("GUE/NGL", "S&D", "Greens/EFA", "ALDE", "EPP", "ECR", "EFD", "NA"),
Number = c(35, 184, 55, 84, 265, 54, 32, 27))
df$Party <- factor(df$Party)
df$Share <- df$Number / sum(df$Number)
df$ymax <- cumsum(df$Share)
df$ymin <- c(0, head(df$ymax, n= -1))
ggplot(df, aes(fill = Party, ymax = ymax, ymin = ymin, xmax = 2, xmin = 1)) + geom_rect() +
coord_polar(theta = "y") + xlim(c(0, 2))
To get labels etc you can use unit circle properties! I wrote a small function trying to recreate the style of the plot in your question :)
library(ggforce)
parlDiag <- function(Parties, shares, cols = NULL, repr=c("absolute", "proportion")) {
repr = match.arg(repr)
stopifnot(length(Parties) == length(shares))
if (repr == "proportion") {
stopifnot(sum(shares) == 1)
}
if (!is.null(cols)) {
names(cols) <- Parties
}
# arc start/end in rads, last one reset bc rounding errors
cc <- cumsum(c(-pi/2, switch(repr, "absolute" = (shares / sum(shares)) * pi, "proportion" = shares * pi)))
cc[length(cc)] <- pi/2
# get angle of arc midpoints
meanAngles <- colMeans(rbind(cc[2:length(cc)], cc[1:length(cc)-1]))
# unit circle
labelX <- sin(meanAngles)
labelY <- cos(meanAngles)
# prevent bounding box < y=0
labelY <- ifelse(labelY < 0.015, 0.015, labelY)
p <- ggplot() + theme_no_axes() + coord_fixed() +
expand_limits(x = c(-1.3, 1.3), y = c(0, 1.3)) +
theme(panel.border = element_blank()) +
theme(legend.position = "none") +
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0.5, r = 1,
start = cc[1:length(shares)],
end = c(cc[2:length(shares)], pi/2), fill = Parties)) +
switch(is.null(cols)+1, scale_fill_manual(values = cols), NULL) +
# for label and line positions, just scale sin & cos to get in and out of arc
geom_path(aes(x = c(0.9 * labelX, 1.15 * labelX), y = c(0.9 * labelY, 1.15 * labelY),
group = rep(1:length(shares), 2)), colour = "white", size = 2) +
geom_path(aes(x = c(0.9 * labelX, 1.15 * labelX), y = c(0.9 * labelY, 1.15 * labelY),
group = rep(1:length(shares), 2)), size = 1) +
geom_label(aes(x = 1.15 * labelX, y = 1.15 * labelY,
label = switch(repr,
"absolute" = sprintf("%s\n%i", Parties, shares),
"proportion" = sprintf("%s\n%i%%", Parties, round(shares*100)))), fontface = "bold",
label.padding = unit(1, "points")) +
geom_point(aes(x = 0.9 * labelX, y = 0.9 * labelY), colour = "white", size = 2) +
geom_point(aes(x = 0.9 * labelX, y = 0.9 * labelY)) +
geom_text(aes(x = 0, y = 0, label = switch(repr,
"absolute" = (sprintf("Total: %i MPs", sum(shares))),
"proportion" = "")),
fontface = "bold", size = 7)
return(p)
}
bt <- data.frame(parties = c("CDU", "CSU", "SPD", "AfD", "FDP", "Linke", "GrĂ¼ne", "Fraktionslos"),
seats = c(200, 46, 153, 92, 80, 69, 67, 2),
cols = c("black", "blue", "red", "lightblue", "yellow", "purple", "green", "grey"),
stringsAsFactors = FALSE)
parlDiag(bt$parties, bt$seats, cols = bt$cols)
Would this work for you?
ggplot(df, aes(fill = Party, ymax = ymax, ymin = ymin, xmax = 2, xmin = 1)) + geom_rect() +
coord_polar(theta = "y",start=-pi/2) + xlim(c(0, 2)) + ylim(c(0,2))
Basically you just set the ylim to be 2x your max so it only plots it on half. In this case we set the y limits to be from 0 to 2. Then you can offset the start in coord_polar(start=) to get it in proper place.
FWIW, one might also check out the nice ggforce package:
library(tidyverse)
library(ggforce)
library(scales)
df %>%
mutate_at(vars(starts_with("y")), rescale, to=pi*c(-.5,.5), from=0:1) %>%
ggplot +
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = .5, r = 1, start = ymin, end = ymax, fill=Party)) +
coord_fixed()

Resources