Adding a logo to Multi plot output in R or ggplot2 - r

I have trying to add a logo to the output derived from grid.arrange or arrangeGrob.
I have the below code:
library(ggplot2)
p1 <- ggplot(ChickWeight, aes(x=Time, y=weight, colour=Diet, group=Chick)) +
geom_line() +
ggtitle("Growth curve for individual chicks")
p2 <- ggplot(ChickWeight, aes(x=Time, y=weight, colour=Diet)) +
geom_point(alpha=.3) +
geom_smooth(alpha=.2, size=1) +
ggtitle("Fitted growth curve per diet")
p3 <- ggplot(subset(ChickWeight, Time==21), aes(x=weight, colour=Diet))
+ geom_density() +
ggtitle("Final weight, by diet")
p4 <- ggplot(subset(ChickWeight, Time==21), aes(x=weight, fill=Diet)) +
geom_histogram(colour="black", binwidth=50) +
ggtitle("Final weight, by diet")
I have used grid.arrange(p1,p2,p3,p4,ncol=2,clip=4) to put multiple plots to a single plot.
But I am having issue while inserting a logo to the above grid.arrange output.
I tried the below method, but got the below error message.
b <- rasterGrob(img, width=unit(5,"cm"), x = unit(40,"cm"))
z1 <- ggplotGrob(grid.arrange(p1,p2,p3,p4,ncol=2,clip=4))
z1<- gtable_add_grob(z1,b, t=1,l=1, r=5)
grid.newpage()
grid.draw(z1)
Error: No layers in plot
Is there a way or method to add a logo to the output after arrangeGrob or grid.arrange.

Not a gtable answer, but this is a slightly different way to add the logo that might help
library(ggplot2)
library(grid)
library(png)
library(gridExtra)
# Read png
img <- readPNG(system.file("img", "Rlogo.png", package="png"), FALSE)
# Create grobs to add to plot
my_g <- grobTree(rectGrob(gp=gpar(fill="black")),
textGrob("Some text", x=0, hjust=0, gp=gpar(col="white")),
rasterGrob(img, x=1, hjust=1))
# Plot
p <- ggplot(mtcars , aes(wt , mpg)) +
geom_line() +
theme(plot.margin=unit(c(1, 1, 1,1), "cm"))
# Add as a strip along top
grid.arrange(my_g, arrangeGrob(p,p,p,p, ncol=2), heights=c(1, 9))

Related

ggplotly with geom_ribbon grouping

I'm having some problems in converting a ggplot in to a plotly object, and retaining the same legend attributes. What I want:
For grouped series, a single line for fit, and faded region for ribbon of same colour, with transparency
No lines at the edge of the ribbon
Grouped legends for the lines, points and ribbons
Here is the code showing the 2 approaches I tried based on this answer:
ggplot: remove lines at ribbon edges
Both have an undesirable effect as you can see when running. Any suggestions would be great :)
library(plotly)
library(ggplot2)
# fake data
set.seed(1)
dt <- data.frame(x=rep(1:7,2), group=rep(letters[1:2], each=7), value=runif(14))
dt$lwr <- dt$value*.9
dt$upr <- dt$value*1.1
# build plot in ggplot, don't want lines at the edge
pl <- ggplot(data=dt, aes(y=value, x=x, group=group, colour=group,
fill=group)) +
geom_point() +
geom_line() +
geom_ribbon(aes(ymin=lwr, ymax=upr), alpha=.3, linetype=0) +
theme_minimal()
# looks ok, no lines at the edges
pl
# lines at edges, single group
ggplotly(pl)
# alternative: try reverting colour to NA
pl2 <- ggplot(data=dt, aes(y=value, x=x, group=group, colour=group,
fill=group)) +
geom_point() +
geom_line() +
geom_ribbon(aes(ymin=lwr, ymax=upr), alpha=.3, colour=NA) +
theme_minimal()
# looks ok
pl2
# no lines, but now not grouped, and some weird naming
ggplotly(pl2)
Thanks, Jonny
EDIT:
Addition to the accepted answer, in functional form
# dd: ggplotly object
library(stringi)
library(rvest)
remove_ggplotly_ribbon_lines <- function(dd){
find <- rvest::pluck(dd$x$data, "fillcolor")
w <- which(!sapply(find, is.null))
for(i in w){
dd$x$data[[i]]$line$color <-
stringi::stri_replace_all_regex(dd$x$data[[i]]$line$color, ",[\\d.]*\\)$", ",0.0)")
}
return(dd)
}
remove_ggplotly_ribbon_lines(ggplotly(pl))
Hi this is more a comment than an answer but I do not have right to post comments.
If you investigate the ggplotly object you will see that it is actually just a list. Changing the right elements of the list helps in controlling plot options.
The solution below just changes the alpha of the lines at ribbon edges. Hope this helps
library(plotly)
set.seed(1)
dt <- data.frame(x=rep(1:7,2), group=rep(letters[1:2], each=7), value=runif(14))
dt$lwr <- dt$value*.9
dt$upr <- dt$value*1.1
# build plot in ggplot, don't want lines at the edge
pl <- ggplot(data=dt, aes(y=value, x=x, group=group, colour=group,
fill=group)) +
geom_point() +
geom_line() +
geom_ribbon(aes(ymin=lwr, ymax=upr), alpha=.3, linetype=0) +
theme_minimal()
# looks ok, no lines at the edges
pl
# no lines at edges
dd = ggplotly(pl)
dd$x$data[[3]]$line$color = "rgba(248,118,109,0.0)"
dd$x$data[[4]]$line$color = "rgba(0,191,196,0.0)"
dd

X axis label is not showing in clustering dendrogram in ggplot

I have done a clustering dendrogram following a previous code I found online, but the x-axis of is not being shown in the graph. I would like to have the dissimilarity value shown in the x-axis, but I have not been successful.
females<-cervidae[cervidae$Sex=="female",]
dstf <- daisy(females[,9:14], metric = "euclidean", stand = FALSE)
hcaf <- hclust(dstf, method = "ave")
k <- 3
clustf <- cutree(hcaf,k=k) # k clusters
dendrf <- dendro_data(hcaf, type="rectangle") # convert for ggplot
clust.dff <- data.frame(label=rownames(females), cluster=factor(clustf),
females$Genus, females$Species)
dendrf[["labels"]] <- merge(dendrf[["labels"]],clust.dff, by="label")
rectf <- aggregate(x~cluster,label(dendrf),range)
rectf <- data.frame(rectf$cluster,rectf$x)
ymax <- mean(hcaf$height[length(hcaf$height)-((k-2):(k-1))])
fem=ggplot() +
geom_segment(data=segment(dendrf), aes(x=x, y=y, xend=xend, yend=yend)) +
geom_text(data=label(dendrf), aes(x, y, label= females.Genus, hjust=0,
color=females.Genus),
size=3) +
geom_rect(data=rectf, aes(xmin=X1-.3, xmax=X2+.3, ymin=0, ymax=ymax),
color="red", fill=NA)+
coord_flip() + scale_y_reverse(expand=c(0.2, 0)) +
theme_dendro() + scale_color_discrete(name="Genus") +
theme(legend.position="none")
Here is how my dendrogram looks:
Your code included theme_dendro(), which is described in its help file as:
Sets most of the ggplot options to blank, by returning blank theme
elements for the panel grid, panel background, axis title, axis text,
axis line and axis ticks.
You force the x-axis line / text / ticks to be visible in theme():
ggplot() +
geom_segment(data=segment(dendrf), aes(x=x, y=y, xend=xend, yend=yend)) +
geom_text(data=label(dendrf), aes(x, y, label= label, hjust=0,
color=cluster),
size=3) +
geom_rect(data=rectf, aes(xmin=X1-.3, xmax=X2+.3, ymin=0, ymax=ymax),
color="red", fill=NA)+
coord_flip() +
scale_y_reverse(expand=c(0.2, 0)) +
theme_dendro() +
scale_color_discrete(name="Cluster") +
theme(legend.position="none",
axis.text.x = element_text(), # show x-axis labels
axis.ticks.x = element_line(), # show x-axis tick marks
axis.line.x = element_line()) # show x-axis lines
(This demonstration uses a built-in dataset, since I'm not sure what's cervidae. Code used to create this is reproduced below:)
library(cluster); library(ggdendro); library(ggplot2)
hcaf <- hclust(dist(USArrests), "ave")
k <- 3
clustf <- cutree(hcaf,k=k) # k clusters
dendrf <- dendro_data(hcaf, type="rectangle") # convert for ggplot
clust.dff <- data.frame(label=rownames(USArrests),
cluster=factor(clustf))
dendrf[["labels"]] <- merge(dendrf[["labels"]],clust.dff, by="label")
rectf <- aggregate(x~cluster,label(dendrf),range)
rectf <- data.frame(rectf$cluster,rectf$x)
ymax <- mean(hcaf$height[length(hcaf$height)-((k-2):(k-1))])

Edit 2 stat_hex_bin geoms separately ggplot2

I start by giving you my example code:
x <- runif(1000,0, 5)
y <- c(runif(500, 0, 2), runif(500, 3,5))
A <- data.frame("X"=x,"Y"=y[1:500])
B <- data.frame("X"=x,"Y"=y[501:1000])
ggplot() +
stat_bin_hex(data=A, aes(x=X, y=Y), bins=10) +
stat_bin_hex(data=B, aes(x=X, y=Y), bins=10) +
scale_fill_continuous(low="red4", high="#ED1A3A")
It produces the following plot:
Now I want the lower hexagons to follow a different scale. Namely ranging from a dark green to a lighter green. How can I achieve that?
Update:
As you can see from the answers so far, I am asking myself whether there is a solution without using alpha scales. Also, using two plots with no margin or something similar is not an option for my specific application. Though they both are legitimate answers :)
Rather than trying to get two different fill scales in one plot you could alter the colours of the lower values, after the plot has been built. The basic idea is have two plots with the differing fill scales and then copy accross certain details from one plot to the other.
# Base plot
p <- ggplot() +
stat_bin_hex(data=A, aes(x=X, y=Y), bins=10) +
stat_bin_hex(data=B, aes(x=X, y=Y), bins=10)
# Produce two plots with different fill colours
p1 <- p + scale_fill_continuous(low="red4", high="#ED1A3A")
p2 <- p + scale_fill_continuous(low="darkgreen", high="lightgreen")
# Get fill colours for second plot and overwrite the corresponding
# values in the first plot
g1 <- ggplot_build(p1)
g2 <- ggplot_build(p2)
g1$data[[1]][,"fill"] <- g2$data[[1]][,"fill"]
# You can draw this now but there is only one legend
grid.draw(ggplot_gtable(g1))
To have two legends you can join the legends from the two plots together
# Bind the legends from the two plots together
g1 <- ggplot_gtable(g1)
g2 <- ggplot_gtable(g2)
g1$grobs[[grep("guide", g1$layout$name )]] <-
rbind(g1$grobs[[grep("guide", g1$layout$name )]],
g2$grobs[[grep("guide", g2$layout$name )]] )
grid.newpage()
grid.draw(g1)
Giving (from set.seed(10) prior to data generation)
This should provide more or less what you want
ggplot() +
stat_bin_hex(data=A, aes(x=X, y=Y, alpha=..count..), bins=10,fill="green") +
stat_bin_hex(data=B, aes(x=X, y=Y, alpha=..count..), bins=10,fill="red")
To avoid that the grey is disturbing due to the alpha one could underlay the plot with another white plot at the same location and darken the colours a bit, as suggested by the TO in the comments
#just the red to show the impact due to scale_alpha
ggplot() +scale_alpha_continuous(range=c(0.5,1))+ stat_bin_hex(data=A, aes(x=X, y=Y), bins=10,fill="white",show.legend = TRUE) +
+ stat_bin_hex(data=A, aes(x=X, y=Y, alpha=..count..), bins=10,fill="red",show.legend = TRUE) +
+ stat_bin_hex(data=B, aes(x=X, y=Y, alpha=..count..), bins=10,fill="green", show.legend=TRUE)+guides(fill=FALSE, alpha=FALSE)
An alternative, if you want more options to play with the colours, just create two plots and remove all the space between the two plots when combined with grid.arrange().
p1 <- ggplot() + stat_bin_hex(data=B, aes(x=X, y=Y), bins=10) +
scale_fill_continuous(low="red4", high="#ED1A3A") + xlab("") + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), plot.margin=unit(c(1,1,-0.5,1), "cm")) + scale_y_continuous(limits = c(2.5, 5.5))
p2 <- ggplot() + stat_bin_hex(data=A, aes(x=X, y=Y), bins=10) + scale_fill_continuous(low="darkgreen", high="green") + theme(plot.margin=unit(c(-0.5,1,1,1), "cm")) + scale_y_continuous(limits = c(-0.5, 2.5))
grid.arrange(p1,p2)

Manually creating a legend when you can't supply a color aesthetic

In attempting to answer this question, one way to create the desired plot was to use geom_dotplot from ggplot2 as follows:
library(ggplot2)
library(reshape2)
CTscores <- read.csv(text="initials,total,interest,slides,presentation
CU,1.6,1.7,1.5,1.6
DS,1.6,1.7,1.5,1.7
VA,1.7,1.5,1.5,2.1
MB,2.3,2.0,2.1,2.9
HS,1.2,1.3,1.4,1.0
LS,1.8,1.8,1.5,2.0")
CTscores.m = melt(CTscores, id.var="initials")
ggplot(CTscores.m, aes(x=variable, y=value)) +
geom_dotplot(binaxis="y", stackdir="up",binwidth=0.03) +
theme_bw()+coord_flip()
In order to distinguish the points, it would be convenient to just add color, but geom_dotplot chokes on color and doesn't end up stacking them:
ggplot(CTscores.m, aes(x=variable, y=value, fill=initials)) +
geom_dotplot(binaxis="y", stackdir="up",binwidth=0.03,color=NA) +
theme_bw()+coord_flip()
Color can be added manually using a hack, though:
gg_color_hue <- function(n) {
hues = seq(15, 375, length=n+1)
hcl(h=hues, l=65, c=100)[1:n]
}
cols <- rep(gg_color_hue(6),4)
ggplot(CTscores.m, aes(x=variable, y=value)) +
geom_dotplot(binaxis="y", stackdir="up",binwidth=0.03,fill=cols,color=NA) +
theme_bw()+coord_flip()
Unfortunately, there's no legend. On top of that we can't use aes(fill=) to try to add a legend manually because it will collapse the dots. Is there any way to add a legend without using aes()?
With the help of the gtable package you can extract the legend from the plot with the legend which fails to stack the dots and add that legend with grid.arrange from the gridExtra package to the plot with the colored ans stacked dots as follows:
p1 <- ggplot(CTscores.m, aes(x=variable, y=value)) +
geom_dotplot(binaxis="y", stackdir="up", binwidth=0.03, fill=cols, color=NA) +
coord_flip() +
theme_bw()
p2 <- ggplot(CTscores.m, aes(x=variable, y=value, fill=initials)) +
geom_dotplot(binaxis="y", stackdir="up", binwidth=0.03, color=NA) +
coord_flip() +
theme_bw()
library(gtable)
fill.legend <- gtable_filter(ggplot_gtable(ggplot_build(p2)), "guide-box")
legGrob <- grobTree(fill.legend)
library(gridExtra)
grid.arrange(p1, legGrob, ncol=2, widths = c(4,1))
which gives:

Connect dots with splines

How do I smooth the edges in line plot? I can do I line plot like this:
data <- data.frame(x=1:10, y=c(22,23,21,25,23,24,20,27,22,24))
ggplot(data, aes(x,y)) +
geom_line(colour='forestgreen')
However, I don't like sharp edges. Is there a way to draw a line through those points so that the line is smooth?
This is one way to do it:
library(ggplot2)
library(splines)
library(gridExtra)
dat <- data.frame(x=1:10, y=c(22,23,21,25,23,24,20,27,22,24))
plot.new() # have to do this unfortunately
res <- xspline(dat$x, dat$y, -0.25, draw=FALSE)
gg1 <- ggplot(dat, aes(x,y)) +
geom_line(colour='forestgreen') +
geom_point()
gg2 <- ggplot(data=data.frame(x=res$x, y=res$y), aes(x, y)) +
geom_point(data=dat, aes(x, y), size=1) +
geom_line(color="blue")
grid.arrange(gg1, gg2, ncol=1)
This is using xspline to do the interpolation. Lookup the function to see what tweaking the -0.25 parameter (range is -1 to 1) will do.

Resources