Related
df <-data.frame(y=c(69,61,61,78,69,66,68,59,59,75,67,67,69,61,63,77,67,67,68,61,61,76,66,64), x=gl(4,6))
bx.p <- boxplot(y~x, df,main="Accuracy",ylab="Accuracy(%)",xlab="Models",xlim=c(0.5,4.5),ylim=c(55,90),boxfill=0,medcol=2,boxwex=0.4,names=c("a","b","c","d") )
bx.p$stats[3, ] <- unclass(with(df, by(y, x, FUN = mean)))
bxp(bx.p, add=T, boxfill="transparent", medcol="blue", boxwex=0.4,axes=F, outpch = NA, outlty="blank", boxlty="blank", whisklty="blank", staplelty="blank")
legend(x=3.8,y=90.5, lty=c(1, 1), lwd=rep(3, 2), col=c("red", "blue"), box.lwd=0.2,legend = c("median", "mean"), cex=0.8,horiz = FALSE, bg="transparent")
grid(nx=13, ny=13)
add=TRUE is not applied
It doesn't change although i add (add=TRUE)
bx.p <- boxplot(y~x, df,main="Accuracy",ylab="Accuracy(%)",xlab="Models",xlim=c(0.5,4.5),ylim=c(55,90),boxfill=0,medcol=2,boxwex=0.4,names=c("a","b","c","d"),add=TRUE )
You can add them manually if you like by using the segments() function in base R plots:
df <-data.frame(y=c(69,61,61,78,69,66,68,59,59,75,67,67,69,61,63,77,67,67,68,61,61,76,66,64), x=gl(4,6))
plot(x = c(50,90), y = c(0,10), xlab = NA, ylab = NA, axes = FALSE, type = "n")
bx.p <- boxplot(y ~ x, df, main="Accuracy",
ylab = "Accuracy(%)", xlab = "Models",
xlim = c(0.5,4.5), ylim = c(55,90),
boxfill = "white", medcol = 2, boxwex = 0.4,
names = c("a","b","c","d") )
bx.p$stats[3, ] <- unclass(with(df, by(y, x, FUN = mean)))
bxp(bx.p, add=T, boxfill="transparent", medcol="blue", boxwex=0.4,
axes=F, outpch = NA, outlty="blank", boxlty="blank", whisklty="blank", staplelty="blank")
legend(x=3.8,y=90.5, lty=c(1, 1), lwd=rep(3, 2), col=c("red", "blue"), box.lwd=0.2,legend = c("median", "mean"), cex=0.8,horiz = FALSE, bg="transparent")
segments(x0 = seq(0.5, 10, 0.5), y0 = 50, y1 = 100, lty = 2, lwd = 0.75, col = "lightgrey")
segments(x0 = 0, x1 = 10, y0 = seq(50, 100, 5), lty = 2, lwd = 0.75, col = "lightgrey")
I need help in plotting gamma distribution PDFs in R or RStudio. I have four different gamma distributions listed below. I want to plot their PDFs on the same axis with different colours and also add a legend.
gamma(0.5,0.33)
gamma(2.0,0.88)
gamma(2.4,1.22)
gamma(1.8,1.10)
This should get you what you want, but be careful with the parametrization of rate and scale = 1/rate (use just one).
x <- (1:1000)/100
y1 <- dgamma(x = x, 0.5, 0.33)
y2 <- dgamma(x = x, 2.0, 0.88)
y3 <- dgamma(x = x, 2.4, 1.22)
y4 <- dgamma(x = x, 1.8, 1.10)
pdf(file = 'my-gamma-plot.pdf')
plot(x, y1, type = 'l')
lines(x, y2, type = 'l', col = 2)
lines(x, y3, type = 'l', col = 3)
lines(x, y4, type = 'l', col = 4)
legend("topright",
legend = c('gamma1', 'gamma2', 'gamma3', 'gamma4'),
col = c(1:4),
lty = 1, cex = 0.8)
dev.off()
A base R option with curve
f1 <- function(x) dgamma(x, 0.5, 0.33)
f2 <- function(x) dgamma(x, 2, 0.88)
f3 <- function(x) dgamma(x, 2.4, 1.22)
f4 <- function(x) dgamma(x, 1.8, 1.1)
curve(f1, 0, 10)
curve(f2, 0, 10, add = TRUE, lty = "dotdash")
curve(f3, 0, 10, add = TRUE, lty = "dashed")
curve(f4, 0, 10, add = TRUE, lty = "dotted")
legend(
"center",
legend = c("gamma(0.5,0.33)", "gamma(2,0.88)", "gamma(2.4,1.22)", "gamma(1.8.1.1)"),
box.lty = 0,
cex = 1.5,
lty = c("solid", "dotdash", "dashed", "dotted")
)
How could I create a simple plot of a coordinate system within two vectors in R? It should look like the following plot.
Thank you!
# Empty plot
plot(1, 1, type = "n", xlim = c(-3, 3), ylim = c(-3, 3), asp = 1,
ann = FALSE, axes = FALSE)
# Axes
arrows(x0 = -3, y0 = 0, x1 = 3, y1 = 0, length = 0.1, code = 3)
arrows(x0 = 0, y0 = -3, x1 = 0, y1 = 3, length = 0.1, code = 3)
# Vectors
# v1
arrows(0, 0, 2.5, 1, length = 0.1, col = "lightblue", lwd = 2)
# v2
arrows(0, 0, 1, 2, length = 0.1, col = "blue", lwd = 2)
# v3
arrows(1, 2, 2.5, 1, length = 0.1, col = "red", lwd = 2)
# Text
text(x = mean(c(0, 2.5)), y = mean(c(0, 1)), labels = "v1", pos = 1)
text(0.5, 1, "v2", pos = 3)
text(1.75, 1.5, "v3", pos = 4)
I am creating a plot where I plot the variable on the X-axis against that on the Y-axis, and I am adding histograms of the variables as well. I have added a trend-line to the plot using abline().
The problem is that it does not appear to respect the xlim = c(0, 20) in the plot region as it extends beyond the limits of the x-axis. I tried playing around with the xpd option, but to no avail. Next I tried fiddling with the different par()options, but found nothing that could help with this issue.
What I want is for the trend-line to be the exact length of the x-axis. Any help is much appreciated. In this particular case the trend-line is almost flat, but the slope will change when I do the same for other variables.
MWE -- NOTE: I am only providing 15 data points to illustrate the issue so the graph will differ from the image provided.
df.data <- data.frame(id = 1:15,
ll = c(-9.53026, -6.50640,-6.50640, -7.68535, -11.80899, -8.42790,
-6.50640, -6.50640, -7.92405, -6.50640, -8.95522, -9.99228,
-10.02286, -8.95969, -6.07313),
aspm = c(4.582104, 0.490244, 0.737765, 0.256699, 1.575931, 1.062693,
1.006984, 0.590355, 1.014370, 0.924855, 0.735989, 0.831025,
1.197886, 1.143220, 0.928068))
str.col.light.blue <- c(rgb(r = 110/255, g = 155/255, b = 225/255))
str.col.dark.blue <- c(rgb(r = 50/255, g = 100/255, b = 185/255))
layout(matrix(c(2, 4, 1, 3), 2, 2, byrow = TRUE), widths = c(5, 2), heights = c(2, 5))
layout.show(4)
par(omi = c(0.1, 0.1, 0.1, 0.1))
par(mar = c(2, 2, 0, 0))
par(mai = c(1, 1, 0, 0))
plot(df.data[, "ll"] ~ df.data[, "aspm"], col = str.col.light.blue,
xlim = c(0, 20), ylim = c(-15, -5), axes = FALSE,
xlab = "X1", ylab = "X2",
cex.lab = 1.25)
abline(a = -8.156670, b = -0.000879, lty = 5, col = "black", lwd = 2, xpd = FALSE)
axis(1, at = seq(0, 20, by = 5), labels = seq(0, 20, by = 5), cex.axis = 1)
axis(2, at = seq(-15, -5, by = 3), labels = seq(-15, -5, by = 3), cex.axis = 1, las = 1)
rect(0, -15, 20, log(1/3)*8, density = 10, angle = 45, lwd = 0.5, col = "gray")
par(mar = c(0, 2, 0, 0))
par(mai = c(0, 1, 0.25, 0))
x.hist <- hist(df.data[, "aspm"], plot = FALSE, breaks = 20)
barplot(x.hist$density, axes = FALSE, horiz = FALSE, space = 0, col = str.col.dark.blue)
par(mar = c(2, 0, 0, 0))
par(mai = c(1, 0, 0, 0.25))
y.hist <- hist(df.data[, "ll"], plot = FALSE, breaks = 20)
barplot(y.hist$density, axes = FALSE, horiz = TRUE, space = 0, col = str.col.dark.blue)
In order to avoid working out the start and end points of the segments, you can program a helper function to do it for you.
linear <- function(x, a, b) a + b*x
Then, I've used your code with the following changes. abline was replaced by segments, with all the graphics parameters you had used in your original call.
x0 <- 0
y0 <- linear(x0, a = -8.156670, b = -0.000879)
x1 <- 20
y1 <- linear(x1, a = -8.156670, b = -0.000879)
segments(x0, y0, x1, y1, lty = 5, col = "black", lwd = 2, xpd = FALSE)
This call to segment was placed where ablinewas.
In the final graph, I see a well behaved segment.
I want to be able to plot 2 axes on a graph so the they cross at 0. The question was asked about it here and solved for the crossing axes part. I can't find a way to make the two axes resize in an aspect ratio in RStudio. The graph made by biplot.prcomp is actually doing this, but I'm not able to find the code that enables the resize-axes-in-a-certain-ratio thing.
new_lim <- function(a, type = 1) {
newdata_ratio <- NULL
i <- type * 2 - 1
old_lim <- par("usr")[i:(i+1)] + c(diff(par("usr")[i:(i+1)]) * 0.04 / 1.08,
diff(par("usr")[i:(i+1)]) * -0.04 / 1.08)
old_ratio <- old_lim[1] / old_lim[2]
newdata_ratio <- if (max(a) <= 0) -1.0e+6 else min(a) / max(a)
if (old_ratio >= newdata_ratio ) {
new_min <- min(a)
new_max <- min(a) / old_ratio
} else {
new_min <- max(a) * old_ratio
new_max <- max(a)
}
c(new_min, new_max)
}
x2 <- -10:20
y2 <- seq(40, 10, length.out = length(x2))
library(vegan)
### Fixed elements are prepared.
par(mfrow=c(2,3))
for (i in 1:6) {
### pettern 1 / plot(pca); par(new=T); plot(~, new_lim())
s1= rnorm(50,mean = 12); s2= rnorm(50, mean = 17); s3= rnorm(50, mean = 20)
pca=rda(cbind(s1,s2,s3))
pca.scoop=scores(pca, scaling = 2)
plot(pca, xlab = "x1", ylab = "y1",
type = c("p"),
main= "main",
scaling = 2,
choices = c(1,2),
xlim =c(min(pca.scoop$sites[,1]),max(pca.scoop$sites[,1])),
ylim = c(min(pca.scoop$sites[,2]),max(pca.scoop$sites[,2])),
bty = "o",#"l"
pch=4)
abline(v = 0, lty = 2); abline(h = 0, lty = 2)
par(new =TRUE)
plot(x2, y2,
xlim = new_lim(x2),
ylim = new_lim(y2, 2), axes = F, ann = F)
axis(3, col = "red", col.axis = "red")
axis(4, col = "red", col.axis = "red")
mtext("x2", side = 3, line = 2.5, col = "red")
mtext("y2", side = 4, line = 2.5, col = "red")
## pattern 2 / biplot(pca); par(new=T); plot(~, new_lim())
s1= rnorm(50,mean = 12)
s2= rnorm(50, mean = 17)
s3= rnorm(50, mean = 20)
pca=rda(cbind(s1,s2,s3))
pca.scoop=scores(pca, scaling = 2)
par(new =TRUE)
plot(x2, y2,
xlim = new_lim(x2),
ylim = new_lim(y2, 2), axes = F, ann = F)
axis(3, col = "red", col.axis = "red")
axis(4, col = "red", col.axis = "red")
mtext("x2", side = 3, line = 2.5, col = "red")
mtext("y2", side = 4, line = 2.5, col = "red")
}
Here is the exact same graph, but when I resize the graph manually, the top red x axis is shifted.
Here is an example with prcomp:
for (i in 1:6) {
s1= rnorm(50,mean = 12); s2= rnorm(50, mean = 17); s3= rnorm(50, mean = 20)
pr=prcomp(cbind(s1,s2,s3))
biplot(pr)
abline(h=0,v=0, lty =3)
par(new =TRUE)
plot(x2, y2, axes = F, ann = F)
}
The rescaled image looks the same!:
Edit
This code, when I want to base the second graph on the PC vectors, it's not aligning. Is there a way to align everything and conserve asp = 1?
par(mfrow=c(2,3))
for (i in 1:6) {
### pettern 1 / plot(pca); par(new=T); plot(~, new_lim())
s1= rnorm(50,mean = 12); s2= rnorm(50, mean = 17); s3= rnorm(50, mean = 20)
pca=rda(cbind(s1,s2,s3))
pca.scoop=scores(pca, scaling = 2)
myccaplot( ### (4)
pca, xlab = "x1", ylab = "y1",
type = c("p"),
main= "main",
scaling = 2,
choices = c(1,2),
xlim =c(min(pca.scoop$sites[,1]),max(pca.scoop$sites[,1])),
ylim = c(min(pca.scoop$sites[,2]),max(pca.scoop$sites[,2])),
bty = "o",pch=4,
axes = F) ### (1)
axis(1) ### (2)
axis(2) ### (2)
box() ### (2)
x2 = c(min(pca.scoop$species[,1]),max(pca.scoop$species[,1]))
y2 = c(min(pca.scoop$species[,2]),max(pca.scoop$species[,2]))
par(new =TRUE)
plot(x2, y2,
xlim = new_lim(x2),
ylim = new_lim(y2, 2), axes = F, ann = F)
axis(3, col = "red", col.axis = "red")
axis(4, col = "red", col.axis = "red")
abline(v = 0, lty = 2) ### (3)
abline(h = 0, lty = 2) ### (3)
mtext("x2", side = 3, line = 2.5, col = "red")
mtext("y2", side = 4, line = 2.5, col = "red")
}
The solution is a little bit tricky:
First, don't draw the axis with plot.cca (the first call of plot of object pca).
You can plot the axes yourself afterwards like you do it in the second call of plot.
Draw the ablines after the second plot.
When testing you will see that there are two types of ablines now, one from plot.cca and one we plotted in 3. When looking into the function plot.cca (which is a S3 method for plot), e.g. with getAnywhere(plot.cca) we see that abline is called twice and there is no option to prevent that. So, a little bit tricky: we define our own plot function and remove the two lines with abline within plot.cca. We can call that function e.g. myccaplot. Now it should work like expected.
In code snippets:
for (i in 1:6) {
### pettern 1 / plot(pca); par(new=T); plot(~, new_lim())
s1= rnorm(50,mean = 12); s2= rnorm(50, mean = 17); s3= rnorm(50, mean = 20)
pca=rda(cbind(s1,s2,s3))
pca.scoop=scores(pca, scaling = 2)
myccaplot( ### (4)
pca, xlab = "x1", ylab = "y1",
type = c("p"),main= "main",scaling = 2,choices = c(1,2),
xlim =c(min(pca.scoop$sites[,1]),max(pca.scoop$sites[,1])),
ylim = c(min(pca.scoop$sites[,2]),max(pca.scoop$sites[,2])),
bty = "o",pch=4,
axes = F) ### (1)
axis(1) ### (2)
axis(2) ### (2)
box() ### (2)
par(new =TRUE)
plot(x2, y2,
xlim = new_lim(x2),
ylim = new_lim(y2, 2), axes = F, ann = F)
axis(3, col = "red", col.axis = "red")
axis(4, col = "red", col.axis = "red")
abline(v = 0, lty = 2) ### (3)
abline(h = 0, lty = 2) ### (3)
mtext("x2", side = 3, line = 2.5, col = "red")
mtext("y2", side = 4, line = 2.5, col = "red")
}
### (4) ## copy modified content of getAnywhere(plot.cca) here
myccaplot <- function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
scaling = "species", type, xlim, ylim, const, correlation = FALSE,
hill = FALSE, ...)
{
TYPES <- c("text", "points", "none")
g <- scores(x, choices, display, scaling, const, correlation = correlation,
hill = hill)
if (length(g) == 0 || all(is.na(g)))
stop("nothing to plot: requested scores do not exist")
if (!is.list(g))
g <- list(default = g)
for (i in seq_along(g)) {
if (length(dim(g[[i]])) > 1)
rownames(g[[i]]) <- rownames(g[[i]], do.NULL = FALSE,
prefix = substr(names(g)[i], 1, 3))
}
if (!is.null(g$centroids)) {
if (is.null(g$biplot))
g$biplot <- scores(x, choices, "bp", scaling)
if (!is.na(g$centroids)[1]) {
bipnam <- rownames(g$biplot)
cntnam <- rownames(g$centroids)
g$biplot <- g$biplot[!(bipnam %in% cntnam), , drop = FALSE]
if (nrow(g$biplot) == 0)
g$biplot <- NULL
}
}
if (missing(type)) {
nitlimit <- 80
nit <- max(nrow(g$spe), nrow(g$sit), nrow(g$con), nrow(g$def))
if (nit > nitlimit)
type <- "points"
else type <- "text"
}
else type <- match.arg(type, TYPES)
if (length(choices) == 1) {
if (length(g) == 1)
pl <- linestack(g[[1]], ...)
else {
hasSpec <- names(g)[1] == "species"
ylim <- range(c(g[[1]], g[[2]]), na.rm = TRUE)
pl <- linestack(g[[1]], ylim = ylim, side = ifelse(hasSpec,
"left", "right"), ...)
linestack(g[[2]], ylim = ylim, side = ifelse(hasSpec,
"right", "left"), add = TRUE, ...)
}
return(invisible(pl))
}
if (missing(xlim)) {
xlim <- range(g$species[, 1], g$sites[, 1], g$constraints[,
1], g$biplot[, 1], if (length(g$centroids) > 0 &&
is.na(g$centroids)) NA else g$centroids[, 1], g$default[,
1], na.rm = TRUE)
}
if (!any(is.finite(xlim)))
stop("no finite scores to plot")
if (missing(ylim)) {
ylim <- range(g$species[, 2], g$sites[, 2], g$constraints[,
2], g$biplot[, 2], if (length(g$centroids) > 0 &&
is.na(g$centroids)) NA else g$centroids[, 2], g$default[,
2], na.rm = TRUE)
}
plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1,
...)
# abline(h = 0, lty = 3) # removed
# abline(v = 0, lty = 3) # removed
if (!is.null(g$species)) {
if (type == "text")
text(g$species, rownames(g$species), col = "red",
cex = 0.7)
else if (type == "points")
points(g$species, pch = "+", col = "red", cex = 0.7)
}
if (!is.null(g$sites)) {
if (type == "text")
text(g$sites, rownames(g$sites), cex = 0.7)
else if (type == "points")
points(g$sites, pch = 1, cex = 0.7)
}
if (!is.null(g$constraints)) {
if (type == "text")
text(g$constraints, rownames(g$constraints), cex = 0.7,
col = "darkgreen")
else if (type == "points")
points(g$constraints, pch = 2, cex = 0.7, col = "darkgreen")
}
if (!is.null(g$biplot) && nrow(g$biplot) > 0 && type != "none") {
if (length(display) > 1) {
mul <- ordiArrowMul(g$biplot)
}
else mul <- 1
attr(g$biplot, "arrow.mul") <- mul
arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2],
length = 0.05, col = "blue")
biplabs <- ordiArrowTextXY(mul * g$biplot, rownames(g$biplot))
text(biplabs, rownames(g$biplot), col = "blue")
axis(3, at = c(-mul, 0, mul), labels = rep("", 3), col = "blue")
axis(4, at = c(-mul, 0, mul), labels = c(-1, 0, 1), col = "blue")
}
if (!is.null(g$centroids) && !is.na(g$centroids) && type !=
"none") {
if (type == "text")
text(g$centroids, rownames(g$centroids), col = "blue")
else if (type == "points")
points(g$centroids, pch = "x", col = "blue")
}
if (!is.null(g$default) && type != "none") {
if (type == "text")
text(g$default, rownames(g$default), cex = 0.7)
else if (type == "points")
points(g$default, pch = 1, cex = 0.7)
}
class(g) <- "ordiplot"
invisible(g)
}