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")
Related
I have a 2 x 2 figure where the columns represent two different variables and the rows represent two different locations. How can I add the names of the two locations to the two rows?
Example Data
library(biwavelet)
par(mfrow = c(2,2),
oma = c(3,3,0,0) + 0.1,
mar = c(1,1,1,1) + 0.1)
dat <- as.data.frame(matrix(nrow = 500, ncol = 2))
dat[1] <- seq(1,500)
dat[2] <- sin(dat[1])
# top-left figure
plot(wt(dat),
xaxt = 'n',
xlab = "",
cex.axis = 1.5,
cex.lab = 1.5)
axis(1, at = seq(0, 500, by = 100), cex.axis = 0.1, col.axis = 'NA')
title("Variable 1", line = 0.1, cex.main = 1.5)
# top-right figure
dat[2] <- sin(dat[1]*.5)
plot(wt(dat),
xaxt = 'n',
col.axis = 'NA',
xlab = "",
ylab = "")
axis(1, at = seq(0, 500, by = 100), cex.axis = 0.1, col.axis = 'NA')
title("Variable 2", line = 0.1, cex.main = 1.5)
# bottom-left figure
dat[2] <- sin(dat[1]*.25)
plot(wt(dat),
cex.axis = 1.5)
# bottom-right figure
dat[2] <- sin(dat[1]*.125)
plot(wt(dat),
col.axis = 'NA',
ylab = "",
xlab = "")
axis(1, at = seq(0, 500, by = 100), cex.axis = 1.5)
title(xlab = "Time (hours)",
ylab = "Period",
outer = TRUE,
line = 1.5,
cex.lab = 1.5)
The ideal figure would look like this
Neither of the suggested solutions so far have put the right-hand labels in the orientation requested. You cannot do so with mtext, but rather need to use text, first allowing text to display outside the plot region with par(xpd=NA). (See ?text and ?par, where one reads that the srt,rotation, parameter only applies to text):
par(mfrow=c(2,2), xpd=FALSE)
par(mar = c(1,1,1,1) + 2)
plot(disp ~ mpg, data = mtcars)
mtext("disp 1", side=3)
plot(I(2*disp) ~ mpg, data = mtcars)
mtext("disp 2", side=3); par(xpd=NA)
text("mpg 1", x=36, y=500, srt=270)
plot(disp ~ I(2*mpg), data = mtcars); par(xpd=NA)
plot(I(2*disp) ~ I(2*mpg), data = mtcars)
text("mpg 2", x=72, y=500, srt=270)
It is not as automatic as mtext in the sense that one needs to look at each plotting figure separately to derive a estimate for the x and y positions in the plotting coordinates.
Here's one method:
par(mfrow=c(2,2))
par(mar = c(1,1,1,1) + 0.1)
plot(disp ~ mpg, data = mtcars)
mtext("disp 1", side=3)
plot(I(2*disp) ~ mpg, data = mtcars)
mtext("disp 2", side=3)
mtext("mpg 1", side=4)
plot(disp ~ I(2*mpg), data = mtcars)
plot(I(2*disp) ~ I(2*mpg), data = mtcars)
mtext("mpg 2", side=4)
Unfortunately, mtext does not support rotating text, so you're stuck with the right labels being oriented as they are.
In case anyone stumbles across this page, the code I ended up using was based on #IRTFM answer, see below. It was challenging finding the appropriate y = in the text() function. I used an iterative approach and found the y = to be much lower than I anticipated.
library(biwavelet)
par(mfrow = c(2,2), xpd=F)
par(mar = c(1,1,1.1,1.1) + 0.1,
oma = c(3,3,0.5,0.5) + 0.1)
dat <- as.data.frame(matrix(nrow = 500, ncol = 2))
dat[1] <- seq(1,500)
dat[2] <- sin(dat[1])
# top-left figure
plot(wt(dat),
xaxt = 'n',
xlab = "",
cex.axis = 1.5,
cex.lab = 1.5)
axis(1, at = seq(0, 500, by = 100), cex.axis = 1.5, col.axis = 'NA')
mtext("Variable 1", side = 3, cex = 1.5, line = 0.1)
box(lty = "solid", col = 'black')
# top-right figure
dat[2] <- sin(dat[1]*.5)
plot(wt(dat),
xaxt = 'n',
col.axis = 'NA',
xlab = "",
ylab = "")
axis(1, at = seq(100, 500, by = 100), cex.axis = 0.1, col.axis = 'NA')
mtext("Variable 2", side = 3, cex = 1.5, line = 0.1)
text("Location 1", x = 520, y = 4.1, srt = 270, cex = 1.5, xpd=NA)
box(lty = "solid", col = 'black')
# bottom-left figure
dat[2] <- sin(dat[1]*.25)
plot(wt(dat),
cex.axis = 1.5,
xlab = "",
ylab = "")
axis(1, at = seq(100, 500, by = 100), cex.axis = 1.5)
box(lty = "solid", col = 'black')
# bottom-right figure
dat[2] <- sin(dat[1]*.125)
plot(wt(dat),
col.axis = 'NA',
ylab = "",
xlab = "")
axis(1, at = seq(100, 500, by = 100), cex.axis = 1.5)
text("Location 2", x = 520, y = 4.5, srt = 270, cex = 1.5, xpd=NA)
box(lty = "solid", col = 'black')
title(xlab = "Time (hours)",
ylab = "Period",
outer = TRUE,
line = 1.5,
cex.lab = 1.5)
I can plot the barplot in Excel with decimal points in y-axis limits as shown below.
But I would not be able to change the y-axis limits in R.
Here is my code in R.
par(mfrow=c(1, 1), mar=c(7, 4, 5, 6))
mydata <- data.frame(Algorithm1=c(95.85, 96.94), Algorithm2=c(96.04, 96.84), Algorithm3=c(95, 95.30))
barplot(as.matrix(mydata), main="Precision", ylim=range(0:100),
beside=T, col=c("red", "blue"), las=1, border = 0, cex.lab=1, cex.axis=1, font=1,col.axis="black", ylab = "Percentage",
legend.text = c("X1", "X2"),
args.legend = list(x ='topright', bty='n', inset=c(-0.20,0)))
Thanks in advance for your answer.
You can also use ggplot2 and scales.
library(dplyr)
library(ggplot2)
library(scales)
mydata <- data.frame(Algorithm = rep(c('Algorithm1','Algorithm2','Algorithm3'), each=2),
variable_x = rep(c('X1','X2'),3),
values=c(0.9585, 0.9694,0.9604, 0.9684, 0.95, 0.9530))
mydata %>%
ggplot(aes(x=Algorithm,y=values,fill=variable_x))+
geom_bar(stat='identity', position='dodge')+
scale_y_continuous(labels = scales::percent, limits = c(0.94,0.975), oob = rescale_none)+
scale_fill_manual(values= c(X1='red',X2='blue'))
Set the limit of y and xpd = FALSE.
FALSE : all plotting is clipped to the plot region
TRUE : all plotting is clipped to the figure region
NA : all plotting is clipped to the device region
library(RColorBrewer)
color <- brewer.pal(3, "Set1")[2:1]
plot.new()
plot.window(xlim = c(0, 10), ylim = c(94, 97.5), yaxs = "i")
abline(h = seq(94, 97.5, 0.5), col = 8)
barplot(as.matrix(mydata), beside = T, col = color,
border = NA, legend.text = c("X1", "X2"),
args.legend = list(x = 'topright', bty = "n"), xpd = F, add = T)
You could do:
tickPoints <- 20 * (0:5)
par(mfrow = c(1, 1), mar = c(7, 4, 5, 6))
mydata <- data.frame(
Algorithm1 = c(95.85, 96.94),
Algorithm2 = c(96.04, 96.84),
Algorithm3 = c(95, 95.30)
)
barplot(
as.matrix(mydata), main = "Precision", beside = T, col = c("red", "blue"),
las = 1, border = 0, cex.lab = 1, cex.axis = 1, font = 1, col.axis = "black",
ylab = "Percentage", legend.text = c("X1", "X2"),
args.legend = list(x = 'topright', bty = 'n',inset = c(-0.20, 0)),
axes = FALSE,
ylim = range(tickPoints)
)
axis(side = 2, at = tickPoints, labels = sprintf("%0.1f", tickPoints))
Note the axes = FALSE in the call to barplot
I have made some graphics using doubleYscale command from latticeExtra. I'd like to reduce or even completely remove the white space between the vertical axes and coloured area -I mean, I want data lines to start and end immediatly next to axes-.
My script is like this:
# -----------------------------------------------------------------------------#
library("xts") ## se usa para manipular y graficar series temporales
library("lubridate") ## se usa para manipular fechas
library("lattice") ## se usa para graficar las series
library("latticeExtra") ## se usa para pintar áreas en los gráficos
# -----------------------------------------------------------------------------#
fechas <- seq(as.Date('2017-05-22'), length.out = 365, by = 'days')
serie.0 <- xts::xts(x = runif(n = length(fechas)), order.by = fechas)
serie.5 <- xts::xts(x = runif(n = length(fechas)), order.by = fechas)
titulo <- list(label = 'Título', col = 'black', cex = 1.2)
umbrales.y <- c(0, 0.1, 0.3, 0.5, 0.7, 0.9, 1, 1.1)
etiq.der <- c("PMP", "10%AU", "30%AU", "50%AU", "70%AU", "90%AU", "CC", "")
marcas.x <- fechas[which(day(fechas) == 1)]
labels.x <- substr(as.character(month(marcas.x, label = T)), 1, 3)
scales.x <- list(at = marcas.x + 15, tck = 0, labels = labels.x, cex = 1.1, rot = 0, col = "black")
scales.y <- list(at = umbrales.y, col = "black", rot = 0, labels = c())
scales.y.der <- list(at = umbrales.y, rot = 0, col = "black", labels = etiq.der)
plot.0 <- lattice::xyplot(serie.0 ~ fechas, panel = function(x, y) {
panel.xyarea(x, y = umbrales.y[8], col = "cadetblue",
border = NULL)
panel.xyarea(x, y = umbrales.y[7], col = "darkgreen",
border = NULL)
panel.xyarea(x, y = umbrales.y[6], col = "green4",
border = NULL)
panel.xyarea(x, y = umbrales.y[5], col = "chartreuse3",
border = NULL)
panel.xyarea(x, y = umbrales.y[4], col = "darkolivegreen1",
border = NULL)
panel.xyarea(x, y = umbrales.y[3], col = "lightgoldenrod1",
border = NULL)
panel.xyarea(x, y = umbrales.y[2], col = "chocolate3",
border = NULL)
panel.xyarea(x, y = umbrales.y[1], col = "brown4",
border = NULL)
panel.abline(v = marcas.x, col = "darkgrey",
lwd = 0.05)
panel.abline(h = umbrales.y[4], col = "black",
lwd = 2)
panel.xyplot(x, y, type = "l", col = "darkblue",
lwd = 2)},
xlab = NULL,
ylab = list('Almacenaje', cex = 1, col = 'black'),
main = titulo,
ylim = c(- 0.1, 1),
xlim = range(fechas),
scales = list(relation = "free", col = "black", x = scales.x, y = scales.y),
key = list(text = list(c("Último año", "Decil 5")),
lines = list(col = c("darkblue", "black"),
lty = c(1,2), lwd = c(2,1.9))),
par.settings = list(simpleTheme(col = 1),
layout.widths = list(ylab.axis.padding = -3)))
plot.1 <- lattice::xyplot(serie.5 ~ fechas, type = "l",
col = "black", lwd = 1.9, lty = 2,
ylim = c(- 0.1, 1),
xlim = range(fechas),
scales = list(relation = "free", x = scales.x, y = scales.y.der))
#png(filename = 'C:/Eugenia/graf.png', width = 600, height = 480)
print(latticeExtra::doubleYScale(plot.0, plot.1, style1 = 0, style2 = 0))
#dev.off()
An the result:
I've tried changing the layout.widths parameters, but didn't find the way.
Thank you in advance for any help!
Any tips to remove the zero labels in between the histogram bars?
hist(links$Survey_Duration, breaks = seq(0,50,5), main = "Survey Duration",
labels = TRUE, border = "black",
xlab = "Survey", ylim = c(0, 15), col = "gray", las = 1, xaxt='n')
axis(side=1, at=seq(0,50,5), labels=seq(0,50,5))
abline(v = mean(links$Survey_Duration), col = "royalblue", lwd = 1.5)
abline(v = median(links$Survey_Duration), col = "red", lwd = 1.5)
legend(x = "topright", c("Mean", "Median"), col = c("royalblue","red"),
lwd = c(1.5,1.5))
How about this?
# modify data so there's zero in one of the bins
mtcars$mpg <- ifelse(mtcars$mpg >= 25 & mtcars$mpg <= 30, NA, mtcars$mpg)
# save plot parameters
h <- hist(mtcars$mpg, plot = FALSE)
# produce plot
plot(h, ylim = c(0, 14))
# add labels manually, recoding zeros to nothing
text(h$mids, h$counts + 1, ifelse(h$counts == 0, "", h$counts))
A slightly different answer using the labeling in hist instead of adding text afterwards.
You do not provide your data, so I will use some data that is handy to illustrate.
The labels argument can specify the individual labels
H1 = hist(iris$Sepal.Length, breaks = 3:8, plot=FALSE)
BarLabels = H1$counts
BarLabels[BarLabels == 0] = ""
hist(iris$Sepal.Length, breaks = 3:8, labels = BarLabels)
Thanks #Daniel Anderson, it Ok now (Thumbs Up)
links$Survey_Duration <- ifelse(links$Survey_Duration > 15 &
links$Survey_Duration <= 25,
NA,
links$Survey_Duration)
h <- hist(links$Survey_Duration, breaks = seq(0,50,5), plot = FALSE)
plot(h, ylim = c(0, 14), main = "Survey Duration", xlab = "Time", col = "gray", las = 1)
text(h$mids, h$counts + 1, ifelse(h$counts == 0, "", h$counts))
axis(side=1, at=seq(0,50,5), labels=seq(0,50,5))
abline(v = mean(links$Survey_Duration), col = "royalblue", lwd = 1.5)
abline(v = median(links$Survey_Duration), col = "red", lwd = 1.5)
legend(x = "topright",
c("Mean", "Median"),
col = c("royalblue","red"),
lwd = c(1.5,1.5))
Does anyone know how to extract the 'y' off the y-axis while preserving the variable names in the following plot:
par(mar = c(5,7,4,2) +.01)
matrix <- matrix(rnorm(100) ,ncol = 2, nrow =6)
y <- 1:6
par(mar = c(5,7,4,2) +.01)
plot(matrix[,1], y, cex = .8, pch = 20, xlab = "Standardized Mean Differences", col = "darkblue", main = "Balance Assessment", yaxt = "n")
points(matrix[,2], y, cex = .8, pch = 20, col ="cyan")
abline(v = 0, col = "gray50", lty =2)
text(y =1:6, par("usr")[1], labels = c("Var1", "Var2", "Var3", "Var4", "Var5", "Var6"), pos = 2, xpd = TRUE, srt = 0, cex = .8, font = 1, col = "blue")
It's minor, but it's driving me crazy. Thanks!
Just set ylab='' to remove it.