multiple columns of information ggplot y axis - r

I want to write multiple pieces of information in each y-axis label of a ggplot bar chart (or any similar kind of plot). The problem is having everything aligned nicely.
It's probably best explained with an example for what I want to have:
My primary issue is the formatting on the left side of the figure.
What I've tried so far includes using monospace fonts to write the labels. This basically works but I want to try and avoid the use of monospace fonts for aesthetic purposes.
I've also tried making several ggplots where the idea was to remove everything in two initial plots, except for the y-axis labels (so these "plots" would only be the y-axis labels). Then align the plots next to each other using grid.align. The problem I have here is that there doesn't seem to be a way to remove the plot part of a ggplot (or is there?). It also requires some tweaking since removing x-axis labels in one of the "empty" plots would result in the labels moving down (since no space is occupied by the x-axis labels/title anymore).
I've also tried an approach using geom_text and setting the appropriate distances using the hjust parameter. However, for some reason, the spacing does not seem to be equal for the different size labels (for example distances for the "Red" and "Turquoise" labels are different for the same hjust). As the real data has many more variations in label sizes this variation makes the table look very messy...
I'm not too concerned about the headers since they are easy to add to the figure manually. The values on the right are also not too much of a problem since they have a fixed width and I can use geom_text to set them. So my main problem is with the y-axis (left) labels.
Here's an example data set:
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))

The closest I could come to is to use guide_axis_nested() from ggh4x for formatting the left part. (Disclaimer: I'm the author of ggh4x). With this axis, you can't align spanning categories (e.g group) to the top, nor have titles for the different levels.
library(ggplot2)
library(ggh4x)
# Create some dummy data
df <- expand.grid(
group = paste("Group", c("alpha", "beta", "delta", "gamma")),
shirt = c("Red", "Turquoise")
)
df$N <- sample(1:100, nrow(df))
df$mean <- rlnorm(nrow(df), meanlog = 1)
df$pvalue <- runif(nrow(df))
ggplot(df, aes(x = mean, y = interaction(N, shirt, group, sep = "&"))) +
geom_col() +
guides(
y = guide_axis_nested(delim = "&"),
y.sec = guide_axis_manual(
breaks = interaction(df$N, df$shirt, df$group, sep = "&"),
labels = scales::number(df$pvalue, 0.001)
)
) +
theme(
axis.text.y.left = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nesttext.y = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nestline = element_blank()
)
Created on 2021-11-16 by the reprex package (v1.0.0)

I think #teunbrand provided a very neat solution and code-wise a lot cleaner than mine. However, I also tried another approach using annotation_custom() (based on this answer in another question). The result is quite nice and it should be fairly easy to customize.
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
lvls = c(1,2,3,4,5,6,7,8),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))
dt$groups = paste(dt$group, dt$shirt)
dt$groups = factor(dt$groups, levels=rev(dt$groups))
p2 = ggplot(dt) +
geom_col(aes(x=groups, y=mean)) +
coord_flip(clip='off') +
theme_bw() +
theme(axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.margin = unit(c(0.5,1,0,3.5), "in") # top, right, bottom, left
)
# Compute the position on the X axis for each information column
# I wanted fixed widths for the margins, so I basically compute what the X value
# would be on a specific location of the figure.
x_size = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] - ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] # length of x-axis
p_width = par()$din[1] - 4.5 # width of plot minus the margins as defined above in: plot.margin = unit(c(0.5,1,0,3.5), "in")
rel_x_size = p_width / x_size # size of one unit X in inch
col1_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (3 / rel_x_size) # the Group column, 3 inch left of the start of the plot
col2_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (1.5 / rel_x_size) # the Shirt column, 1.5 inches left of the start of the plot
col3_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (0.25 / rel_x_size) # the N column, 0.25 inches left of the start of the plot
col4_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] + (0.2 / rel_x_size) # the P-val column, 0.2 inches right of the end of the plot
# Set the values for each "row"
i_range = 1:nrow(dt)
i_range_rev = rev(i_range) # Because we reversed the order of the groups
for (i in i_range) {
if(i %% 2 == 0) {
# Group
p2 = p2 + annotation_custom(grob = textGrob(label = dt$group[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
}
# Shirt
p2 = p2 + annotation_custom(grob = textGrob(label = dt$shirt[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
# N
p2 = p2 + annotation_custom(grob = textGrob(label = dt$n[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
# P-val
p2 = p2 + annotation_custom(grob = textGrob(label = dt$p[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
}
# Add the headers
i = i+1
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Group')), hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Shirt')), hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('N')), hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('P-val')), hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
p2
Output:
What is basically done, is that margins for the figure are set in plot.margin in the initial plot. Some computation is then performed to determine the correct location for each column of information. Subsequently we loop through the data set and set the values in each column using annotation_custom(). Finally, we can add the headers in a similar manner.
Note: if you resize the plot window (in RStudio for example), you need to re-run the code otherwise the layout will be messed up.

Related

How to add direct labels to a bar chart in ggplot for numeric x axis

I am trying to create a bar chart in ggplot where the widths of the bars are associated with a variable Cost$Sum.of.FS_P_Reduction_Kg. I am using the argument width=Sum.of.FS_P_Reduction_Kg to set the width of the bars according to a variable.
I want to add direct labels to the chart to label each bar, similar to the image documented below. I am also seeking to add in x axis labels corresponding to the argument width=Sum.of.FS_P_Reduction_Kg. Any help would be greatly appreciated. I am aware of ggrepel but haven't been able to get the desired effect so far.
I have used the following code:
# Plot the data
P1 <- ggplot(Cost,
aes(x = Row.Labels,
y = Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost,
width = Average.of.FS_Annual_P_Reduction_Kg, label = Row.Labels)) +
geom_col(fill = "grey", colour = "black") +
geom_label_repel(
arrow = arrow(length = unit(0.03, "npc"), type = "closed", ends = "first"),
force = 10,
xlim = NA) +
facet_grid(~reorder(Row.Labels,
Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost),
scales = "free_x", space = "free_x") +
labs(x = "Measure code and average P reduction (kg/P/yr)",
y = "Mean annual TOTEX (£/kg) of P removal (thousands)") +
coord_cartesian(expand = FALSE) + # remove spacing within each facet
theme_classic() +
theme(strip.text = element_blank(), # hide facet title (since it's same as x label anyway)
panel.spacing = unit(0, "pt"), # remove spacing between facets
plot.margin = unit(c(rep(5.5, 3), 10), "pt"), # more space on left for axis label
axis.title=element_text(size=14),
axis.text.y = element_text(size=12),
axis.text.x = element_text(size=12, angle=45, vjust=0.2, hjust=0.1)) +
scale_x_discrete(labels = function(x) str_wrap(x, width = 10))
P1 = P1 + scale_y_continuous(labels = function(x) format(x/1000))
P1
The example data table can be reproduced with the following code:
> dput(Cost)
structure(list(Row.Labels = structure(c(1L, 2L, 6L, 9L, 4L, 3L,
5L, 7L, 8L), .Label = c("Change the way P is applied", "Improve management of manure",
"In channel measures to slow flow", "Keep stock away from watercourses",
"No till trial ", "Reduce runoff from tracks and gateways", "Reversion to different vegetation",
"Using buffer strips to intercept pollutants", "Water features to intercept pollutants"
), class = "factor"), Average.of.FS_Annual_P_Reduction_Kg = c(0.11,
1.5425, 1.943, 3.560408144, 1.239230769, 18.49, 0.091238043,
1.117113762, 0.11033263), Average.of.FS_._Change = c(0.07, 0.975555556,
1.442, 1.071692763, 1.212307692, 8.82, 0.069972352, 0.545940711,
0.098636339), Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost = c(2792.929621,
2550.611429, 964.061346, 9966.056875, 2087.021801, 57.77580744,
165099.0425, 20682.62962, 97764.80805), Sum.of.Total_._Cost = c(358.33,
114310.49, 19508.2, 84655, 47154.23, 7072, 21210, 106780.34,
17757.89), Average.of.STW_Treatment_Cost_BASIC = c(155.1394461,
155.1394461, 155.1394461, 155.1394461, 155.1394461, 155.1394461,
155.1394461, 155.1394461, 155.1394461), Average.of.STW_Treatment_Cost_HIGH = c(236.4912345,
236.4912345, 236.4912345, 236.4912345, 236.4912345, 236.4912345,
236.4912345, 236.4912345, 236.4912345), Average.of.STW_Treatment_Cost_INTENSIVE = c(1023.192673,
1023.192673, 1023.192673, 1023.192673, 1023.192673, 1023.192673,
1023.192673, 1023.192673, 1023.192673)), class = "data.frame", row.names = c(NA,
-9L))
I think it will be easier to do a bit of data prep so you can put all the boxes in one facet with a shared x-axis. For instance, we can calc the cumulative sum of reduction Kg, and use that to define the starting x for each box.
EDIT -- added ylim = c(0, NA), xlim = c(0, NA), to keep ggrepel::geom_text_repel text within positive range of plot.
library(ggplot2)
library(ggrepel)
library(stringr)
library(dplyr)
Cost %>%
arrange(desc(Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost)) %>%
mutate(Row.Labels = forcats::fct_inorder(Row.Labels),
cuml_reduc = cumsum(Average.of.FS_Annual_P_Reduction_Kg),
bar_start = cuml_reduc - Average.of.FS_Annual_P_Reduction_Kg,
bar_center = cuml_reduc - 0.5*Average.of.FS_Annual_P_Reduction_Kg) %>%
ggplot(aes(xmin = bar_start, xmax = cuml_reduc,
ymin = 0, ymax = Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost)) +
geom_rect(fill = "grey", colour = "black") +
geom_text_repel(aes(x = bar_center,
y = Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost,
label = str_wrap(Row.Labels, 15)),
ylim = c(0, NA), xlim = c(0, NA), ## EDIT
size = 3, nudge_y = 1E4, nudge_x = 2, lineheight = 0.7,
segment.alpha = 0.3) +
scale_y_continuous(labels = scales::comma) +
labs(x = "Measure code and average P reduction (kg/P/yr)",
y = "Mean annual TOTEX (£/kg) of P removal (thousands)")
You could experiment with scaling the values a little bit, e.g. using logarithmization. Since I prefer baseplots over gglplot2 I show you a base solution using barplot accordingly.
First, we transform the firs column into rownames and delete it.
cost <- `rownames<-`(Cost[-1], Cost[,1])
Defining widths in barplot is quite straightforward, since it has an option width= where we put in the logarithmized values of the according variable. For the bar-labels we need to calculate the positions and use text; to achieve line-wraps we may use strwrap. A label can conveniently left out if it's a hardship case (as #6 in the example). Finally we use (headless) arrows .
# logarithmize values
w <- log(w1 <- cost$Average.of.Cost_Per_Kg_P_Removal.undiscounted..LOW_Oncost)
# define vector labels inside / outside, at best by hand
inside <- as.logical(c(0, 1, 0, 1, 1, 0, 1, 1, 1))
# calculate `x0` values of labels
x0 <- w / 2 + c(0, cumsum(w)[- length(w)])
# define y values o. labels
y0 <- ifelse(inside, colSums(t(cost)) / 2, 1.5e5)
# make labels using 'strwrap'
labs <- mapply(paste, strwrap(rownames(cost), 15, simplify=F), collapse="\n")
# define nine colors
colores <- hcl.colors(9, "Spectral", alpha=.7)
# the actual plot
b <- barplot(cs <- colSums(t(cost)), width=w, space=0, ylim=c(1, 2e5),
xlim=c(-1, 80), xaxt="n", xaxs="i", col=colores, border=NA,
xlab="Measure code and average P reduction (kg/P/yr)",
ylab="Mean annual TOTEX (£/kg) of P removal (thousands)")
# place lables, leave out # 6
text(x0[-6], y0[-6], labels=labs[-6], cex=.7)
# arrows
arrows(x0[c(1, 3)], 1.35e5, x0[c(1, 3)], cs[c(1, 3)], length=0)
# label # 6
text(40, 1e5, labs[6], cex=.7)
# arrow # 6
arrows(40, 8.4e4, x0[6], cs[6], length=0)
# make x axis
axis(1, c(0, cumsum(log(seq(0, 1e5, 1e4)[-1]))),
labels=format(c(0, cumsum(seq(0, 1e5, 1e4)[-1])), format="d"), tck=-.02)
# put it in a box
box()
Result
I hope I got the x axis values right.
You probably have to figure out a little how the probably new functions work, but it's quite easy using the help files, e.g. type ?barplot.

Six Variable Line Graph Without a Legend

I'm looking to replicate the design of the first plot seen in this post:
http://stats.blogoverflow.com/2011/12/andyw-says-small-multiples-are-the-most-underused-data-visualization/
This was taken from [1], but in that book there is no code shown for the figure.
This figure in the link has no legend, and instead shows the labels 'IN', 'MO', ect. in a staggered fashion positioned at the height of the respective line they represent. I know how to make plots using ggplot2, but the specific issue I'm having is writing code to make the labels on the right side of the figure like that. Could someone demonstrate how to do this?
1: Carr, Daniel & Linda Pickle. 2009. Visualizing Data Patterns with Micromaps. Boca Rotan, FL. CRC Press.
This is no easy task, especially to do programmatically. It involves working with grobs, nothing hard, but usually done manually on finished products, rather than generated procedurally.
Data
df <- read.table(text = 'Samples Day.1 Day.2 Day.3 Day.4
Seradigma335 1.2875 1.350 1.850 1.6125
Seradigma322 0.9375 2.400 1.487 1.8125
Sigma 1.1250 1.962 1.237 2.0500
Shapiro_red 0.7750 1.575 1.362 1.0125
Shapiro_w/red 0.7750 1.837 0.975 0.8250', header = T)
(taken from another question here on SO)
Code
library(tidyr)
library(ggplot2)
tidy_df <- df %>%
gather('Day','Value', -Samples)
Simple plot
g <- ggplot(tidy_df) +
geom_line(aes(Day, Value, group = Samples), show.legend = F) +
scale_x_discrete(expand = c(.02,0)) +
scale_y_continuous(limits = c(0,3)) +
theme_grey() +
theme(plot.margin = unit(c(0,.2,0,0), 'npc'),
panel.border = element_rect(color = 'black', fill = NA),
axis.ticks = element_blank()
)
Note the right margin (set with plot.margin = unit(c(0,.2,0,0), 'npc'))
Labels
library(cowplot)
g <- g +
draw_label(label = df$Samples[1], x = 4.1, y = df$Day.4[1], hjust = 0) +
draw_label(label = df$Samples[2], x = 4.1, y = df$Day.4[2], hjust = 0) +
draw_label(label = df$Samples[3], x = 4.1, y = df$Day.4[3], hjust = 0) +
draw_label(label = df$Samples[4], x = 4.1, y = df$Day.4[4], hjust = 0) +
draw_label(label = df$Samples[5], x = 4.1, y = df$Day.4[5], hjust = 0)
We added the labels directly to the plot (as opposed to a grob, see documentation), with an x of 4.1, so it's actually just outside the panel (Day.4 has an x of 4) and covered by the margin (it's called clipping).
Remove clipping
# transform to grob
gt <- ggplotGrob(g)
# set panel's clipping to off
gt$layout$clip[gt$layout$name == "panel"] <- "off"
# draw the grob
ggdraw(gt)
Notes
We can kind of speed up the label creation with a for loop:
for (i in 1:nrow(df)) {
g <- g + draw_label(label = df$Samples[i], x = 4.1, y = df$Day.4[i], hjust = 0)
}
But we can't really map to vars as we are used to with aesthetics.
As I said at the beginning these methods require quite a bit of work to find the right balance and positioning, that can't certainly be expected for a quick plot, but if something has to be published it may be worth.
You can use geom_label with the nudge_x argument like this:
library(data.table) # I always use data.table but not required
library(ggplot2)
a <- c(1:10)
b <- c(seq(1,20,2))
c <- c(seq(1,30,3))
d <- c(1:10)
aa <- data.table(a,b,c,d)
ggplot(aa)+
geom_line(aes(a,b))+
geom_line(aes(a,c))+
geom_line(aes(a,d))+
geom_label(aes(10,10), label = "line 1", nudge_x = 1)+
geom_label(aes(10,19), label = "line 2", nudge_x = 1)+
geom_label(aes(10,29), label = "line 3", nudge_x = 1)
You can directly input the ordered pair that corresponds to the desired location of your label. The plot looks like this:

Using ggplot to plot occupied parking spaces in a parking lot

I’d like to use ggplot to draw a grid plot of the following scenario which I’ve attempted to depict in the picture below... I could use some guidance on how to logically think about the approach. Thank you for the guidance.
--
Each aisle in the example picture below has an odd number side—and an even number side
The spaces on the odd-side are listed ascending from 1… K where K is odd
The spaces on the even-side are listed ascending from 2…N where N is even
This pattern exists for each aisle in the parking lot
If a car is parked in a space—we track that spot in a database.
How can I reproduce a grid-level ggplot to indicate with a symbol on the plot all spaces where a car is parked?
The listing of occupied spaces would be “fed” into the ggplot logic via a .csv file: the format of the .csv would look something like this:
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36
...
Image credit: Michael Layefsky, 2010, Google Images
My experience with direct use of grid is limited, so I can't say how hard this would be with grid functions, but it seems reasonably straightforward in ggplot2. Here's a simple example that is (I hope) not too far off from what you're looking for:
library(ggplot2)
# Set up grid of space identifiers
df = data.frame(y=1:10, x=rep(c(0:1, 3:4, 6:7), each=10),
space=paste0(rep(c("A","B","C"), each=20),
rep(c(seq(2,20,2),seq(1,20,2)), 3)),
stringsAsFactors=FALSE)
# Assume we have a vector of occupied spaces
set.seed(194)
occupied = sample(df$space, 30)
# Mark occupied spaces in data frame
df$status = ifelse(df$space %in% occupied, "Occupied", "Available")
ggplot(df) +
geom_segment(aes(x=x - 0.5, xend=x + 0.5, y=y, yend=y - 1)) +
geom_label(aes(label=space, x=x, y=y, fill=status), colour="blue", label.size=0) +
annotate(geom="segment", x=seq(0.5,6.5,3), xend=seq(0.5,6.5,3),
y=rep(0,3), yend=rep(10,3), lty="11") +
theme_bw(base_size=14) +
scale_fill_manual(values=c(hcl(c(105,15),100,65))) +
#scale_fill_manual(values=c(NA, hcl(15,100,65))) + # Color only occupied spaces
theme(axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()) +
labs(x="",y="",fill="")
If you are taking a list of only the occupied spots as input in the form that you showed, and then you want to produce a visualization of occupied spots using ggplot2, this approach will work. First, I process the input, turning it into something that I can give ggplot easily.
# the provided example data
d <- read.table(text="
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36", stringsAsFactors=FALSE)
Split the "spaces" into meaningful coordinates. I kept the original space names around for later labeling. What follows is all manipulation used to get the plot set up correctly.
cars <- strsplit(d[,1], "(?<=[A-Z])", perl=TRUE) # split the raw data
# turn resulting list into data.frame and give it names
cars <- setNames(do.call(rbind.data.frame, cars), c("aisle","spot.num"))
# convert the from factors to numeric,
# and turn the aisle letter into numeric data for plotting
# retain the original spot id for labeling the plot
cars <- with(cars, data.frame(
spot.num = as.numeric(as.character(spot.num)),
aisle = aisle, # keep this around for faceting
aisle.coord = 2 * (utf8ToInt(paste(as.character(aisle), collapse="")) - utf8ToInt("A")),
spot.id = d[,1]))
I multiplied the aisle by 2 after converting A to 1, B to 2, and so on, to make a new variable called aisle.coord. The reason for multiplying by 2 is to set up a variable where each aisle can be composed of two lines:
# if the spot number is even, increment aisle by 1 (put it on the right).
# This is possible because I multiplied by 2 earlier
cars$aisle.coord[cars$spot.num %% 2 == 0] <- cars$aisle.coord[cars$spot.num %% 2 == 0] + 1
# We need to adjust the spot numbers to real row numbers
# i.e. A02 is in row 1, not row 2, A10 is in row 5, etc.
cars$spot <- ceiling(cars$spot.num / 2)
Now, the plotting:
library(ggplot2)
library(grid) # for unit()
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8) +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white")
That is a bare-bones attempt at the graph. Lots of room for you to improve and adjust it. Here is another attempt with a little more effort. Still, plenty of room for adjustment (e.g. you could adjust the plot so that a the full lot appears, not just the part of the lot up to the maximum spot: B44):
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8, fill = "orange") +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white", size = 4) +
annotate("rect", ymin = 0, ymax = max(cars$spot)+0.5, xmin = 0.3, xmax = 0.7, fill = "grey40") +
theme(panel.margin.x = unit(0.05, "lines"),
plot.background = element_rect("grey40"),
panel.background = element_rect("grey40"),
panel.grid.minor = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
strip.text = element_blank(),
strip.background = element_blank()) +
scale_y_continuous(breaks = seq(0.5, (max(cars$spot) + 0.5), 1)) +
scale_x_continuous(breaks = c(-0.3, 1.3)) +
geom_text(data=data.frame(x = 0.5, y = 10, aisle = LETTERS[1:length(unique(cars$aisle))]),
aes(x = x, y = y, label = aisle), inherit.aes = FALSE, color = "white")

textGrob placement relative to changing plot size

I'm producing a whole pile of graphs of changing sizes. I want each graph to display a symbol (say, asterisk) at a specific point on the graph margin (top y-axis value), regardless of plot size. Right now I do it manually by defining x/y for each textGrob, but there has got to be a better way.
Plot size is determined by number of categories in the dataset (toy data below). Ideally, the output plots would have identical panel sizes (I'm assuming that can be controlled through defining margin sizes in inches and adding that value to the height parameter?). Widths don't usually change, but it would be nice to automate both x and y placements based on the defined device width (and plot margins).
Thanks so much!
library(ggplot2)
library(gridExtra)
set.seed(123)
df <- data.frame(x = rnorm(20, 0, 1), y = rnorm(20, 0, 1), category = rep(c("a", "b"), each = 10))
## plot 1
sub <- df[df$category == "a",]
height = 2*length(unique(sub$category))
p <- ggplot(sub) +
geom_point(aes(x = x, y = y)) +
facet_grid(category ~ .)
jpeg(filename = "fig1.jpg",
width = 6, height = height, units = "in", pointsize = 12, res = 900,
quality = 100)
g <- arrangeGrob(p, sub = textGrob("*", x = 0.07, y = 10.15, hjust = 0, vjust=0, #### puts the top discharge value; might need to be adjusted manually in following years
gp = gpar(fontsize = 15)))
grid.draw(g)
dev.off()
## plot 2
height = 2*length(unique(df$category))
p <- ggplot(df) +
geom_point(aes(x = x, y = y)) +
facet_grid(category ~ .)
jpeg(filename = "fig2.jpg",
width = 6, height = height, units = "in", pointsize = 12, res = 900,
quality = 100)
g <- arrangeGrob(p, sub = textGrob("*", x = 0.07, y = 23.1, hjust = 0, vjust=0, #### puts the top discharge value; might need to be adjusted manually in following years
gp = gpar(fontsize = 15)))
grid.draw(g)
dev.off()

Wrapping / bending text around a circle in plot

Is there any chance to write text which is "wrapped" around the circle? I mean something like this:
Yes, and here is the code, free of charge :-) . I wrote this a while back but I don't think ever published it in any CRAN package.
# Plot symbols oriented to local slope.
# Interesting problem: if underlying plot has some arbitrary aspect ratio,
# retrieve by doing: Josh O'B via SO:
# myasp <- with(par(),(pin[2]/pin[1])/(diff(usr[3:4])/diff(usr[1:2])))
# so make that the default value of argument 'asp'
# Default is 'plotx' is vector of indices at which to
# plot symbols. If is_indices=FALSE, only then turn to splinefun to
# calculate y-values and slopes; and user beware.
#
# 6 Feb 2014: added default col arg so can stick in a color vector if desired
# TODO
#
slopetext<-function(x,y,plotx, mytext, is_indices=TRUE, asp=with(par(), (pin[1]/pin[2])*(diff(usr[3:4])/diff(usr[1:2]))),offsetit= 0, col='black', ...) {
if (length(x) != length(y)) stop('data length mismatch')
if (!is.numeric(c(x,y,plotx) ) ) stop('data not numeric')
if(is_indices) {
# plotting at existing points.
if(any(plotx<=1) | any(plotx>= length(x))) {
warning("can't plot endpoint; will remove")
plotx<-plotx[(plotx>1 & plotx<length(x))]
}
lows<-plotx-1
highs<-plotx+1
# then interpolate low[j],high[j] to get slope at x2[j]
slopes <- (y[highs]-y[lows])/(x[highs]-x[lows]) #local slopes
# sign(highlow) fix the rotation problem
angles <- 180/pi*atan(slopes/asp) + 180*(x[lows] > x[highs] )
intcpts <- y[highs]-slopes*x[highs]
ploty <- intcpts + x[plotx]*slopes
# change name, so to speak, to simplify common plotting code
plotx<-x[plotx]
}else{
#interpolating at plotx values
if (any(plotx<min(x)) | any(plotx>max(x)) ) {
warning("can't plot extrapolated point; will remove")
plotx<-plotx[(plotx>min(x) & plotx<max(x))]
}
spf<-splinefun(x,y)
ploty<-spf(plotx)
angles <- 180/pi * atan(spf(plotx,1)/asp) #getting first deriv, i.e. slope
} #end of else
xlen<-length(plotx) # better match y and mytext
# The trouble is: srt rotates about some non-centered value in the text cell
# Dunno what to do about that.
dely <- offsetit*cos(angles)
delx <- offsetit*sin(angles)
# srt must be scalar
mytext<-rep(mytext,length=xlen)
col <- rep(col,length=xlen)
for (j in 1:xlen) text(plotx[j], ploty[j], labels=mytext[j], srt= angles[j], adj=c(delx,dely),col=col[j], ...)
}
Edit: per David's excellent suggestion, a sample case:
x <- 1:100
y <- x/20 + sin(x/10)
plot(x,y,t='l')
slopetext(x=x,y=y,plotx=seq(10,70,by=10),mytext=letters[1:8])
The third argument in this example selects every tenth value of (x,y) for placement of the text.
I should warn that I haven't idiot-proofed the is_indices=FALSE case and the spline fit may in extreme cases place your text in funny ways.
plotrix::arctext
library(plotrix)
# set up a plot with a circle
plot(x = 0, y = 0, xlim = c(-2, 2), ylim = c(-2, 2))
draw.circle(x = 0, y = 0, radius = 1)
# add text
arctext(x = "wrap some text", center = c(0, 0), radius = 1.1, middle = pi/2)
arctext(x = "counterclockwise", center = c(0, 0), radius = 1.1, middle = 5*pi/4,
clockwise = FALSE, cex = 1.5)
arctext(x = "smaller & stretched", center = c(0, 0), radius = 1.1, middle = 2*pi ,
cex = 0.8, stretch = 1.2)
circlize
For greater opportunities of customization, check the circlize package (see the circlize book). By setting facing = "bending" in circos.text, the text wraps around a circle.
library(circlize)
# create some angles, labels and their corresponding factors
# which determine the sectors
deg <- seq(from = 0, to = 300, by = 60)
lab <- paste("some text", deg, "-", deg + 60)
factors <- factor(lab, levels = lab)
# initialize plot
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
# add text to each sector
lapply(factors, function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending")
})
circos.clear()
From circlize version 0.2.1, circos.text has two new options: bending.inside which is identical to original bending and bending.outside (see Figure 3.4 in the circlize book). Thus, it is easy to turn the text in the bottom half of the plot using bending.outside:
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
lapply(factors[1:3], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.outside")
})
lapply(factors[4:6], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.inside")
})
circos.clear()
The figure in the question can now be recreated quite easily in ggplot using the geomtextpath package:
library(geomtextpath)
df <- data.frame(x = c(0, 5.5, 6, 5.2, 0, 0.5, 0) + 8 * rep(0:5, each = 7),
y = rep(c(0, 0, 1, 2, 2, 1, 0), 6) + 8,
id = rep(1:6, each = 7))
df2 <- data.frame(x = c(3, 11, 19, 27, 35, 43), y = 9, id = 1:6,
z = paste("text", 0:5 * 60))
ggplot(df, aes(x, y, group = id)) +
geom_polygon(fill = "red", color = "black") +
geom_hline(yintercept = 9, color = "red", alpha = 0.3, size = 7) +
geom_textpath(data = df2, aes(label = z), size = 7, upright = FALSE) +
ylim(c(0, 10)) +
xlim(c(0, 48)) +
coord_polar(theta = "x", direction = -1, start = -pi/4) +
theme_void()
Disclaimer: I'm co-author of said package.

Resources