Create gradient color bar with ggplot2 - r

I have the following code to create color bars, modified from here:
color.bar <- function(lut, title='') {
min <- -1
max <- -min
nticks <- 5
ticks <- seq(min, max, len=nticks)
scale <- length(lut)/(max-min)
pdf(NULL)
dev.control(displaylist="enable")
plot(c(min,max), c(10,0), type='n', bty='n', xaxt='n', xlab='', yaxt='n', ylab='', main=title, cex.main=3)
axis(1, ticks, las=1, labels=c('MIN','','','','MAX'), cex.axis=2)
for (i in 1:length(lut)) {
x = (i-1)/scale + min
rect(x, 0, x+1/scale, 10, col=lut[i], border=NA)
}
P <- recordPlot()
invisible(dev.off())
return(P)
}
myplot <- color.bar(colorRampPalette(c("light green", "yellow", "orange", "red"))(100), "Intensity")
myplot
Which produces the following:
Now what I would need would be to do the exact same in ggplot2, cause I want to add the result, along with a list of ggplots, to a pdf using grid.arrange.
I do not really know how to start... Anybody can help me get started to produce the same output using ggplot2?

Related

Beeswarm plot in R: weird gaps?

I've made a beeswarm plot in R by basically looping through groups in my data and creating a beeswarm for each group and combining into one plot:
#Build color field
color.By.Category <- function(x) {
if (x == "Polydrug") {
return("red")
} else if (x == "Opioid") {
return("blue")
} else if (x == "Cocaine") {
return("green")
} else if (x == "Gabapentin") {
return("orange")
} else if (x == "Meth") {
return("blue")
} else if (x == "Benzo") {
return("pink")
} else {
return("black")
}
}
# Make 5 rows, the first is the legend
par(mfrow=c(5,1), mar=c(0,10,0,0), oma=c(10,0,5,2), bg="black")
# Build legend
drug.categories <- unique(death.data.2$drug)
colr <- sapply(drug.categories, color.By.Category)
xleg <- seq(-10,110, by=23)
beeswarm(xleg, pwcol=colr,
horizontal = TRUE,
pch=15,
method="center",
cex=1,
xlim=c(-10,110),
ylim=c(-10,4))
text(x=xleg+0, y=.5, labels=toupper(drug.categories), col="white", pos=4, cex=1.1)
races <- unique(death.data.2$race)
for (i in 1:length(races)) {
# Subset to race/ethnicity
current <- death.data.2[death.data.2$race == races[i],]
# Draw the symbols
beeswarm(current$age, pwcol=current$color,
pch=15, method="center",
cex=1, horizontal=TRUE,
ylim=c(-10,10), xlim=c(0,100), axes=FALSE)
# label
mtext(races[i], side = 2, las=1, col="white", cex=.9)
}
x <- seq(0, 100, 5)
axis(side = 1, labels = x, at=x, col="black", col.ticks = "white")
mtext(x, side = 1, outer=FALSE, at=x, line=.8, col="white", cex=.8)
mtext("Age", side=1, at=x[1], outer=FALSE, col="white", line=2, adj=0.05, padj=.5, cex=.8)
# Title
mtext("Overdose Deaths by Substance Type", side=3, outer=TRUE, line=1, cex=1.5, col="white")
Which looks like this:
You can see there are weird gaps (i.e. blank lanes) where no data is showing, which almost looks like some kind of artifact from how the plot is rendering. What's going on here?
I believe you can remove the gaps by setting breaks = NA in your "Draw the symbols" beeswarm() call. The help file ?beeswarm tells us
breaks Breakpoints (optional). If NULL, breakpoints are chosen
automatically. If NA, bins are not used (similar to stripchart with
method = "stack").
So when the breaks = NA the binning behavior is prevented and the gaps should not appear.
# Draw the symbols
beeswarm(current$age, pwcol=current$color,
pch=15, method="center",
cex=1, horizontal=TRUE,
ylim=c(-10,10), xlim=c(0,100), axes=FALSE, breaks = NA)

how to plot matlab style log-log plot using R plot

ENV
R version 3.3.1
MAC OSX 10.9.4
I would like to plot a style like figure below, which is plotted by matlab.
There is full grid on the plot with customized axis range (e.g. $10^0~10^{-4}$) and axis label (e.g. 10^0 10^1 10^-2 10^-3 10^-4 10^-5). There are ten ticks between 10^0 and 10^1 and also other labels. Similar for y axis.
Expected:
I tried:
initial.dir<-getwd()
setwd("/Rworks/bin")
sink("r.o")
pk <- read.table("2017.file)
rownames(pk)<-c("k","pk")
d.f <- data.frame(t(pk))
png(file="m.png")
plot(
d.f$k,
d.f$pk,
type = "n",
log = "xy",
xlim = c( 10^0, 10^2),
ylim = c( 0.00001, 1),
)
lines( d.f$k, d.f$pk, col = "green4", lty = "dotted")
points( d.f$k, d.f$pk, bg = "limegreen", pch = 21 )
box()
dev.off
sink()
setwd(initial.dir)
I got:
The axis and axis label and the ticks and grid is not what I want. Can anyone can give an advices? Thanks.
Worst case scenario, you can just draw the axes and background lines yourself.
plot(
x=c(1,2), y=c(0.6,0.2),
pch=21, bg="red",
log = "xy",
xlim = c( 10^0, 10^2),
ylim = c( 0.00001, 1),
xaxt="n", yaxt="n",
xlab="", ylab="",
yaxs="i"
)
lines(x=c(1,2), y=c(0.6,0.2))
axis(1, at=10^(0:2),
labels=expression(10^0, 10^1, 10^2))
axis(2, at=10^(-5:0), las=1,
labels=expression(10^-5, 10^-4, 10^-3, 10^-2, 10^-1, 10^0))
abline(h=outer((1:10),(10^(-5:-1))), col="#00000033", lty=2)
abline(v=outer((1:10),(10^(0:1))), col="#00000033", lty=2)
Here's an example - it's not exactly what you want (e.g. you could play around with theme options such as panel.grid.minor to get dotted grid lines), but it's most of the way there.
Exponential-format axis tick labels, from here:
fancy_scientific <- function(l) {
# turn in to character string in scientific notation
l <- format(l, scientific = TRUE)
# quote the part before the exponent to keep all the digits
l <- gsub("^(.*)e", "'\\1'e", l)
# turn the 'e+' into plotmath format
l <- gsub("e", "%*%10^", l)
# return this as an expression
parse(text=l)
}
Manual ticks from #G5W's answer: might be possible to write a function to do this automatically, or one might exist somewhere.
yticks = outer((1:10),(10^(-5:-1)))
xticks = outer((1:10),(10^(0:1)))
Draw the plot (with #G5W's sample mini-data)
library(ggplot2)
ggplot(data.frame(x=1:2,y=c(0.6,0.2)),
aes(x,y))+
geom_point(colour="red")+
scale_x_log10(limits=c(1,100),labels=fancy_scientific,
minor_breaks=xticks)+
scale_y_log10(limits=c(1e-5,1),labels=fancy_scientific,
minor_breaks=yticks)+
theme_bw()

Arrange points and lines in an r plot legend

Is it possible to rearrange the legend of the following plot
plot(1,1, type="n")
legend("topleft", c("1", "2"), col=c("darkblue", "darkred"), pch = 1, bty = "n", horiz = T, lwd=1.25, cex=1.8)
to look like this ("point-line-point" pattern)?
Usually, if you want this level of control over plot elements, you'll have to do it manually with primitives (points(), lines()/segments(), text(), etc.) and careful calculations from the plot parameters (e.g. par('usr')). It's not easy. Here's an example of how this could be done:
point.line.point <- function(x1,y1,x2=x1,y2=y1,...) {
points(c(x1,x2),c(y1,y2),...);
segments(x1,y1,x2,y2,...);
};
legend.plp <- function(x,y,labels,col,linewidth=diff(par('usr')[1:2])/10,textgap=diff(par('usr')[1:2])/20,...) {
comb <- cbind(labels,col);
xc <- x;
for (i in seq_len(nrow(comb))) {
x2 <- xc+linewidth;
point.line.point(xc,y,x2,col=comb[i,'col'],...);
text(x2+textgap,y,comb[i,'labels'],...);
xc <- x2+textgap*1.5+strwidth(comb[i,'labels']);
};
};
plot(1,1,type="n");
legend.plp(par('usr')[1]+diff(par('usr')[1:2])/20,par('usr')[4]-diff(par('usr')[3:4])/20,1:2,c('darkblue','darkred'),font=2,cex=1.5);
Here is an alternative solution that is the opposite of elegant. It involves embedding a couple of plots (one per legend), and a great deal of manual manipulation (to set the 'legends' where you want them to be):
library(Hmisc)
data(mtcars)
#plots the one in blue
plot(mtcars$cyl, type="o", col="darkblue")
#plots the one in red
lines(mtcars$carb, type="o", col="darkred")
#name the legends
text(6.5,7, "Cyl", font=2)
text(14,7, "Carb", font=2)
#add the subplots, it's actually a normal plot wrapped around the subplot with the x and y positions
subplot(plot(c(1,0),c(1,1), xlab=NA, ylab=NA, xaxt="n", yaxt="n", col="darkblue", type="o", axes=FALSE), 3, 7)
subplot(plot(c(1,0),c(1,1), xlab=NA, ylab=NA, xaxt="n", yaxt="n", col="darkred", type="o", axes=FALSE), 10, 7)
That yields the following plot:

igraph network graph with color-gradient bar

I am trying to to add color-gradient bar below the network graph I draw using igraph. For some reason, the axis label of the color-gradient bar can't be shown. However , when I draw the color-gradient bar alone without the network graph, the axis label is perfectly shown. Any suggestion ?
colorstrip <- function(colors) {
count <- length(colors)
m <- matrix(1:count, count, 1)
par(mai=c(5, 50, 30, 50), cex.axis=2, ann=T, tck=-1)
image(m, col=colors, ylab="", axes=FALSE)
axis(side=3, at=seq(from=-0.165, to=1.22, by=0.332),
labels=letters[1:5])
}
library(igraph)
g <- graph.ring(10)
pdf("test_igraph.pdf", width=200, height=200)
layout(matrix(c(1,2), nrow=2), heights=c(2,0.5))
plot(g)
colorstrip(c("red", "mediumseagreen", "yellow", "blue"))
dev.off()
Original code was here
The labels are there, but they are very tiny. Zoom in in your PDF viewer and then you will see them.
The reason for them being tiny is that the plot itself is huge. For pdf() width and height is in inches, so you have a 200 in times 200 in figure. The solution is to make the figure smaller (or the letters bigger, but I guess you don't want to have a huge figure anyway):
colorstrip <- function(colors) {
count <- length(colors)
m <- matrix(1:count, count, 1)
par(mai=c(0.2, 2, 1, 2), cex.axis=2, ann=T, tck=-1)
image(m, col=colors, ylab="", axes=FALSE)
axis(side=3, at=seq(from=-0.165, to=1.22, by=0.332),
labels=letters[1:5])
}
library(igraph)
g <- graph.ring(10)
pdf("test_igraph.pdf", width=7, height=7)
layout(matrix(c(1,2), nrow=2), heights=c(2,0.5))
plot(g)
colorstrip(c("red", "mediumseagreen", "yellow", "blue"))
dev.off()
So this has nothing to do with igraph. Actually, even if you just plot the color strip, you will not see the labels.

layout add line R

In the 4th example of layout function, which can be generated by example(layout),
I want to overlay the line plot on the barplot of samples from a normal distriubtion.
I tried lines(), plot( , add=TRUE), but with no luck.
How can I do that? Or do I have to take a different route from using layout?
Here is one approach:
library(TeachingDemos)
x <- pmin(3, pmax(-3, stats::rnorm(50)))
y <- pmin(3, pmax(-3, stats::rnorm(50)))
xhist <- hist(x, breaks=seq(-3,3,0.5), plot=FALSE)
yhist <- hist(y, breaks=seq(-3,3,0.5), plot=FALSE)
top <- max(c(xhist$density, yhist$density))
xrange <- c(-3,3)
yrange <- c(-3,3)
nf <- layout(matrix(c(2,0,1,3),2,2,byrow=TRUE), c(3,1), c(1,3), TRUE)
layout.show(nf)
par(mar=c(3,3,1,1))
plot(x, y, xlim=xrange, ylim=yrange, xlab="", ylab="")
par(mar=c(0,3,1,1))
bx.out <- barplot(xhist$density, axes=FALSE, ylim=c(0, top), space=0)
updateusr( bx.out[1:2], 0:1, xhist$mids[1:2], 0:1 )
xdens <- density(x)
lines(xdens$x, xdens$y, col='blue')
par(mar=c(3,0,1,1))
by.out <- barplot(yhist$density, axes=FALSE, xlim=c(0, top), space=0, horiz=TRUE)
updateusr( 0:1, by.out[1:2], 0:1, yhist$mids[1:2] )
ydens <- density(y)
lines(ydens$y, ydens$x, col='blue')
Note the change from counts to density so that the "heights" of the bars will match with the density and the use of updateusr from the TeachingDemos package to match the coordinate systems. Instead of updateusr you could also specify width and xlim to the barplot function.

Resources