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!
Related
I am helping someone translate hand-drawn economics supply and demand functions into image files that can be included in a Word document. These have been going well using Hmisc::bezier and geom_path modeled after Andrew Heiss's recon plots and using his curve_intersect function. That is, until the author asked that one of the supply curves should pass through a specified set of coordinates. The Hmisc::bezier function only uses the first and last control point as absolute, and bends toward intermediate points so the specified intersection point does not match the curve. I tried creating a spline of 2 bezier curves with the bezier function from the bezier package (v1.1.2, https://cran.r-project.org/web/packages/bezier/bezier.pdf), but this fails with "Error in FUN(X[[i]], ...) : object 'x' not found", which I do not understand or know how to fix.
Please let me know where I am going wrong or if there is a better method! I will include the commented out attempts using various functions. Please excuse the amateurish code, as I am a relative newb at R and ggplot2.
This section not directly relevant to my question
# Graph figures for physical economics, negative oil prices paper
library(reconPlots)
library(dplyr)
library(ggplot2)
library(patchwork)
library(ggrepel)
library(bezier)
library(ggforce)
options(ggrepel.max.time = 1)
options(ggrepel.max.iter = 20000)
#Set seed value for ggrepel
set.seed(52)
# panel (a)
#Set values of curves using the bezier function, each pair of c() values
# is an xy coordinate, and the sets of coordinates control the shape of the
# curve
supply <- Hmisc::bezier(c(1, 5, 6), c(3, 4, 9)) %>%
as_data_frame()
demand <- Hmisc::bezier(c(0, 9, 9), c(6, 6, 6)) %>%
as_data_frame()
label_height <- Hmisc::bezier(c(0, 9, 9), c(8, 8, 8)) %>%
as_data_frame()
# Calculate the intersections of the two curves
intersections <- bind_rows(curve_intersect(supply, demand))
# Calculate point where the curve label(s) intersect a specified height
supply_label <- bind_rows(curve_intersect(supply, label_height))
labels <- data_frame(label = expression("PS"[CR]^DRL),
x = supply_label$x,
y = supply_label$y)
production <- ggplot(mapping = aes(x = x, y = y)) +
#Draw the supply curve. Demand is not drawn in this figure, but the
# intersections of an imaginary demand curve are used to illustrate P0
# and Q0, the intersection point, and the dotted lines
geom_path(data = supply, color = "#0073D9", size = 1) +
geom_segment(data = intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
#Draw the supply curve label using the intersection calculated above, using
# GGrepel so that the labels do not overlap the curve line
geom_text_repel(data = labels
,aes(x = x, y = y, label = label)
,parse = TRUE
,direction = "x"
,force = 3
,force_pull = 0.1
,hjust = 0
,min.segment.length = 0
) +
#Draw the intersection point based on intersection function between supply
# and the phantom flat demand curve at height y=6
geom_point(data = intersections, size = 3) +
#Use scale functions to set y-axis label, axis intersection point labels,
# and limits of the viewing area
scale_x_continuous(expand = c(0, 0), breaks = intersections$x
,labels = expression(Q[CR]^{DRL-PS})
,limits=c(0,9)
) +
scale_y_continuous(expand = c(0, 0), breaks = c(intersections$y, 9)
,labels = c(expression(P[CR]==frac("$",brl))
,expression(P[CR]))
,limits=c(0,9)
) +
#Use labs function to set x-axis title and title of each graph using the
# caption function so that it displays on the bottom
labs(x = expression(frac(Barrels,Week)),
caption = expression(atop("(a) Driller Production Supply", "of Crude Oil"))
) +
#Set classic theme, x-axis title on right-hand side using larger font of
# relative size 1.2, graph title on left-hand side using same larger font
theme_classic() +
theme(axis.title.y = element_blank(),
axis.title.x = element_text(hjust = 1),
axis.text = element_text(size=rel(1.2)),
plot.caption = element_text(hjust = 0.5, size=rel(1.2))
) +
coord_equal()
# Save the intersections so we can set the same quantity, price for panel (c)
specified_intersections = intersections
# Panel (b)
supply <- Hmisc::bezier(c(3.99, 4), c(0, 9)) %>%
as_data_frame()
demand <- Hmisc::bezier(c(2, 3, 4, 5), c(9, 6.5, 6, 5.5)) %>%
as_data_frame()
demand_capacity <- Hmisc::bezier(c(5, 5), c(0, 5.5)) %>%
as_data_frame()
supply_capacity <- Hmisc::bezier(c(4.999, 5), c(0, 9)) %>%
as_data_frame()
supply_label_height <- Hmisc::bezier(c(0, 9), c(9, 9)) %>%
as_data_frame()
demand_label_height <- Hmisc::bezier(c(0, 9), c(8, 8)) %>%
as_data_frame()
capacity_label_height <- Hmisc::bezier(c(0, 9), c(9, 9)) %>%
as_data_frame()
# Calculate the intersections of the two curves
intersections <- bind_rows(curve_intersect(supply,
demand))
supply_label <- bind_rows(curve_intersect(supply
,supply_label_height))
demand_label <- bind_rows(curve_intersect(demand
,demand_label_height))
capacity_label <- bind_rows(curve_intersect(supply_capacity
,capacity_label_height))
labels <- data_frame(label = c(expression("OD"[CR]^DRL),expression("OS"[CR]^DRL)
,expression("Q"[CR]^CAP)
),
x = c(demand_label$x, supply_label$x
, capacity_label$x
),
y = c(demand_label$y, supply_label$y
, capacity_label$y
)
)
inventory <- ggplot(mapping = aes(x = x, y = y)) +
geom_path(data = supply, color = "#0073D9", size = 1) +
geom_path(data = demand, color = "#FF4036", size = 1) +
geom_path(data = demand_capacity, color = "#FF4036", size = 1) +
geom_path(data = supply_capacity, color = "#0073D9", size = 1, lty = "dashed") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_text_repel(data = labels
,aes(x = x, y = y, label = label)
,parse = TRUE
,direction = "x"
,force = 3
,force_pull = 0.1
,hjust = c(0, 0, 1)
,min.segment.length = 0
) +
geom_point(data = intersections, size = 3) +
scale_x_continuous(expand = c(0, 0), breaks = c(intersections$x
, 5),
labels = c(expression(paste(Q[CR]^{DRL-OS},phantom(12345)))
,expression(Q[CR]^CAP)
)
, limits=c(0,9)) +
scale_y_continuous(expand = c(0, 0), breaks = c(intersections$y, 9),
labels = c(expression(P[CR]),expression(P[CR]))
, limits=c(0,9)) +
labs(x = "Barrels",
caption = expression(atop("(b) Driller Storage / Ownership", "of Crude Oil"))
) +
theme_classic() +
theme(axis.title.y = element_blank(),
axis.title.x = element_text(hjust = 1),
axis.text = element_text(size=rel(1.2)),
plot.caption = element_text(hjust = 0.5, size=rel(1.2))
) +
coord_equal()
Relevant section
# panel (c)
# ggforce package method
#supply <- list(c(1, 4, specified_intersections$x, 5, 7),
# c(3, 4, specified_intersections$y, 7, 9)) %>%
# as_data_frame()
# bezier package method: Fails with "Error in FUN(X[[i]], ...) : object 'x' not found"
t <- seq(0, 2, length=10)
p <- list(c(1, 4, specified_intersections$x, 7, 8),
c(3, 4, specified_intersections$y, 6, 9))
#p <- matrix(c(1,3, 4,4, specified_intersections$x,specified_intersections$y,
# 7,6, 8,9), nrow=5, ncol=2, byrow=TRUE)
supply <- bezier(t=t, p=p) %>%
as_data_frame()
# Original: Fails because it does not pass through the specified intersection
#supply <- Hmisc::bezier(c(1, specified_intersections$x, 8),
# c(3, specified_intersections$y, 9)) %>%
# as_data_frame()
# Hmisc method: Fails because there is no way to get the two curves to appear
# contiguous
#supply1 <- Hmisc::bezier(c(1, 4, specified_intersections$x),
# c(3, 4, specified_intersections$y)) %>%
# as_data_frame()
#supply2 <- Hmisc::bezier(c(specified_intersections$x, 6, 7),
# c(specified_intersections$y, 8, 9)) %>%
# as_data_frame()
#demand <- Hmisc::bezier(c(0, 9), c(specified_intersections$y, specified_intersections$y)) %>%
# as_data_frame()
label_height <- Hmisc::bezier(c(0, 9), c(8, 8)) %>%
as_data_frame()
# Calculate the intersections of the two curves
#intersections <- bind_rows(curve_intersect(supply, demand))
#supply_label <- bind_rows(curve_intersect(supply,
# label_height))
#labels <- data_frame(label = expression("SS"[CR]^DRL),
# x = supply_label$x,
# y = supply_label$y)
sales <- ggplot(mapping = aes(x = x, y = y)) +
# ggforce package method
# geom_bspline(data = supply, color = "#0073D9", size = 1) +
# Original geom_path method
geom_path(data = supply, color = "#0073D9", size = 1) +
# Supply 1 and 2 for Hmisc method
# geom_path(data = supply1, color = "#0073D9", size = 1) +
# geom_path(data = supply2, color = "#0073D9", size = 1) +
geom_segment(data = specified_intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = specified_intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
# geom_text_repel(data = labels
# ,aes(x = x, y = y, label = label)
# ,parse = TRUE
# ,direction = "x"
# ,force = 3
# ,force_pull = 0.1
# ,hjust = 0
# ,min.segment.length = 0
# ) +
geom_point(data = specified_intersections, size = 3) +
scale_x_continuous(expand = c(0, 0), breaks = specified_intersections$x,
labels = expression(Q[CR]^{DRL-SS}), limits=c(0,9)) +
scale_y_continuous(expand = c(0, 0), breaks = c(specified_intersections$y, 9),
labels = c(expression(P[CR]),expression(P[CR]))) +
labs(x = expression(frac(Barrels,Week)),
caption = expression(atop("(c) Driller Sales Supply", "of Crude Oil"))
) +
theme_classic() +
theme(axis.title.y = element_blank(),
axis.title.x = element_text(hjust = 1),
axis.text = element_text(size=rel(1.2)),
plot.caption = element_text(hjust = 0.5, size=rel(1.2))
) +
coord_equal()
patchwork <- (production | inventory | sales)
patchwork
Graphs before implementation of fixed coordinates. Need to move panel (c) intersection point to match panel (a)
I solved the "Error in FUN(X[[i]], ...) : object 'x' not found" by printing the supply variable and noticing that the bezier function names its rows V1,V2 and not x,y. I needed to set the aesthetics of the geom_path to the correct mapping.
Relevant Section, trimmed to only the bezier method
# panel (c)
# bezier package method
t <- seq(0, 2, length = 100)
p <- matrix(c(1,3, 4,4, specified_intersections$x,specified_intersections$y,
7,6, 8,9), nrow=5, ncol=2, byrow=TRUE)
supply <- bezier::bezier(t=t, p=p, deg=2) %>%
as_data_frame()
sales <- ggplot(mapping = aes(x = x, y = y)) +
# Original geom_path method
geom_path(data = supply, mapping = aes(x = V1, y = V2),
color = "#0073D9", size = 1, inherit.aes = FALSE) +
geom_segment(data = specified_intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = specified_intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_point(data = specified_intersections, size = 3) +
scale_x_continuous(expand = c(0, 0), breaks = specified_intersections$x,
labels = expression(Q[CR]^{DRL-SS}), limits=c(0,9)) +
scale_y_continuous(expand = c(0, 0), breaks = c(specified_intersections$y, 9),
labels = c(expression(P[CR]),expression(P[CR]))) +
labs(x = expression(frac(Barrels,Week)),
caption = expression(atop("(c) Driller Sales Supply", "of Crude Oil"))
) +
theme_classic() +
theme(axis.title.y = element_blank(),
axis.title.x = element_text(hjust = 1),
axis.text = element_text(size=rel(1.2)),
plot.caption = element_text(hjust = 0.5, size=rel(1.2))
) +
coord_equal()
patchwork <- (production | inventory | sales)
patchwork
This does not solve my larger problem of needing a smooth curve that passes through a specified set of coordinates, as it produces two bezier curves that do not match.
I will do some research on using functions to specify bezier curves and find out if there is some mathematical or programmatic way to specify a bezier curve that passes through a set of fixed coordinates. If I find one, I'll edit this answer.
If anyone knows how to accomplish this, I would appreciate any help!
Kinked bezier curves
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()
I am actually very amazed to see I cannot quickly find a guide to how to do this. Here is an example:
library(ggplot2)
library(gganimate)
library(data.table)
library(magrittr)
dt <- lapply(seq(10), function(i){
mean = i
label = paste0("T = ", i)
dt = data.table(x = seq(0, 50, length.out = 100))
set(dt, j = "y", value = dt[, dlnorm(x, meanlog = log(mean), sdlog = 0.2)])
set(dt, j = "frameN", value = i)
return(dt)
}) %>% rbindlist
print(dt)
p <- ggplot(dt, aes(x = x, y = y)) +
geom_line() +
scale_x_continuous(name = "x", breaks = c(0, 1)) +
transition_manual(frameN)
animate(p)
I want the breaks and labels of scale_x_continuous to follow my own definitions:
arr_breaks <- c(1, 3, 2, 4, 3, 5, 4, 6, 5, 7)
arr_labels <- paste0(seq(10, 100, 10), " kg")
And then
breaks = arr_breaks[1], labels = arr_labels[1] for frame 1
breaks = arr_breaks[2], labels = arr_labels[2] for frame 2
...
breaks = arr_breaks[10], labels = arr_labels[10] for frame 10
No matter how I do it I got errors. Any idea?
As #z-lin noted, gganimate is not currently set up (to my knowledge) to animate scales with different breaks. The effect could be closely approximated using geoms, and with some more work you could probably make an exact visual match to a changing scale.
breaks_df <- data.frame(
frameN = c(1:10),
arr_breaks = c(1, 3, 2, 4, 3, 5, 4, 6, 5, 7),
arr_labels = paste0(seq(10, 100, 10), " kg")
)
p <- ggplot(dt, aes(x = x, y = y)) +
geom_segment(data = breaks_df, color = "white",
aes(x = arr_breaks, xend = arr_breaks,
y = -Inf, yend = Inf)) +
geom_text(data = breaks_df, vjust = 3, size = 3.5, color = "gray30",
aes(x = arr_breaks, y = 0, label = arr_labels)) +
geom_line() +
scale_x_continuous(name = "x", breaks = c(0)) +
coord_cartesian(clip = "off") +
transition_manual(frameN)
animate(p, width = 600, height = 250)
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
The question relates to this: Line graph customization (add circles, colors), but since I got a new task, I created a new question.
So again my data frame is the same as in the question I've posted in a link. With code below and (little of my own modification) that was given to me by #beetroot
value <- c(9, 4, 10, 7, 10,
10, 10, 4, 10,
4, 10, 2, 5, 5, 4)
names <- c("a","b",
"c","d","e",
"f", "g","h",
"i","j","k","l",
"m","n","p")
df <- data.frame(value, names)
df$names <- as.character(df$names)
df$part <- rep(c("part3", "part2", "part1"), each = 5)
library(dplyr)
library(tidyr)
df2 <- df %>%
group_by(part, names) %>%
expand(value = min(df$value):max(df$value))
p <- ggplot() +
geom_point(data = df2, aes(x = value, y = names),
shape = 1) +
geom_point(data = df, aes(y = names, x = value, group = 1),
colour = I("red"), shape = 21, lwd = 3, fill = "red") +
geom_line(data = df, aes(y = names, x = value, group = 1),
group = I(1),color = I("red")) +
theme_bw() +
facet_wrap(~part, ncol = 1, scales = "free_y")
p + theme(strip.background = element_rect(fill="dodgerblue3"),
strip.text.x = element_text(colour = "white"))+xlab("") +ylab("")
df <- data.frame(value, names)
df$names <- as.character(df$names)
I get this output:
But now I would like to connect lines through (PART1, PART2 and PART3) so that my output would look like:
I used black color of a line just it will be more visible that I would like to connect this parts with lines.
Although I am not completely satisfied I've found solution. I computed the bounding box.
Firstly I removed facet_wrap(~part, ncol = 1, scales = "free_y") so my code looks like this:
p <- ggplot() +
geom_point(data = df2, aes(x = value, y = names),
shape = 1) +
geom_point(data = df, aes(y = names, x = value, group = 1),
colour = I("red"), shape = 21, lwd = 3, fill = "red") +
geom_line(data = df, aes(y = names, x = value, group = 1),
group = I(1),color = I("red")) +
theme_bw()
Then the trick was to create data frame and add the width and height of text directly:
# PART 1
TextFrame <- data.frame(X = 6, Y = 15.5, LAB = "PART 1")
TextFrame <- transform(TextFrame,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
# PART 2
TextFrame.1 <- data.frame(X = 6, Y = 10.5, LAB = "PART 2")
TextFrame.1 <- transform(TextFrame.1,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
# PART 3
TextFrame.2 <- data.frame(X = 6, Y = 4.5, LAB = "PART 3")
TextFrame.2 <- transform(TextFrame.2,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
Then I've used geom_rectand geom_text to create the illusion I am after.
p + geom_rect(data = TextFrame, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame,aes(x = X, y = Y, label = LAB), size = 5) +
geom_rect(data = TextFrame.1, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame.1,aes(x = X, y = Y, label = LAB), size = 5) +
geom_rect(data = TextFrame.2, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame.2,aes(x = X, y = Y, label = LAB), size = 5)
And the output is: