Adding a table to ggplot figure - r

I have dose response data:
df <- data.frame(dose=c(10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034,10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034,10,0.625,2.5,0.15625,0.0390625,0.0024414,0.00976562,0.00061034),viability=c(6.117463479317,105.176885855348,57.9126197628863,81.9068445005286,86.484379347143,98.3093580807309,96.4351897372596,81.831197750164,27.3331232120347,85.2221817678203,80.7904933803092,91.9801454635583,82.4963735273569,110.440066995265,90.1705406346481,76.6265869905362,11.8651732228561,88.9673125759484,35.4484427232156,78.9756635057238,95.836828982968,117.339025930735,82.0786828300557,95.0717213053837),stringsAsFactors=F)
I fit log-logistic model to these data using the drc R package:
library(drc)
fit <- drm(viability~dose,data=df,fct=LL.4(names=c("Slope","Lower Limit","Upper Limit","ED50")))
I then plot this curve with the standard error using:
pred.df <- expand.grid(dose=exp(seq(log(max(df$dose)),log(min(df$dose)),length=100)))
pred <- predict(fit,newdata=pred.df,interval="confidence")
pred.df$viability <- pred[,1]
pred.df$viability.low <- pred[,2]
pred.df$viability.high <- pred[,3]
library(ggplot2)
p <- ggplot(df,aes(x=dose,y=viability))+geom_point()+geom_ribbon(data=pred.df,aes(x=dose,y=viability,ymin=viability.low,ymax=viability.high),alpha=0.2)+labs(y="viability")+
geom_line(data=pred.df,aes(x=dose,y=viability))+coord_trans(x="log")+theme_bw()+scale_x_continuous(name="dose",breaks=sort(unique(df$dose)),labels=format(signif(sort(unique(df$dose)),3),scientific=T))+ggtitle(label="all doses")
Finally I'd like to add the parameter estimates to the plot as a table. I'm trying:
params.df <- cbind(data.frame(param=gsub(":\\(Intercept\\)","",rownames(summary(fit)$coefficient)),stringsAsFactors=F),data.frame(summary(fit)$coefficient))
rownames(params.df) <- NULL
ann.df <- data.frame(param=gsub(" Limit","",params.df$param),value=signif(params.df[,2],3),stringsAsFactors=F)
rownames(ann.df) <- NULL
xmin <- sort(unique(df$dose))[1]
xmax <- sort(unique(df$dose))[3]
ymin <- df$viability[which(df$dose==xmin)][1]
ymax <- max(pred.df$viability.high)
p <- p+annotation_custom(tableGrob(ann.df),xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax)
But getting the error:
Error: annotation_custom only works with Cartesian coordinates
Any idea?
Also,
once plotted, is there a way to suppress row names?

I'm not sure if there's a way around the annotation_custom error within "base" ggplot2. However, you can use draw_grob from the cowplot package to add the table grob (as described here).
Note that in draw_grob the x-y coordinates give the location of the lower left corner of the table grob (where the coordinates of the width and height of the "canvas" go from 0 to 1):
library(gridExtra)
library(cowplot)
ggdraw(p) + draw_grob(tableGrob(ann.df, rows=NULL), x=0.1, y=0.1, width=0.3, height=0.4)
Another option is to resort to grid functions. We create a viewport within the plot p draw the table grob within that viewport.
library(gridExtra)
library(grid)
Draw the plot p that you've already created:
p
Create a viewport within plot p and draw the table grob. In this case, the x-y coordinates give the location of the center of the viewport and therefore the center of the table grob:
vp = viewport(x=0.3, y=0.3, width=0.3, height=0.4)
pushViewport(vp)
grid.draw(tableGrob(ann.df, rows=NULL))
UPDATE: To remove the background colors of the table grob, you can manipulate the table grob theme elements. See the example below. I also justified the numbers so that they line up on the decimal point. For more information on editing table grobs, see the tableGrob vignette.
thm <- ttheme_minimal(
core=list(fg_params = list(hjust=rep(c(0, 1), each=4),
x=rep(c(0.15, 0.85), each=4)),
bg_params = list(fill = NA)),
colhead=list(bg_params=list(fill = NA)))
ggdraw(p) + draw_grob(tableGrob(ann.df, rows=NULL, theme=thm),
x=0.1, y=0.1, width=0.3, height=0.4)

Related

Annotate the axis ggplo2

I am trying to create an annotation (particularly a rectangle) over a ggplot. Here's what I want to get:
I have tried geom_rect but that can only draw inside the plot axis.
I have also attempted to use annotate_custom which this post mentions, but when I try to work with xmin = -3 (for instance), it doesn't work.
Thank you!
I'm gonna start by asking what you are trying to achieve with this? It seems odd, at least in your example.
But, it can be done. Because you did not provide a reproducible example, I've got something else. The goal here is to turn of the panel's clipping, such that elements that lie outside it's boundaries will be plotted.
library(ggplot2)
library(grid)
# Create a plot
p <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
Here, I'm adding a rectangle with rect. But this also modifies the x- and y-axis, so we fix these with coord_cartesian. You cannot use xlim as this will remove data points that fall outside the range.
g <- p + annotate('rect', xmin=-1, xmax=3, ymin=10, ymax=30, fill='blue', alpha=1/3) +
coord_cartesian(xlim=c(1, 4))
# Convert into a graphical object -- a grob
g <- ggplotGrob(g)
# Try printing g
g is an object that puts all the elements into a table-like structure. So now, we find the panel in the layout dataframe of g, and turn of clipping.
i <- which(g$layout$name == 'panel')
g$layout[i,'clip'] <- 'off'
Finally draw the grob:
# grid.newpage()
grid.draw(g)

Duplicate Same Legend Twice in Ggplot2

I am preparing a chart where I have client's requirement to put same legend on top and bottom. Using ggplot I can put it either at top or at bottom. But I am not aware about option of duplicating at both the places.
I have tried putting legend.position as c('top','bottom') but that is giving me error and I know if should give error.
Can it be done with other libraries? I want to same legend twice at top and at bottom?
Take this code for an instance
library(ggplot2)
bp <- ggplot(data=PlantGrowth, aes(x=group, y=weight, fill=group)) + geom_boxplot()
bp <- bp + theme(legend.position="bottom")
bp
You have to work with the intermediate graphic objects (grobs) that ggplot2 uses when being plotted.
I grabbed a function that was flowing around here on StackOverflow to extract the legend, and put it into a package that is now on CRAN.
Here's a solution:
library(lemon)
bp <- bp + theme(legend.position='bottom')
g <- ggplotGrob(bp)
l <- g_legend(g)
grid.arrange(g, top=l)
g_legend accepts both the grob-version (that cannot be manipulated with ggplot2 objects) and the ordinary ggplot2 objects. Using ggplotGrob is a one-way street; once converted you cannot convert it back to ggplot2. But, as in the example, we keep the original ggplot2 object. ;)
Depending on the use case, a center-aligned top legend may not be appropriate as in the contributed answer by #MrGrumble here: https://stackoverflow.com/a/46725487/5982900
Alternatively, you can copy the "guide-box" element of the ggplotGrob, append it to your grob object, and reset the coordinates to the top of the ggplot.
createTopLegend <- function(ggplot, heightFromTop = 1) {
g <- ggplotGrob(ggplot)
nGrobs <- (length(g$grobs))
legendGrob <- which(g$layout$name == "guide-box")
g$grobs[[nGrobs+ 1]] <- g$grobs[[legendGrob]]
g$layout[nGrobs+ 1,] <- g$layout[legendGrob,]
rightLeft <- unname(unlist(g$layout[legendGrob, c(2,4)]))
g$layout[nGrobs+ 1, 1:4] <- c(heightFromTop, rightLeft[1], heightFromTop, rightLeft[2])
g
}
Load the gridExtra package. From your ggplot object bp, use createTopLegend to duplicate another legend, then use grid.draw to produce your final figure. Note you may need to alter your plot margins depending on your figure.
library(ggplot2)
library(grid)
library(gridExtra)
bp <- ggplot(data=PlantGrowth, aes(x=group, y=weight, fill=group)) + geom_boxplot()
bp <- bp + theme(legend.position="bottom", plot.margin = unit(c(2,0,0,0), "lines"))
g <- createTopLegend(bp)
grid.draw(g)
# dev.off()
This will ensure the legend is aligned in the same way horizontally as it appears in your original ggplot.

R parallel coordinate plot with fixed scale on X-axis, no matter how large the plot becomes

I am trying to build a parallel coordinate diagram in R for showing the difference in ranking in different age groups. And I want to have a fixed scale on the Y axis for showing the values.
Here is a PC plot :
The goal is to see the slopes of the lines really well. So if I have value 1 that is bound with the value 1000, I want to see the line going aaall the way down steeply.
In R so far, if I have values that are too big, my plot is all squished so everything fits and it's hard to visualize anything.
My code for drawing the parallel coordinate plot is the following so far:
pc_18_34 <- read.table("parCoordData_18_24_25_34.csv", header=FALSE, sep="\t")
#name columns of data frame
colnames(pc_18_34) = c("18-25","25-34")
#build the parallel coordinate plot
# doc : http://docs.ggplot2.org/current/geom_path.html
group <- rep(c("Top 10", "Top 10-29", "Top 30-49"), each = 18)
df <- data.frame(id = seq_along(group), group, pc_18_34[,1], pc_18_34[,2])
colnames(df)[3] = "18-25"
colnames(df)[4] = "25-34"
library(reshape2) # for melt
dfm <- melt(df, id.var = c("id", "group"))
dfm[order(dfm$group,dfm$ArtistRank,decreasing=TRUE),]
colnames(dfm)[3] = "AgeGroup"
colnames(dfm)[4] = "ArtistRank"
ggplot(dfm, aes(x=AgeGroup, y=ArtistRank, group = id, colour = group), main="Tops across age groups")+ geom_path(alpha = 0.5, size=1) + geom_path(aes(color=group))
I have looked into how to get the scales to change in ggplot, using libraries like scales but when I had a layer of scale, the diagram doesn't even show up anymore.
Any thoughts on how to make to use a fixed scale (say difference of 1 in rank shown as 5px in the plot), even if it means that the plot is very tall ?
Thaanks !! :)
You can set the panel height to an absolute size based on the number of axis breaks. Note that the device won't scale automatically, so you'll have to adjust it manually for your plot to fit well.
library(ggplot2)
library(gtable)
p <- ggplot(Loblolly, aes(height, factor(age))) +
geom_point()
gb <- ggplot_build(p)
gt <- ggplot_gtable(gb)
n <- length(gb$panel$ranges[[1]]$y.major_source)
# locate the panel in the gtable layout
panel <- gt$layout$t[grepl("panel", gt$layout$name)]
# assign new height to the panels, based on the number of breaks
gt$heights[panel] <- list(unit(n*25,"pt"))
grid.newpage()
grid.draw(gt)

How to plot stacked point histograms?

What's the ggplot2 equivalent of "dotplot" histograms? With stacked points instead of bars? Similar to this solution in R:
Plot Histogram with Points Instead of Bars
Is it possible to do this in ggplot2? Ideally with the points shown as stacks and a faint line showing the smoothed line "fit" to these points (which would make a histogram shape.)
ggplot2 does dotplots Link to the manual.
Here is an example:
library(ggplot2)
set.seed(789); x <- data.frame(y = sample(1:20, 100, replace = TRUE))
ggplot(x, aes(y)) + geom_dotplot()
In order to make it behave like a simple dotplot, we should do this:
ggplot(x, aes(y)) + geom_dotplot(binwidth=1, method='histodot')
You should get this:
To address the density issue, you'll have to add another term, ylim(), so that your plot call will have the form ggplot() + geom_dotplot() + ylim()
More specifically, you'll write ylim(0, A), where A will be the number of stacked dots necessary to count 1.00 density. In the example above, the best you can do is see that 7.5 dots reach the 0.50 density mark. From there, you can infer that 15 dots will reach 1.00.
So your new call looks like this:
ggplot(x, aes(y)) + geom_dotplot(binwidth=1, method='histodot') + ylim(0, 15)
Which will give you this:
Usually, this kind of eyeball estimate will work for dotplots, but of course you can try other values to fine-tune your scale.
Notice how changing the ylim values doesn't affect how the data is displayed, it just changes the labels in the y-axis.
As #joran pointed out, we can use geom_dotplot
require(ggplot2)
ggplot(mtcars, aes(x = mpg)) + geom_dotplot()
Edit: (moved useful comments into the post):
The label "count" it's misleading because this is actually a density estimate may be you could suggest we changed this label to "density" by default. The ggplot implementation of dotplot follow the original one of Leland Wilkinson, so if you want to understand clearly how it works take a look at this paper.
An easy transformation to make the y axis actually be counts, i.e. "number of observations". From the help page it is written that:
When binning along the x axis and stacking along the y axis, the numbers on y axis are not meaningful, due to technical limitations of ggplot2. You can hide the y axis, as in one of the examples, or manually scale it to match the number of dots.
So you can use this code to hide y axis:
ggplot(mtcars, aes(x = mpg)) +
geom_dotplot(binwidth = 1.5) +
scale_y_continuous(name = "", breaks = NULL)
I introduce an exact approach using #Waldir Leoncio's latter method.
library(ggplot2); library(grid)
set.seed(789)
x <- data.frame(y = sample(1:20, 100, replace = TRUE))
g <- ggplot(x, aes(y)) + geom_dotplot(binwidth=0.8)
g # output to read parameter
### calculation of width and height of panel
grid.ls(view=TRUE, grob=FALSE)
real_width <- convertWidth(unit(1,'npc'), 'inch', TRUE)
real_height <- convertHeight(unit(1,'npc'), 'inch', TRUE)
### calculation of other values
width_coordinate_range <- diff(ggplot_build(g)$panel$ranges[[1]]$x.range)
real_binwidth <- real_width / width_coordinate_range * 0.8 # 0.8 is the argument binwidth
num_balls <- real_height / 1.1 / real_binwidth # the number of stacked balls. 1.1 is expanding value.
# num_balls is the value of A
g + ylim(0, num_balls)
Apologies : I don't have enough reputation to 'comment'.
I like cuttlefish44's "exact approach", but to make it work (with ggplot2 [2.2.1]) I had to change the following line from :
### calculation of other values
width_coordinate_range <- diff(ggplot_build(g)$panel$ranges[[1]]$x.range)
to
### calculation of other values
width_coordinate_range <- diff(ggplot_build(g)$layout$panel_ranges[[1]]$x.range)

Justification of multiple legends in ggmap/ggplot2

I am trying to make a map with two legends denoting shape and colour ("Type" and "Org" in the example below), and have the legends inset. I can place the legends, but I would like them to be left justified so that their left edges line up. I can't make them anything other than centred with respect to each other:
require(ggplot2)
require(ggmap)
require(grid)
require(mapproj)
data <- data.frame(Org=rep(c("ABCDEFG","HIJKLMNOP","QRSTUVWX"),4)
, Type=rep(c("Y","Z"),6), Lat=runif(12,48,54.5)
, Long=runif(12,-133.5,-122.5))
osmMap <- get_map(location=c(-134,47.5,-122,55), source = 'osm')
points <- geom_jitter(data=data, aes(Long, Lat, shape=Type
, colour=Org))
legend <- theme(legend.justification=c(0,0), legend.position=c(0,0)
, legend.margin=unit(0,"lines"), legend.box="vertical"
, legend.key.size=unit(1,"lines"), legend.text.align=0
, legend.title.align=0)
ggmap(osmMap) + points + legend
This option is now available in ggplot2 0.9.3.1, use
ggmap(osmMap) + points + legend + theme(legend.box.just = "left")
Old, manual solution:
Here is a solution:
require(gtable)
require(ggplot2)
require(ggmap)
require(grid)
require(mapproj)
# Original data
data <- data.frame(Org=rep(c("ABCDEFG","HIJKLMNOP","QRSTUVWX"),4),
Type=rep(c("Y","Z"),6), Lat=runif(12,48,54.5),
Long=runif(12,-133.5,-122.5))
osmMap <- get_map(location=c(-134,47.5,-122,55), source = 'google')
points <- geom_jitter(data=data, aes(Long, Lat, shape=Type, colour=Org))
legend <- theme(legend.justification=c(0,0), legend.position=c(0,0),
legend.margin=unit(0,"lines"), legend.box="vertical",
legend.key.size=unit(1,"lines"), legend.text.align=0,
legend.title.align=0)
# Data transformation
p <- ggmap(osmMap) + points + legend
data <- ggplot_build(p)
gtable <- ggplot_gtable(data)
# Determining index of legends table
lbox <- which(sapply(gtable$grobs, paste) == "gtable[guide-box]")
# Each legend has several parts, wdth contains total widths for each legend
wdth <- with(gtable$grobs[[lbox]], c(sum(as.vector(grobs[[1]]$widths)),
sum(as.vector(grobs[[2]]$widths))))
# Determining narrower legend
id <- which.min(wdth)
# Adding a new empty column of abs(diff(wdth)) mm width on the right of
# the smaller legend box
gtable$grobs[[lbox]]$grobs[[id]] <- gtable_add_cols(
gtable$grobs[[lbox]]$grobs[[id]],
unit(abs(diff(wdth)), "mm"))
# Plotting
grid.draw(gtable)
This does not depend on Type or Org. However, this would not be enough having more than two legends. Also, in case you do some changes so that list of grobs (graphical objects) is altered, you might need to change grobs[[8]] to grobs[[i]] where i is the position of your legends, see gtable$grobs and look for TableGrob (5 x 3) "guide-box": 2 grobs.
Edit: 1. Automatically detecting which grob is legends table, i.e. no need to change anything after modifying other parts of plot. 2. Changed calculation of width differences, now code should work when having any two legends, i.e. in more complex cases as well, for example:

Resources