Related
I need to add a "separating" line in Base R boxplot to separate difference groups. In the example below, I want to separate groups A and B (each having 2 levels) using a horizontal line (in red). R codes for reproducible results:
dat = data.frame(A1 = rnorm(1000, 0, 1), A2 = rnorm(1000, 1, 2),
B1 = rnorm(1000, 0.5, 0.5), B2 = rnorm(1000, 1.5, 1.5))
boxplot(dat, horizontal = T, outline=F)
Is there an easy way to do in Base R?
Also, is there an easy way to color the y-axis labels? I want to have A1 and B1 shown as red, and A2 and B2 shown as blue in the axis.
Thanks!
Use abline. To get the right position take the mean of the axTicks of the y-axis.
To get the colored labels, first omit yaxt and rebuild axis ticks and mtext, also using axTicks.
b <- boxplot(dat, horizontal=T, outline=F, yaxt="n")
ats <- axTicks(2)
axis(2, labels=F)
mtext(b$names, 2, 1, col=c(2, 4), at=ats)
abline(h=mean(ats), lwd=2, col=2)
If you want axis tick label colors corresponding to the labels, use segments instead.
b <- boxplot(dat, horizontal=T, outline=F, yaxt="n")
ats <- axTicks(2)
abline(h=mean(ats), lwd=2, col=2)
pu <- par()$usr
Map(function(x, y) segments(pu[1] - .2, x, pu[1], x, xpd=T, col=y), ats, c(2, 4))
mtext(b$names, 2, 1, col=c(2, 4), at=ats)
Edit: To adjust the space a little more use at=option in boxplot and leave out the middle axTicks.
b <- boxplot(dat, horizontal=T, outline=F, yaxt="n", at=c(1, 2, 4, 5))
ats <- axTicks(2)[-3]
abline(h=mean(ats), lwd=2, col=2)
pu <- par()$usr
Map(function(x, y) segments(pu[1] - .2, x, pu[1], x, xpd=T, col=y), ats, c(2, 4))
mtext(b$names, 2, 1, col=c(2, 4), at=ats)
I am working in RStudio and trying to make a 3x3 grid of the triangle plots built with the functions below. I’ve included a reproducible example, and the error I am running into is that the margins are too large to plot multiple plot, even though I am reducing the width and height.
I’ve also tried saving these as png and loading them in to arrange with cowplot, but the figure is very blurry and I’m not sure how to adjust the text size or line thickness to make the figures more legible.
#Data
iris$nrm.Sepal <- iris$Sepal.Width / iris$Sepal.Length
iris$nrm.Petal <- iris$Petal.Width / iris$Petal.Length
df_list <- split(iris, (iris$Species))
top.triangle <- function() {
plot(my.y ~ my.x, data= my.data, axes=FALSE, ylab='', xlab="",
main='', xlim=c(0, 1), ylim=c(0, 1), xaxt="n", yaxt="n", asp=1)
mtext("Here could be your title", 3, 5, font=2, cex=1.3, adj=.95)
mtext("Position.2", 2, .75)
mtext("Position.1", 3, 2)
axis(side=2, las=1, pos=0)
axis(side=3, las=1, pos=1)
lines(0:1, 0:1)
}
bottom.triangle <- function() {
points(my.x ~ my.y, data=my.data.2, xpd=TRUE)
mtext("Position.2", 1, 1.5, at=mean(par()$usr[1:2]) + x.dist)
mtext("Position.1", 4, 3, padj=par()$usr[1] + 10)
x.at <- axisTicks(par()$usr[1:2], 0) + x.dist
axis(side=1, las=1, pos=0, at=x.at,
labels=F, xpd=TRUE)
mtext(seq(0, 1, .2), 1, 0, at=x.at)
axis(4, las=1, pos=1 + x.dist)
lines(0:1 + x.dist, 0:1, xpd=TRUE)
}
#loop for generating species specific plots
for(i in 1:(length(df_list))){
current.strain <- as.character(df_list[[i]]$Species[1])
#declare file for saving png
# png(paste0("~.test.triangle_", current.strain, ".png"), width=650, height=500)
plot.new()
my.data = iris
my.x.top = (iris %>% filter(Species == current.strain) )$nrm.Petal
my.y.top = (iris %>% filter(Species == current.strain) )$nrm.Sepal
my.x.bottom = (iris %>% filter(Species == current.strain) )$nrm.Petal
my.y.bottom = (iris %>% filter(Species == current.strain) )$nrm.Sepal
op <- par(mar=c(3, 2, 2, 2) + 0.1, oma=c(2, 0, 0, 2))
top.triangle(my.y.top, my.x.top, my.data)
bottom.triangle(my.y.bottom+x.dist, my.x.bottom, my.data)
par(op)
RP[[i]] <- recordPlot()
dev.off()
}
#for margins too large error
graphics.off()
par("mar")
par(mar=c(.1,.1,.1,.1))
#draw and arrange the plots
ggdraw() +
draw_plot(RP[[1]], x=0, y=0)
#Add remaining plots
#draw_plot(RP[[2]], x=.25, y=.25)
#draw_plot(RP[[3]], x=.25, y=.25)
(this is built off the answer I posted from this question, R base plot, combine mirrored right triangles )
To use plot solution at specified link, you need to adjust to the iris data including your calculated columns, nrm.Sepal and nrm.Petal inside both functions. Then, instead of split, consider by to pass subsets into both functions for plotting. However, the plot will only generate 1 X 3. It is unclear how 3 X 3 is generated. Your posted link above actually duplicates
Data
iris$nrm.Sepal <- iris$Sepal.Width / iris$Sepal.Length
iris$nrm.Petal <- iris$Petal.Width / iris$Petal.Length
Functions
top.triangle <- function(my.data) {
plot(nrm.Sepal ~ nrm.Petal, data= my.data, axes=FALSE, ylab="", xlab="",
main='', xlim=c(0, 1), ylim=c(0, 1), xaxt="n", yaxt="n", asp=1)
mtext(my.data$Species[[1]], 3, 5, font=2, cex=1.3, adj=.95)
mtext("Position.2", 2, .75)
mtext("Position.1", 3, 2)
axis(side=2, las=1, pos=0)
axis(side=3, las=1, pos=1)
lines(0:1, 0:1)
}
bottom.triangle <- function(my.data) {
x.dist <- .5
my.data.2 <- transform(my.data, nrm.Sepal=nrm.Sepal + x.dist)
points(nrm.Petal ~ nrm.Sepal, data=my.data.2, col="red", xpd=TRUE)
mtext("Position.2", 1, 1.5, at=mean(par()$usr[1:2]) + x.dist)
mtext("Position.1", 4, 3, padj=par()$usr[1] + 3)
x.at <- axisTicks(par()$usr[1:2], 0) + x.dist
axis(side=1, las=1, pos=0, at=x.at,
labels=FALSE, xpd=TRUE)
mtext(seq(0, 1, 0.2), 1, 0, at=x.at, cex=0.7)
axis(4, las=1, pos=1 + x.dist)
lines(0:1 + x.dist, 0:1, xpd=TRUE)
}
Plot
par(mar=c(1, 4, 8, 6), oma=c(2, 0, 0, 2), mfrow=c(2,3))
by(iris, iris$Species, function(sub){
top.triangle(sub)
bottom.triangle(sub)
})
I'm trying to plot 4 lines from 4 different y-axis variables vs. the same x-axis variable on one graph. I am currently using:
plot(df$x1, df$y,
lines(smooth.spline(df$x1, df$y), col="red"),
main="Decrease over 10 years",
ylim = c(0, 10),
xlim = c(0,10),
xlab="Years",
ylab="Percentage",
pch="",
las = 1
)
points(df$x2, df$y,
lines(smooth.spline(df$x2, df$y), col="blue")
points(df$x3, df$y,
lines(smooth.spline(df$x3, df$y), col="green")
points(df$x4, df$y,
lines(smooth.spline(df$x4, df$y), col="black")
However, when I plot this I obtain the 4 desired curves, but also "o" points along the x-axis. Is there a way to remove these points (they don't refer to the data)? I've tried using the pch="" option, but this does not remove the points.
Thanks,
Mark
I tried to reproduce your problem with
set.seed(123)
df<-data.frame(
x1=sort(rnorm(25, 5, 2)),
x2=sort(rnorm(25, 5, 2)),
x3=sort(rnorm(25, 5, 2)),
x4=sort(rnorm(25, 5, 2))
)
df<-transform(df, y=x1*2-1+rnorm(25))
plot(df$x1, df$y, lines(smooth.spline(df$x1, df$y), col="red"))
points(df$x2, df$y, lines(smooth.spline(df$x2, df$y), col="blue"))
points(df$x3, df$y, lines(smooth.spline(df$x3, df$y), col="green"))
points(df$x4, df$y, lines(smooth.spline(df$x4, df$y), col="black"))
But i didn't see anything unusual on the plot. Can you explain how your data is different than the sample I generated?
I feel like this is a very basic question but I have spent a lot of time looking for an answer and haven't found one. So, if this is answered somewhere else I would love to be redirected rather than downvoted, please.
Anyway, my problem is that when I graph in R, often the y-axis will fail to extend to the end of my data. A sample graphic is below, where you can see that it would be better for the axis to go all the way to 30 rather than 20. However, submitting ylim = c(0,30) doesn't do anything and I cannot think of or find another command that would do the trick?
Here is a reproducible example. If ylim usually works then I am assuming something is breaking because of the aesthetic changes I've made?
set.seed(1)
x<-runif(1:1000, min=1, max=10)
hist(x, breaks=100, main=NA, axes=F, xlab = NA, ylab = NA)
axis(side = 1, tck= -.01, labels=NA)
axis(side = 2, tck=-.01, labels=NA)
axis(side = 1, lwd=0, line= -.4, cex.axis=1.4)
axis(side = 2, lwd=0, line=-.4, las=1, cex.axis=1.4)
mtext(side = 1, "Percent pathogenic bacteria", line = 2.5, cex=1.8)
mtext(side = 2, "Frequency", line = 2.5, cex=1.8)
Use ylim to specify the y axis range:
set.seed(3)
f <- function(y, ...)
hist(y, breaks=20, ...)
ylim <- range(pretty(ceiling(f(y <- rchisq(1000, 3), plot=FALSE)$counts/10)*10))
f(y, ylim=ylim) # versus f(y)
Earlier I asked about creating a gradient of n values in base graphics (LINK). Now I'd like to create a gradient legend that goes with it. My ideal would be something like ggplot2's gradient legends:
Here's some code similar to what I'm working with:
colfunc <- colorRampPalette(c("red", "blue"))
plot(1:20, 1:20, pch = 19, cex=2, col = colfunc(20))
Here is an example of how to build a legend from first principles using rasterImage from grDevices and layout to split the screen
layout(matrix(1:2,ncol=2), width = c(2,1),height = c(1,1))
plot(1:20, 1:20, pch = 19, cex=2, col = colfunc(20))
legend_image <- as.raster(matrix(colfunc(20), ncol=1))
plot(c(0,2),c(0,1),type = 'n', axes = F,xlab = '', ylab = '', main = 'legend title')
text(x=1.5, y = seq(0,1,l=5), labels = seq(0,1,l=5))
rasterImage(legend_image, 0, 0, 1,1)
Late to the party, but here is a base version presenting a legend using discrete cutoffs. Thought it might be useful for future searchers.
layout(matrix(1:2,nrow=1),widths=c(0.8,0.2))
colfunc <- colorRampPalette(c("white","black"))
par(mar=c(5.1,4.1,4.1,2.1))
plot(1:10,ann=FALSE,type="n")
grid()
points(1:10,col=colfunc(10),pch=19,cex=1.5)
xl <- 1
yb <- 1
xr <- 1.5
yt <- 2
par(mar=c(5.1,0.5,4.1,0.5))
plot(NA,type="n",ann=FALSE,xlim=c(1,2),ylim=c(1,2),xaxt="n",yaxt="n",bty="n")
rect(
xl,
head(seq(yb,yt,(yt-yb)/10),-1),
xr,
tail(seq(yb,yt,(yt-yb)/10),-1),
col=colfunc(10)
)
mtext(1:10,side=2,at=tail(seq(yb,yt,(yt-yb)/10),-1)-0.05,las=2,cex=0.7)
And an example image:
The following creates a gradient color bar with three pinpoints without any plot beforehand and no alien package is needed. Hope it is useful:
plot.new()
lgd_ = rep(NA, 11)
lgd_[c(1,6,11)] = c(1,6,11)
legend(x = 0.5, y = 0.5,
legend = lgd_,
fill = colorRampPalette(colors = c('black','red3','grey96'))(11),
border = NA,
y.intersp = 0.5,
cex = 2, text.font = 2)
As a refinement of #mnel's great answer, inspired from another great answer of #Josh O'Brien, here comes a way to display the gradient legend inside the plot.
colfunc <- colorRampPalette(c("red", "blue"))
legend_image <- as.raster(matrix(colfunc(20), ncol=1))
## layer 1, base plot
plot(1:20, 1:20, pch=19, cex=2, col=colfunc(20), main='
Awesome gradient legend inside')
## layer 2, legend inside
op <- par( ## set and store par
fig=c(grconvertX(c(0, 10), from="user", to="ndc"), ## set figure region
grconvertY(c(4, 20.5), from="user", to="ndc")),
mar=c(1, 1, 1, 9.5), ## set margins
new=TRUE) ## set new for overplot w/ next plot
plot(c(0, 2), c(0, 1), type='n', axes=F, xlab='', ylab='') ## ini plot2
rasterImage(legend_image, 0, 0, 1, 1) ## the gradient
lbsq <- seq.int(0, 1, l=5) ## seq. for labels
axis(4, at=lbsq, pos=1, labels=F, col=0, col.ticks=1, tck=-.1) ## axis ticks
mtext(sq, 4, -.5, at=lbsq, las=2, cex=.6) ## tick labels
mtext('diff', 3, -.125, cex=.6, adj=.1, font=2) ## title
par(op) ## reset par