Related
How to get ggplot Heatmap (R) to use two colors? One for between a fill value of -.1 to .1 and one for not
ggplot(base, aes(x,y, fill= base$`Equal Opportunity Difference`)) +
geom_tile() +
#axis formatting
scale_x_discrete(breaks = c(10, 20, 30, 40 , 50, 60, 70, 80, 90),
labels = c("10%", "20%","30%", "40%","50%", "60%", "70%","80%", "90%"),
limits = c(10,90)) +
scale_y_discrete(breaks = c(10, 20, 30, 40 , 50, 60, 70, 80, 90),
labels = c("10%", "20%","30%", "40%","50%", "60%", "70%","80%", "90%"),
limits = c(10,90)) +
geom_text(aes(label = signif(base$`Equal Opportunity Difference`,2)), color = "white",
size = 4) +
scale_fill_gradient2(midpoint=c(-.1, s.1), low="#B2182B", high="#2166AC")
This is what I have right now, which isn't working. Also the axis are only showing 10% and 90%
I would appreciate if someone had a solution for that too.
Without a minimal reproducible example it's difficult to guess potential solutions to your problem. Is this what you're hoping to achieve? If not, what do you want to change?
library(ggplot2)
library(scales)
x <- seq(1:10)
y <- seq(1:10)
df <- expand.grid(x = x, y = y)
df$z <- signif(c(runif(50, -10, 0), runif(50, 0, 10)), 2)
df$z_categorised <- cut(df$z, c(seq(-10, -1, 1), seq(1, 10, 1)))
palette_red_blue <- colorRampPalette(colors = c("#B2182B","white", "#2166AC"))
ggplot(df, aes(x = x, y = y, fill = z_categorised)) +
geom_tile(color = "white") +
geom_text(aes(label = z)) +
scale_fill_manual(values = palette_red_blue(19)) +
scale_x_continuous(breaks = seq(0, 10, 1),
labels = percent_format(scale = 10)) +
scale_y_continuous(breaks = seq(0, 10, 1),
labels = percent_format(scale = 10)) +
coord_cartesian(expand = 0)
Created on 2022-06-21 by the reprex package (v2.0.1)
I want to plot a bar like below.
Here is where I am.
attitude <- c('solid_blue', 'leaning_blue', 'toss_up', 'leaning_red', 'solid_red')
n_votes <- c(190, 108, 121, 39, 80)
group <- c(1,1,1,1,1)
df <- rbind(attitude, n_votes, group)
df <- as.data.frame(t(df))
ggplot(data = df) +
geom_bar(stat = 'identity', mapping = aes (x = group, y = n_votes, fill = attitude)) + coord_flip()
where df is like
attitude n_votes group
1 solid_blue 190 1
2 leaning_blue 108 1
3 toss_up 121 1
4 leaning_red 39 1
5 solid_red 80 1
I got a plot like this
The n_votes does not seem to accumulate correctly, how can I correct this?
Now I have this
Dan
Your main problem is because of the way you constructed your data frame, all the columns in it are character vectors. Look:
class(df$n_votes)
#> [1] "character"
It takes less code and gets better results to construct the data frame like this:
attitude <- c('solid_blue', 'leaning_blue', 'toss_up', 'leaning_red', 'solid_red')
n_votes <- c(190, 108, 121, 39, 80)
df <- data.frame(attitude, n_votes, group)
Now using your plot code (except noting that geom_bar(stat = "identity" is a long-hand way of writing geom_col(
ggplot(data = df) +
geom_col(aes(x = group, y = n_votes, fill = attitude)) +
coord_flip()
We get:
Or, if you want to get closer:
attitude <- c('solid_blue', 'leaning_blue', 'toss_up', 'leaning_red', 'solid_red')
n_votes <- c(190, 108, 121, 39, 80)
df <- data.frame(rev(attitude), rev(n_votes), group)
df$attitude <- factor(rev(attitude), levels = attitude)
ggplot(data = df) +
geom_col(aes(x = group, y = n_votes, fill = attitude)) +
scale_fill_manual(values = rev(c("#2558b1", "#77b3dd", "#cbcbcb", "#f3b0a7", "#d95551")),
guide = guide_none()) +
geom_text(check_overlap = TRUE, label = 298, size = 15,
x = 1.8, y = 0, hjust = 0, color = "#2558b1") +
geom_text(check_overlap = TRUE, label = 119, size = 15,
x = 1.8, y = sum(n_votes), hjust = 1, color = "#d95551") +
geom_text(check_overlap = TRUE, label = "Joe Biden\nDEMOCRAT",
size = 5, x = 1.8, y = 60, hjust = 0) +
geom_text(check_overlap = TRUE, label = "Donald J Trump\nREPUBLICAN",
size = 5, x = 1.8, y = sum(n_votes) - 60, hjust = 1) +
geom_text(check_overlap = TRUE, aes(x = group, y = n_votes, label = n_votes),
position = position_stack(vjust = 0.5), size = 5, color = "white") +
geom_segment(aes(x = 0.55, xend = 1.45, y = sum(n_votes)/2, yend = sum(n_votes)/2),
linetype = 2) +
coord_flip() +
theme_classic() +
scale_x_discrete(expand = expansion(add = c(0.7, 0.7))) +
theme(panel.background = element_rect(fill = "#fdf1e5"),
plot.margin = margin(50, 10, 50, 10),
axis.line = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())
I would like to produce a graphic combining four facets of a graph with insets in each facet showing a detail of the respective plot. This is one of the things I tried:
#create data frame
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
#do first basic plot
library(ggplot2)
plot1<-ggplot(data=data_frame, aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() + theme_bw() +
labs(title ="", x = "year", y = "sd")
plot1
#make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
plot2 <- plot1 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log",
breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
plot2
#extract inlays (this is where it goes wrong I think)
library(ggpmisc)
library(tibble)
library(dplyr)
inset <- tibble(x = 0.01, y = 10.01,
plot = list(plot2 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
coord_cartesian(xlim = c(13, 15),
ylim = c(3, 5)) +
labs(x = NULL, y = NULL, color = NULL) +
scale_colour_gradient(guide = FALSE) +
theme_bw(10)))
plot3 <- plot2 +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot)) +
annotate(geom = "rect",
xmin = 13, xmax = 15, ymin = 3, ymax = 5,
linetype = "dotted", fill = NA, colour = "black")
plot3
That leads to the following graphic:
As you can see, the colours in the insets are wrong, and all four of them appear in each of the facets even though I only want the corresponding inset of course. I read through a lot of questions here (to even get me this far) and also some examples in the ggpmisc user guide but unfortunately I am still a bit lost on how to achieve what I want. Except maybe to do it by hand extracting four insets and then combining them with plot2. But I hope there will be a better way to do this. Thank you for your help!
Edit: better graphic now thanks to this answer, but problem remains partially unsolved:
The following code does good insets, but unfortunately the colours are not preserved. As in the above version each inset does its own rainbow colours anew instead of inheriting the partial rainbow scale from the facet it belongs to. Does anyone know why and how I could change this? In comments I put another (bad) attempt at solving this, it preserves the colors but has the problem of putting all four insets in each facet.
library(ggpmisc)
library(tibble)
library(dplyr)
# #extract inlays: good colours, but produces four insets.
# fourinsets <- tibble(#x = 0.01, y = 10.01,
# x = c(rep(0.01, 4)),
# y = c(rep(10.01, 4)),
# plot = list(plot2 +
# facet_wrap( ~ max_rep, ncol=2) +
# coord_cartesian(xlim = c(13, 15),
# ylim = c(3, 5)) +
# labs(x = NULL, y = NULL, color = NULL) +
# scale_colour_gradientn(name = "number of replicates", trans = "log", guide = FALSE,
# colours = rainbow(20)) +
# theme(
# strip.background = element_blank(),
# strip.text.x = element_blank()
# )
# ))
# fourinsets$plot
library(purrr)
pp <- map(unique(data_frame$max_rep), function(x) {
plot2$data <- plot2$data %>% filter(max_rep == x)
plot2 +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
#pp[[2]]
inset_new <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
final_plot <- plot2 +
geom_plot_npc(data = inset_new, aes(npcx = x, npcy = y, label = plot, vp.width = 0.3, vp.height =0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
#final_plot
final_plot then looks like this:
I hope this clarifies the problem a bit. Any ideas are very welcome :)
Modifying off #user63230's excellent answer:
pp <- map(unique(data_frame$max_rep), function(x) {
plot2 +
aes(alpha = ifelse(max_rep == x, 1, 0)) +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
scale_alpha_identity() +
facet_null() +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
Explanation:
Instead of filtering the data passed into plot2 (which affects the mapping of colours), we impose a new aesthetic alpha, where lines belonging to the other replicate numbers are assigned 0 for transparency;
Use scale_alpha_identity() to tell ggplot that the alpha mapping is to be used as-is: i.e. 1 for 100%, 0 for 0%.
Add facet_null() to override plot2's existing facet_wrap, which removes the facet for the inset.
Everything else is unchanged from the code in the question.
I think this will get you started although its tricky to get the size of the inset plot right (when you include a legend).
#set up data
library(ggpmisc)
library(tibble)
library(dplyr)
library(ggplot2)
# create data frame
n_replicates <- c(rep(1:10, 15), rep(seq(10, 100, 10), 15), rep(seq(100,
1000, 100), 15), rep(seq(1000, 10000, 1000), 15))
sim_years <- rep(sort(rep((1:15), 10)), 4)
sd_data <- rep(NA, 600)
for (i in 1:600) {
sd_data[i] <- rnorm(1, mean = exp(0.1 * sim_years[i]), sd = 1/n_replicates[i])
}
max_rep <- sort(rep(c(10, 100, 1000, 10000), 150))
data_frame <- cbind.data.frame(n_replicates, sim_years, sd_data, max_rep)
# make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(`10` = "2, 3, ..., 10 replicates", `100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates", `10000` = "1000, 2000, ..., 10000 replicates")
Get overall plot:
# overall facet plot
overall_plot <- ggplot(data = data_frame, aes(x = sim_years, y = sd_data, group = n_replicates, col = n_replicates)) +
geom_line() +
theme_bw() +
labs(title = "", x = "year", y = "sd") +
facet_wrap(~max_rep, ncol = 2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log", breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
#plot
overall_plot
which gives:
Then from the overall plot you want to extract each plot, see here. We can map over the list to extract one at a time:
pp <- map(unique(data_frame$max_rep), function(x) {
overall_plot$data <- overall_plot$data %>% filter(max_rep == x)
overall_plot + # coord_cartesian(xlim = c(13, 15), ylim = c(3, 5)) +
labs(x = NULL, y = NULL) +
theme_bw(10) +
theme(legend.position = "none")
})
If we look at one of these (I've removed the legend) e.g.
pp[[1]]
#pp[[2]]
#pp[[3]]
#pp[[4]]
Gives:
Then we want to add these inset plots into a dataframe so that each plot has its own row:
inset <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
Then merge this into the overall plot:
overall_plot +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot, vp.width = 0.8, vp.height = 0.8))
Gives:
Here is a solution based on Z. Lin's answer, but using ggforce::facet_wrap_paginate() to do the filtering and keeping colourscales consistent.
First, we can make the 'root' plot containing all the data with no facetting.
library(ggpmisc)
library(tibble)
library(dplyr)
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
base <- ggplot(data=data_frame,
aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() +
theme_bw() +
scale_colour_gradientn(
name = "number of replicates",
trans = "log10", breaks = my_breaks,
labels = my_breaks, colours = rainbow(20)
) +
labs(title ="", x = "year", y = "sd")
Next, the main plot will be just the root plot with facet_wrap().
main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))
Then the new part is to use facet_wrap_paginate with nrow = 1 and ncol = 1 for every max_rep, which we'll use as insets. The nice thing is that this does the filtering and it keeps colour scales consistent with the root plot.
nmax_rep <- length(unique(data_frame$max_rep))
insets <- lapply(seq_len(nmax_rep), function(i) {
base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
guides(colour = "none", x = "none", y = "none") +
theme(strip.background = element_blank(),
strip.text = element_blank(),
axis.title = element_blank(),
plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
y = rep(10.01, nmax_rep),
plot = insets,
max_rep = unique(data_frame$max_rep))
main +
geom_plot_npc(data = insets,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.3, vp.height = 0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
Created on 2020-12-15 by the reprex package (v0.3.0)
I have a scatter plot where the y-axis scaling changes at a certain point to plot data with some extreme values. I'm trying to add some sort of visual cue on the y-axis that indicates that the scaling changes at the point.
Here's an example of a plot
library(scales)
library(ggplot2)
set.seed(104)
ggdata <- data.frame('x' = rep('a',100),
'y' = c(runif(90, 0, 20), runif(10, 90, 100)))
transformation <- trans_new(
"my_transformation",
transform = function(x) ifelse(x <= 30, x / 5, (x - 30) / 20 + 30 / 5),
inverse = function(x) ifelse(x <= 30 / 5, x * 5, (x - 30 / 5) * 20 + 30)
)
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous(trans = transformation, breaks = c(0, 10, 20, 30, 50, 70, 90, 110))
I want to add some marker to "tick 30" on y axis for scale change.
I was thinking of adding a double tick on the axis, but there is no linetype that looks like a double line. The product should look something like this. I'm aware of transforms like scale_y_log10, but I'd rather work with custom scaling that dynamically changes with the data.
EDIT: per #Tjebo's suggestion, I used annotate to add a "=" to the y axis breakpoint:
library(scales)
library(ggplot2)
set.seed(104)
ggdata <- data.frame('x' = rep('a',100),
'y' = c(runif(90, 0, 20), runif(10, 90, 100)))
transformation <- trans_new(
"my_transformation",
transform = function(x) ifelse(x <= 30, x / 5, (x - 30) / 20 + 30 / 5),
inverse = function(x) ifelse(x <= 30 / 5, x * 5, (x - 30 / 5) * 20 + 30)
)
mybreaks <- c(0, 10, 20, 30, 50, 70, 90, 110)
tick_linetype <- rep("solid", length(mybreaks))
tick_linetype[4] <- "blank"
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
annotate(geom = "point", shape = "=", x = -Inf, y = 30, size = 3) +
scale_y_continuous(trans = transformation, breaks = mybreaks) +
theme(axis.ticks.y = element_line(linetype = tick_linetype)) +
coord_cartesian(clip = 'off')
I was thinking of adding a double tick on the axis, but there is no
linetype that looks like a double line.
You can use any character as point shape. Also an equal sign, or back slash, etc.
For example:
library(scales)
library(ggplot2)
set.seed(104)
ggdata <- data.frame('x' = rep('a',100),
'y' = c(runif(90, 0, 20), runif(10, 90, 100)))
transformation <- trans_new(
"my_transformation",
transform = function(x) ifelse(x <= 30, x / 5, (x - 30) / 20 + 30 / 5),
inverse = function(x) ifelse(x <= 30 / 5, x * 5, (x - 30 / 5) * 20 + 30)
)
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
annotate(geom = "point", shape = "=", x = -Inf, y = 30, size = 8, color = 'red') +
scale_y_continuous(trans = transformation, breaks = c(0, 10, 20, 30, 50, 70, 90, 110))+
coord_cartesian(clip = 'off')
I removed the clipping, but you can also leave it. The color was just chosen for highlighting.
Or, even better, use text annotation. You can then also change the angle - kind of nice.
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
annotate(geom = "text", label = "=", x = -Inf, y = 30, size = 8, color = "red", angle = 45) +
scale_y_continuous(trans = transformation, breaks = c(0, 10, 20, 30, 50, 70, 90, 110)) +
coord_cartesian(clip = "off")
Created on 2020-04-21 by the reprex package (v0.3.0)
I cannot get the exact look that you linked to, but perhaps some of these ideas are useful to you.
You can make your specified value a minor break, and add a line only to minor breaks (here I was unable to pick the exact value of 20, since that was already a major break, but perhaps you can play around with the numbers to get something you like):
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous(trans = transformation, minor_breaks=20.05,breaks = c(0, 10,20, 30, 50, 70, 90, 110))+
theme(
panel.grid.minor.y = element_line(1)
)
Another option is to change the labels themselves. Here I have bolded and wrapped in () the 20 value, but you can add other symbols as well:
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous(trans = transformation, minor_breaks = c(0, 10, 20, 30, 50, 70, 90, 110),
breaks = c(0, 10, 20, 30, 50, 70, 90, 110), labels=c(0, 10, expression(bold(("20"))), 30, 50, 70, 90, 110))
You can add a segment to the plot, which here isn't the prettiest option since the x axis isn't continuous, but perhaps it will spur ideas:
ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous(trans = transformation, breaks = c(0, 10, 20, 30, 50, 70, 90, 110))+
geom_segment(aes(x=-.01,y=19.5,xend=.01,yend=20.5),size=1.5)
Perhaps you could also just shade the bottom (or top) portion of your plot:
ggplot(data = ggdata,aes(x = x, y = y)) +
geom_jitter() +
scale_y_continuous(trans = transformation,breaks = c(0, 10,20, 30, 50, 70, 90, 110))+
annotate("rect", xmin = .4, xmax = 1.6, ymin = 0, ymax = 21,
alpha = .2)
This solution should help with how you want your axis to look like. FWIW I would like to caution against breaking axes unless you explicitly tell your audience about them. In the code below I created two plots, one is for the data below 30 and the other data is for the extreme points (and remove its x axis and labels). Then I use plot.margin to set the plots margins so that they overlap a bit when I put them in a grid.arrange. You might have to mess with the margins to get the labels to line up.
library(scales)
library(ggplot2)
library(gridExtra)
set.seed(104)
ggdata <- data.frame('x' = rep('a',100),
'y' = c(runif(90, 0, 20), runif(10, 90, 100)))
p1 <- ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous(breaks = seq(0,30,5), limits = c(0,30))+
theme(plot.margin=unit(c(0,.83,0,1), "cm"))
p2 <- ggplot(data = ggdata) +
geom_jitter(aes(x = x, y = y)) +
scale_y_continuous( breaks = seq(60,100,10), limits = c(60,100)) +
scale_x_discrete()+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
plot.margin=unit(c(0,1,-0.1,1), "cm"))
grid.arrange(p2,p1)
I'd like to produce an area/bar graph in R similar to this:
(plot from David MacKay's (excellent) book "Sustainable Energy")
I honestly can't even find the proper name for a plot like this. It seems to be a bar graph with variable width bars. Certainty a powerful communication tool.
You can do this with base graphics. First we specify some widths and heights:
widths = c(0.5, 0.5, 1/3,1/4,1/5, 3.5, 0.5)
heights = c(25, 10, 5,4.5,4,2,0.5)
Then we use the standard barplot command, but specify the space between blocks to be zero:
##Also specify colours
barplot(heights, widths, space=0,
col = colours()[1:6])
Since we specified widths, we need to specify the axis labels:
axis(1, 0:6)
To add grid lines, use the grid function:
##Look at ?grid to for more control over the grid lines
grid()
and you can add arrows and text manually:
arrows(1, 10, 1.2, 12, code=1)
text(1.2, 13, "A country")
To add your square in the top right hand corner, use the polygon function:
polygon(c(4,4,5,5), c(20, 25, 25, 20), col="antiquewhite1")
text(4.3, 22.5, "Hi there", cex=0.6)
This all gives:
Aside: in the plot shown, I've used the par command to adjust a couple of aspects:
par(mar=c(3,3,2,1),
mgp=c(2,0.4,0), tck=-.01,
cex.axis=0.9, las=1)
Inspired by the code from the blog post I mentioned above,
df <- data.frame(x = c("Alpha", "Beta", "Gamma", "Delta"), width = c(25, 50, 75, 100), height = c(100, 75, 50, 25))
df$w <- cumsum(df$width)
df$wm <- df$w - df$width
df$wt <- with(df, wm + (w - wm)/2)
library(ggplot2)
p <- ggplot(df, aes(ymin = 0))
p1 <- p + geom_rect(aes(xmin = wm, xmax = w, ymax = height, fill = x))
library(grid) # needed for arrow function
p1 + geom_text(aes(x = wt, y = height * 0.8, label = x)) +
theme_bw() + labs(x = NULL, y = NULL) +
theme(axis.ticks = element_blank(),axis.text.x = element_blank(),
axis.text.y = element_blank(), legend.position = "none") +
annotate("text", x = 120, y = 83, label = "a Beta block") +
geom_segment(aes(x = 100, y = 80, xend = 80, yend = 75),
arrow = arrow(length = unit(0.5, "cm")))