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)
})
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 was trying to follow this tutorial (https://popgen.nescent.org/2018-03-27_RDA_GEA.html) and plot the RDA, but I would like to remove the two dashed lines (x=0 and y=0). Does anyone know how to get rid of them?
This is the graph I'm talking about
According to this post you can alter a plot.rda() to remove the dotted lines if you build the plot up yourself from scratch, but it's a complicated/challenging task. The easiest/best solution in my opinion is to draw white lines over the dotted lines with abline(h = 0, v = 0, col = "white", lwd = 2) and redraw the plot borders with box() before you plot the points/lines. See the ## PLOTTING ## section below for an example:
## OBTAIN & LOAD THE DATA ##
#install.packages(c("psych","vegan"), dependencies=TRUE)
library(psych) # Used to investigate correlations among predictors
library(vegan) # Used to run RDA
temp <- tempfile()
download.file("https://github.com/NESCent/popgenInfo/blob/master/data/wolf_geno_samp_10000.zip?raw=true",
temp)
gen <- read.csv(unzip(temp, "wolf_geno_samp_10000.csv"), row.names=1)
dim(gen)
sum(is.na(gen))
gen.imp <- apply(gen,
2,
function(x) replace(x,
is.na(x),
as.numeric(names(which.max(table(x))))))
sum(is.na(gen.imp)) # No NAs
env <- read.csv(url("https://raw.githubusercontent.com/NESCent/popgenInfo/master/data/wolf_env.csv"))
str(env)
env$individual <- as.character(env$individual)
env$land_cover <- as.factor(env$land_cover)
identical(rownames(gen.imp), env[,1])
pairs.panels(env[,5:16], scale=T)
pred <- subset(env, select=-c(precip_coldest_quarter, max_temp_warmest_month, min_temp_coldest_month))
table(pred$land_cover)
pred <- subset(pred, select=-c(land_cover))
pred <- pred[,5:12]
colnames(pred) <- c("AMT","MDR","sdT","AP","cvP","NDVI","Elev","Tree")
pairs.panels(pred, scale=T)
wolf.rda <- rda(gen.imp ~ ., data=pred, scale=T)
wolf.rda
RsquareAdj(wolf.rda)
summary(eigenvals(wolf.rda, model = "constrained"))
screeplot(wolf.rda)
signif.full <- anova.cca(wolf.rda, parallel=getOption("mc.cores"))
signif.full
signif.axis <- anova.cca(wolf.rda, by="axis", parallel=getOption("mc.cores"))
signif.axis
vif.cca(wolf.rda)
plot(wolf.rda, scaling=3)
plot(wolf.rda, choices = c(1, 3), scaling=3)
levels(env$ecotype) <- c("Western Forest","Boreal Forest","Arctic","High Arctic","British Columbia","Atlantic Forest")
eco <- env$ecotype
bg <- c("#ff7f00","#1f78b4","#ffff33","#a6cee3","#33a02c","#e31a1c")
## PLOTTING ##
plot(wolf.rda, type="n", scaling=3)
abline(h = 0, v = 0, col = "white", lwd = 2)
box()
points(wolf.rda, display="species", pch=20, cex=0.7, col="gray32", scaling=3) # the SNPs
points(wolf.rda, display="sites", pch=21, cex=1.3, col="gray32", scaling=3, bg=bg[eco]) # the wolves
text(wolf.rda, scaling=3, display="bp", col="#0868ac", cex=1) # the predictors
legend("bottomright", legend=levels(eco), bty="n", col="gray32", pch=21, cex=1, pt.bg=bg)
plot(wolf.rda, type="n", scaling=3, choices=c(1,3))
abline(h = 0, v = 0, col = "white", lwd = 2)
box()
points(wolf.rda, display="species", pch=20, cex=0.7, col="gray32", scaling=3, choices=c(1,3))
points(wolf.rda, display="sites", pch=21, cex=1.3, col="gray32", scaling=3, bg=bg[eco], choices=c(1,3))
text(wolf.rda, scaling=3, display="bp", col="#0868ac", cex=1, choices=c(1,3))
legend("topleft", legend=levels(eco), bty="n", col="gray32", pch=21, cex=1, pt.bg=bg)
Also, in future, if you could please post the code required to obtain and load the data or a minimal, reproducible example, it would have made this question a lot easier to answer; see How to make a great R reproducible example
I have the following code to create a simple split y-axis plot.
I would like to loop through (as an example) the edhec data set so that each panel in a matrix of panels has two lines: the first vector of edhec on the left and one of subsequent vectors on the right:
library(zoo)
library(PerformanceAnalytics)
data(edhec)
edhec <- as.zoo(edhec)
plot(edhec[ ,1], ylab=colnames(edhec[ ,1]), lwd=2)
par(new=TRUE)
plot(edhec[ ,2], ann=FALSE, yaxt="n", col="darkgreen", lwd=1)
axis(side=4)
Thanks for your help!
I'm guessing this is roughly what you want?
library(zoo)
library(PerformanceAnalytics)
data(edhec)
edhec <- as.zoo(edhec)
par(mfrow=c(ceiling(ncol(edhec)/2), 2),
mar=c(0, 2, 0, 2), oma=c(2, 0, 1, 0), mgp=c(2, 0.7, 0))
invisible(lapply(1:ncol(edhec),
function(x) {
par(new=FALSE)
plot(edhec[, x],
xaxt=ifelse(x >= ncol(edhec) - 1, "s", "n"),
ylab="")
par(new=TRUE)
plot(edhec[, x + 1], col="darkgreen", ann=FALSE, xaxt="n", yaxt="n")
axis(side=4)
}
))
So i have this numeric variables which reflect percentages
data1.pct<-19
data2.pct<-5
data3.pct<-76
class1.pct<-35
class2.pct<-18
class3.pct<-47
Now i am using this code to generate barplot
CairoPDF(paste('data1/', data, '_plot1.pdf', sep=''), family='sans', pointsize=9, width=6, height=3.25)
par(mar=(c(4, 4, 1, 13) + 0.1), mgp=c(3, 2, 0), xpd=TRUE)
barplot(cbind(
c(data1.pct, data2.pct, data3.pct),
c(class1.pct, class2.pct, class3.pct)), col=c("firebrick3", "dodgerblue3", "mistyrose1"), ylim=c(0,100), space=c(0,1)
)
legend("topright", inset=c(-0.55, 0), legend=c("not attend", "refused", "attend"), col=c("mistyrose1", "dodgerblue3", "firebrick3"), lty=1, lwd=2, bty='n')
dev.off()
and the result is
I would like to add corresponding percentages inside barplot, that is numbers/percentages in my variables. So My output should be:
I would like to use barplot funcion to do this and NOT ggplot2
I have tried adding percentages with
text(mydata, 0, round(data1.pct), 1),cex=1,pos=3) but this is not right.
To get the y-values for the text, you can use cumsum along with tail and head to get the midpoints of each bar section.
par(mar=(c(4, 4, 1, 13) + 0.1), mgp=c(3, 2, 0), xpd=TRUE)
## Make the matrix for barplot
mat <- cbind(c(data1.pct, data2.pct, data3.pct), c(class1.pct, class2.pct, class3.pct))
## Get the y-values for text
ys <- apply(mat, 2, function(x) c(x[1]/2, head(cumsum(x),-1) + tail(x,-1)/2))
## Make barplot, store x data
xs <- barplot(mat, col=c("firebrick3", "dodgerblue3", "mistyrose1"), ylim=c(0,100), space=c(0,1))
## Add text
text(rep(xs, each=nrow(ys)), c(ys), labels=c(mat))
legend("topright", inset=c(-0.55, 0), legend=c("not attend", "refused", "attend"), col=c("mistyrose1", "dodgerblue3", "firebrick3"), lty=1, lwd=2, bty='n')
Hi everybody I have 3 plots with density bars on either axis which I have done this way (here is a simpler form presented with only 3 ordinary plots but the other parts are necessary as required for a more complicated function which I have left off here just for the ease of viewing)
scatterBar.Norm <- function(x,y) {
zones <- matrix(c(2,0,1,3), ncol=2, byrow=TRUE)
layout(zones, widths=c(5/7,2/7), heights=c(2/7,5/7))
title("My Title", outer=TRUE);
par(mar=c(3,3,1,1),mgp=c(2,1,0))
plot(1:10, xlab="Magnification", ylab="residue", col=2)
par(mar=c(0,3,1,1))
plot(1:10, xlab="Magnification", ylab="residue",col=3)
par(mar=c(3,0,1,1))
plot(1:10, xlab="Magnification", ylab="residue", col=4)}
scatterBar.Norm(2,3)
The problem :
Firstly the The plot title the "My Title" part is going out of the canvas , how to fix it ?
Thanks for the much needed help in advance.
You've instructed R to plot the title in the outer margin, but (at least in your example) you haven't set up that margin. The following should work:
scatterBar.Norm <- function(x, y) {
zones <- matrix(c(2, 0, 1, 3), ncol=2, byrow=TRUE)
layout(zones, widths=c(5, 2), heights=c(2, 5))
par(mar=c(3, 3, 1, 1), mgp=c(2, 1, 0), oma=c(0, 0, 3, 0))
plot(1:10, xlab="Magnification", ylab="residue", col=2)
par(mar=c(0, 3, 1, 1))
plot(1:10, xlab="Magnification", ylab="residue", col=3)
par(mar=c(3, 0, 1, 1))
plot(1:10, xlab="Magnification", ylab="residue", col=4)
title("My Title", outer=TRUE)
}
plot.new()
scatterBar.Norm(2, 3)