ggplot2 plot an angle between two lines - r

I would like to plot an angle between two lines using ggplot2, meaning something similar to the bold red line in the plot below. Is there an easy solution to this?
Data and code to make the plot without the red line:
library(tidyverse)
df <- tibble(
line = c("A", "A", "B", "B"),
x = c(1, 5, 1, 3),
y = c(1, 3, 1, 5))
ggplot(
df, aes(x, y, group = line))+
geom_path()

have a look at geom_curve, e.g. :
ggplot( df, aes(x, y, group = line))+
geom_path() +
geom_curve(aes(x = 1.5, y = 2, xend = 2, yend = 1.5), curvature = -0.5, color = "red", size = 3)
You will have to tweak it a bit to use it in a more robust, automatic way, for example:
red_curve <- df %>%
group_by(line) %>%
summarise( avg_x = mean(x),
avg_y = mean(y))
ggplot( df, aes(x, y, group = line))+
geom_path() +
geom_curve( data = red_curve, aes(x = avg_x[1], y = avg_y[1], xend = avg_x[2], yend = avg_y[2]), curvature = 0.5, color = "red", size = 3)

Here is a solution with geom_arc of the ggforce package.
library(ggplot2)
library(ggforce)
angle <- function(p, c){
M <- p - c
Arg(complex(real = M[1], imaginary = M[2]))
}
O <- c(1,1)
P1 <- c(5,3)
P2 <- c(3,5)
a1 <- angle(P1, O)
a2 <- angle(P2, O)
df <- data.frame(
line = c("A", "A", "B", "B"),
x = c(1, 5, 1, 3),
y = c(1, 3, 1, 5)
)
ggplot(df, aes(x, y, group = line)) +
geom_path() +
geom_arc(aes(x0 = 1, y0 = 1, r = 1, start = a1, end = a2),
color="red", size = 2, inherit.aes = FALSE)
The arc does not look like a true arc circle. That's because the aspect ratio is not set to 1. To set the aspect ratio to 1:
ggplot(df, aes(x, y, group = line)) +
geom_path() +
geom_arc(aes(x0 = 1, y0 = 1, r = 1, start = a1, end = a2),
color="red", size = 2, inherit.aes = FALSE) +
coord_fixed()

Related

Lines on top and bottom of ggplot plot area

I want to add a line on the top and bottom of my plots (bottom line below the x label and axis) created using ggplot2. So far I have added a rectangle around the plot, but I do not want the lines on the sides.
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
library(ggplot2)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
theme(plot.background = element_rect(size = 1, color = 'blue'))
I hope you guys have a solution.
Will something similar to this work?
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
annotate(geom = 'segment',
y = Inf,
yend = Inf,
x = -Inf,
xend = Inf,
size = 2) +
theme(axis.line.x = element_line(size = 1))
Not a perfect, but working solution. You have to plot huge "-" (size = 1000) outside plot area. This solution is not perfect as you have to manually adjust position of "-" on the y-axis.
df <- data.frame(x = 1:10, y = 1:10)
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
# Y position adjusted manually
geom_text(aes(5, 2.9, label = "-"), color = "blue", size = 1000) +
# Y position adjusted manually
geom_text(aes(5, 21.2, label = "-"), color = "blue", size = 1000) +
# Plot outside plot area
coord_cartesian(ylim = c(0, 10), clip = "off")
I am not completely happy with the solution as I don't fully grasp
how to change the size of the lines
why they are not perfectly aligned with top and bottom when using patchwork::wrap_plots()
why it does not show the top line using ggpubr::ggarrange() or cowplot::plot_grid()
but based on this code, I suggest the following solution:
library(ggplot2)
df <- data.frame(x = 1:5, y = 1:5)
p <- ggplot(data = df) + aes(x, y) + geom_point()
top_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(1, "npc")))
bot_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(0, "npc")))
patchwork::wrap_plots(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
ggpubr::ggarrange(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
cowplot::plot_grid(top_line, p, bot_line,
ncol = 1, nrow = 3,
rel_heights = c(0, 1, 0))
Created on 2022-08-25 with reprex v2.0.2

R - (ggplot) Make geom_step jumps dashed

I'm plotting a discrete CDF. I have a few questions regarding geom_step which I'm not finding by using Google.
Is it possible to make the line segment representing the jump dashed
rather than solid to better show whats going on?
Is it possible to add geom_point more efficiently than I do? (less
c/p).
Below is my current solution:
library(tidyverse)
library(ggthemes)
theme_set(theme_few())
x0 <- seq(-0.5, -0.01, by = 0.01)
x1 <- seq(0, 0.99, by = 0.02)
x2 <- seq(1, 1.99, by = 0.02)
x3 <- seq(2, 2.99, by = 0.02)
x35 <- seq(3, 3.49, by = 0.01)
x4 <- seq(3.5, 3.99, by = 0.01)
tibble_ex <- tibble(
x0 = x0,
x1 = x1,
x2 = x2,
x3 = x3,
x35 = x35,
x4 = x4
)
tibble_ex %>%
gather(x, xax, x0:x4) %>%
mutate(cdf = case_when(x == 'x0' ~ 0,
x == 'x1' ~ 1/2,
x == 'x2' ~ 3/5,
x == 'x3' ~ 4/5,
x == 'x35' ~ 9/10,
x == 'x4' ~ 1)) %>%
ggplot(aes(x = xax, y = cdf)) +
geom_step() +
geom_point(aes(x = 0, y = 0), size = 3, shape = 21, fill = 'white') +
geom_point(aes(x = 1, y = 0.5), size = 3, shape = 21, fill = 'white') +
geom_point(aes(x = 2, y = 3/5), size = 3, shape = 21, fill = 'white') +
geom_point(aes(x = 3, y = 4/5), size = 3, shape = 21, fill = 'white') +
geom_point(aes(x = 3.5, y = 9/10), size = 3, shape = 21, fill = 'white') +
geom_point(aes(x = 0, y = 0.5), size = 3, shape = 21, fill = 'black') +
geom_point(aes(x = 1, y = 3/5), size = 3, shape = 21, fill = 'black') +
geom_point(aes(x = 2, y = 4/5), size = 3, shape = 21, fill = 'black') +
geom_point(aes(x = 3, y = 9/10), size = 3, shape = 21, fill = 'black') +
geom_point(aes(x = 3.5, y = 1), size = 3, shape = 21, fill = 'black') +
labs(x = 'x', y = 'F(x)')
ggplot will be more powerful to use if you can put your data into a data frame and structure it so that the characteristics of your data can be mapped directly.
Here's a way to take your data and augment it with additional rows that represent the connecting points, by matching each x with the prior cdf value. I added a column, type, to keep track of which is which. I also arrange df so that geom_segment plots the points in the right order.
new_steps <-
tibble(x = c(0:3, 3.5, 4),
cdf = c(0, .5, .6, .8, .9, 1))
df <- new_steps %>%
mutate(type = "cdf") %>%
bind_rows(new_steps %>%
mutate(type = "prior",
cdf = lag(cdf))) %>%
drop_na() %>%
arrange(x, desc(type))
Then we can map the points' fill and the geom_segments' linetype to type.
ggplot(df) +
geom_point(aes(x, cdf, fill = type),
shape = 21) +
scale_fill_manual(values = c("black", "white")) +
geom_segment(aes(x = lag(x), y = lag(cdf),
xend = x, yend = cdf,
lty = type)) +
scale_linetype_manual(values = c("dashed", "solid"))
(1) No, there is not a built-in way to make the geom_step half-dashed. But if you post this as a separate question, perhaps someone will help create a new geom for this.
(2) The answer is to put the points you want plotted in a data frame, like anything else you might want to plot:
point_data = data.frame(x = rep(c(0, 1, 2, 3, 3.5), 2),
y = c(0, rep(c(.5, .6, .8, .9), 2), 1),
z = rep(c("a", "b"), each = 5))
# calling your gathered/mutated version of tibble_ex df
ggplot(df, aes(x = xax, y = cdf)) +
geom_step() +
geom_point(data = point_data, aes(x = x, y = y, fill = z), shape = 21) +
scale_fill_manual(values = c("white", "black"), guide = FALSE) +
labs(x = 'x', y = 'F(x)')
For the second part of your question, you can put all the coordinates in a separate data frame and call geom_point only once:
ddf <- data.frame(xax = rep(c(0:3, 3.5), 2),
cdf = c(0, .5, .6, .8, .9, .5, .6, .8, .9, 1),
col = rep(c("white", "black"), each = 5))
dev.new()
tibble_ex %>%
gather(x, xax, x0:x4) %>%
mutate(cdf = case_when(x == 'x0' ~ 0,
x == 'x1' ~ 1/2,
x == 'x2' ~ 3/5,
x == 'x3' ~ 4/5,
x == 'x35' ~ 9/10,
x == 'x4' ~ 1)) %>%
ggplot(aes(x = xax, y = cdf)) +
geom_step() +
geom_point(data = ddf, aes(fill = I(col)), size = 3, shape = 21) +
labs(x = 'x', y = 'F(x)')

Add count as label to points in geom_count

I used geom_count to visualise overlaying points as sized groups, but I also want to add the actual count as a label to the plotted points, like this:
However, to achieve this, I had to create a new data frame containing the counts and use these data in geom_text as shown here:
#Creating two data frames
data <- data.frame(x = c(2, 2, 2, 2, 3, 3, 3, 3, 3, 4),
y = c(1, 2, 2, 2, 2, 2, 3, 3, 3, 3),
id = c("a", "b", "b", "b", "c",
"c", "d", "d", "d", "e"))
data2 <- data %>%
group_by(id) %>%
summarise(x = mean(x), y = mean(y), count = n())
# Creating the plot
ggplot(data = data, aes(x = x, y = y)) +
geom_count() +
scale_size_continuous(range = c(10, 15)) +
geom_text(data = data2,
aes(x = x, y = y, label = count),
color = "#ffffff")
Is there any way to achieve this in a more elegant way (i.e. without the need for the second data frame)? I know that you can access the count in geom_count using ..n.., yet if I try to access this in geom_text, this is not working.
Are you expecting this:
ggplot(data %>%
group_by(id) %>%
summarise(x = mean(x), y = mean(y), count = n()),
aes(x = x, y = y)) + geom_point(aes(size = count)) +
scale_size_continuous(range = c(10, 15)) +
geom_text(aes(label = count),
color = "#ffffff")
update:
If the usage of geom_count is must, then the expected output can be achieved using:
p <- ggplot(data = data, aes(x = x, y = y)) +
geom_count() + scale_size_continuous(range = c(10, 15))
p + geom_text(data = ggplot_build(p)$data[[1]],
aes(x, y, label = n), color = "#ffffff")
here would be a solution for a code with discrete values
f<-ggplot(data = STest, aes(x = x, y = y)) + geom_count()+scale_x_discrete(labels = c("strong decrease","decrease","no change","increase","strong increase","no opinion"))+scale_y_discrete(labels = c("strong decrease","decrease","no change","increase","strong increase","no opinion"))
f + geom_text(data = ggplot_build(p)$data[[1]],aes(x, y, label = n,vjust= -2))
Thank you so much!
A much easier way to change this is to use the labs() function so in this case it would be ...labs(size = "Count") + ....
That should be all you need.

ggplot2 guide/legend on shape

I have a plot from the following script.
require(ggplot2)
df.shape <- data.frame(
AX = runif(10),
AY = runif(10),
BX = runif(10, 2, 3),
BY = runif(10, 2, 3)
)
p <- ggplot(df.shape)
p <- p + geom_point(aes(x = AX, y = AY, shape = 15)) +
geom_point(aes(x = BX, y = BY, shape = 19)) +
scale_shape_identity() +
guides(shape = guide_legend(override.aes = list(shape = 15, shape = 19)) )
print(p)
This doesn't produce a legend, describing which shape is "A" and which shape is "B". Note that the squares and circles may be close to one another, so I can't generally define the variable based on location. How do I display a "shape" legend?
I would reshape my data in the long format using reshape:
dt <- reshape(df.shape ,direction='long', varying=list(c(1, 3), c(2, 4)),
,v.names = c('X','Y'), times = c('A','B'))
Then I plot it simply like this
ggplot(dt) +
geom_point(aes(x = X, y = Y, shape = time),size=5) +
scale_shape_manual(values=c(15,19))

Circular plot in ggplot2 with line segments connected in r

I am trying to create a circular plot and am stuck at a point:
dat1 <- data.frame (xvar = 1:10, y = 6, ymin = 4, ymax = 4.5)
Using this data, I can produce a circular ribbon plot in ggplot2
require(ggplot2)
ggplot(dat1, aes(x=xvar, y=y)) + geom_ribbon(aes(ymin=ymin, ymax=ymax),
col = "blue", fill = "blue2") + ylim (c(0,6)) + coord_polar()
However I want more.
I want to fill the segment of the ribbon with different colors and labels using the following data.
filld <- data.frame (start = c(1, 4, 6, 7.5, 8, 9), end = c(4, 6, 7.5, 8, 9, 10),
label = c("A", "B", "C", "A", "C", "D"))
filld
## start end label
## 1 1.0 4.0 A
## 2 4.0 6.0 B
## 3 6.0 7.5 C
## 4 7.5 8.0 A
## 5 8.0 9.0 C
## 6 9.0 10.0 D
The ribbon will be filled with different color by label variable. For example, the segment A will start from 1 and end at 4. Then segment B will start and end at 6 and filled with different color. Segments with same label (such as A and C) will be connected by line.
The resulting plot will look like this:
Here is an example:
filld$p <- rowMeans(subset(filld, select = c(start, end)))
ggplot(filld, aes(xmin = start, xmax = end, ymin = 4, ymax = 5, fill = label)) +
geom_rect() +
geom_segment(data = subset(filld, label %in% label[duplicated(label)]),
aes(x = p, y = 0, xend = p, yend = 4, colour = label),
size = 2, show_guide = FALSE) +
geom_text(aes(x = p, y = 4.5, label = label), colour = "white", size = 10) +
coord_polar() +
scale_y_continuous(limits = c(0, 5))
Updated
I do not recommend but something like this:
filld <- data.frame (start = c(1, 4, 6, 7.5, 8, 9), end = c(4, 6, 7.5, 8, 9, 10),
label = c("A", "B", "C", "A", "C", "D"))
filld$p <- rowMeans(subset(filld, select = c(start, end)))
filld <- merge(filld, ddply(filld, .(label), summarize, p2 = mean(p)))
lnd <- subset(filld, label %in% label[duplicated(label)])
lnd <- ddply(lnd, .(label), function(x) {
x <- seq(x$p[1], x$p[2], length = 100)
y <- 4.5 + ((x - mean(x))^2 - (x[1]-mean(x))^2) / (x[1]-mean(x))^2 * 3 + sin(x*3*pi) * 0.1
data.frame(x, y)
})
p <- ggplot(filld, aes(xmin = start, xmax = end, ymin = 4, ymax = 5, colour = label, fill = label)) +
geom_line(aes(x, y, xmin = NULL, ymin = NULL, xmax = NULL, ymax = NULL), data = lnd, size = 2) +
geom_rect() +
geom_text(aes(x = p, y = 4.5, label = label), colour = "white", size = 10) +
coord_polar() +
scale_y_continuous(limits = c(0, 5))
p
Perhaps, what you want is beyond the scope of ggplot2.
Take a look at ggbio. This package extends ggplot2 and the grammar of graphics to sequence data (bioinformatics) but they seems to solve your problem (for example see here). Taking a look at the source code for the package may direct you to a more generic solution.
Add the ymin etc to fill d
fd <- data.frame(filld, ymin = 4, y =6, ymax = 4.5)
Then use geom_rect with the column label as the fill and colour aesthetics
ggplot(fd, aes(x=start,xmin = start, xmax = end, y=y)) +
geom_rect(aes(ymin=ymin, ymax=ymax, fill = label )) +
ylim (c(0,6)) +
coord_polar()
Add the lines:
## calculate the midpoint for each segment
fd$xmid <- apply(fd[,1:2],1,mean)
## get the replicate id for the labels (what occurence is this)
library(plyr)
library(reshape2)
fd1 <- ddply(fd, .(label), mutate, id = 1:length(xmid))
## reshape to wide, subsetting only with more than one rep
.lines <- na.omit(dcast(fd1, label~id, value.var = 'xmid'))
## add a mid point between the mid points
.lines$mid <- apply(.lines[,2:3],1,mean)
## reshape to long, and add some y values
ld <- data.frame(arrange(melt(.lines,value.name = 'x'), label, x), y = rep(c(4,3,4),2))
ggplot(fd) +
geom_rect(aes(x=start,xmin = start, xmax = end, y=y,ymin=ymin, ymax=ymax, fill = label )) +
ylim (c(0,6)) +
coord_polar() + geom_path(data = ld, aes(x=x,y=y,colour = label))
The lines are ugly, but there!

Resources