I'm making stacked boxplots and plots on top of one another using R's layout command in base graphics.
The graphs look great, except that y-axis labels from different plots overlap (highlighted in red circle):
Similar questions are here online, but none of them use layout.
I don't want to expand the space between the plots, I don't think this will look good.
How
I've tried reducing the font size, but the labels still go outside the plot area.
How can I set R's boxplot and plot so that the tick labels do not go above or below the red line, i.e. the max/min y-value, in the image above?
Some example code
legend_space <- -0.26
right <- 10.5
bottom <- 0
left <- 5
top <- 0
cex_main = 1
setEPS()
postscript('figure.eps')
g1 <- c()
g2 <- c()
p <- c()
percent <- c()
sum_p <- c()
sum_percent <- c()
g1_means <- c()
g2_means <- c()
xaxis <- c()
sum_p[1] <- 0.0430904
xaxis[1] <- 2984116
p[1] <- 0.0430904
percent[1] <- -65.1758
sum_percent[1] <- -65.1758
g1[1] <- list(c(47.058824,100.000000,100.000000))
g1_means[1] <- 84.482759
g2[1] <- list(c(13.750000,4.123711,96.000000))
g2_means[1] <- 19.306931
sum_p[2] <- 0.0443229
xaxis[2] <- 2984148
p[2] <- 0.0587825
percent[2] <- -73.8956
sum_percent[2] <- -69.332
g1[2] <- list(c(94.285714,94.736842,100.000000))
g1_means[2] <- 95.145631
g2[2] <- list(c(10.588235,0.000000,92.592593))
g2_means[2] <- 21.250000
sum_p[3] <- 0.0444647
xaxis[3] <- 2984157
p[3] <- 0.124606
percent[3] <- -40.2577
sum_percent[3] <- -60.3056
g1[3] <- list(c(76.315789,94.736842,64.705882))
g1_means[3] <- 83.928571
g2[3] <- list(c(63.529412,0.000000,60.000000))
g2_means[3] <- 43.670886
sum_p[4] <- 0.0393696
xaxis[4] <- 2984168
p[4] <- 0.0310268
percent[4] <- -38.4133
sum_percent[4] <- -54.7893
g1[4] <- list(c(59.459459,57.894737,100.000000))
g1_means[4] <- 64.864865
g2[4] <- list(c(35.294118,6.250000,36.363636))
g2_means[4] <- 26.451613
sum_p[5] <- 0.0304293
xaxis[5] <- 2984175
p[5] <- 0.0344261
percent[5] <- -50.5157
sum_percent[5] <- -54.0582
g1[5] <- list(c(62.500000,94.736842,100.000000))
g1_means[5] <- 85.849057
g2[5] <- list(c(52.873563,6.250000,26.666667))
g2_means[5] <- 35.333333
layout(matrix(c(0,0,1,1,2,2,3,3,4,4), nrow = 5, byrow = TRUE), heights = c(0.2,1,1,1,1.4))
par(mar = c(bottom, left, top, right))
boxplot(g1, xaxt = 'n', range = 0, ylab = '%', ylim = c(0,100), col = 'white', cex.lab=1.5, cex.axis=cex_main, cex.main=cex_main, cex.sub=1.5, xlim = c(0.5,length(g1)+0.5))
title('title', outer = TRUE, line = -1.5)
lines(g1_means, col='dark green', lwd = 3)
par(xpd=TRUE)
legend('topright',inset = c(legend_space,0), c('Control', 'Weighted Mean'), col = c('black','dark green'), lwd = c(1,3))
boxplot(g2, xaxt = 'n', range = 0, main = NULL, ylim = c(0,100), ylab = '%', col = 'gray', cex.lab=1.5, cex.axis=cex_main, cex.main=cex_main, cex.sub=1.5, xlim = c(0.5,length(g2)+0.5))
lines(g2_means, col='dark green', lwd = 3)
par(xpd=TRUE)
legend('topright',inset = c(legend_space,0),c('Case', 'Weighted Mean'), col = c('black','dark green'), lwd = c(1,3))
par(mar = c(bottom, left, top, right))#'mar’ A numerical vector of the form 'c(bottom, left, top, right)’
plot(p, xaxt='n', ylab = 'P', type = 'l', lty = 1, lwd = 3, cex.lab=1.5, cex.axis=1, cex.main=cex_main, cex.sub=1.5, , log = 'y', xlim = c(0.5,length(p)+0.5), ylim = c(min(p,sum_p), max(p, sum_p)))
points(sum_p, xaxt='n', ylab = 'P', type = 'l', col = 'blue', lty = 2, lwd = 3)
legend('topright', inset=c(legend_space,0), c('CpG P', 'Moving P Mean'), col = c('black','blue'), lwd=c(3,3), lty=c(1,2))
par(mar = c(bottom+5, left, top, right))#'mar’ A numerical vector of the form 'c(bottom, left, top, right)’
plot(percent, xaxt='n', ylab = '% Diff.', xlab = 'CpG', type = 'l', lty = 1, lwd = 3, cex.lab=1.5, cex.axis=1, cex.main=cex_main, cex.sub=1.5, xlim = c(0.5,length(percent)+0.5), ylim = c(min(percent, sum_percent), max(percent, sum_percent)))
points(sum_percent, xaxt='n', xlab = 'CpG', type = 'l', col = 'blue', lty = 2, lwd = 3)
par(xpd=TRUE)
legend('topright', inset=c(legend_space,0), c('Percent', 'Moving Mean %'), col = c('black','blue'), lwd=c(3,3), lty=c(1,2))
axis( 1, at=1:length(xaxis), xaxis)
dev.off()
thanks to #count, the solution is simply to use
las=2 in par settings. las=2 sets the labels to be read vertically.
Related
I have the following code (Thanks to an answer from #Rawr in this question):
labes1 <- c("P(LNG)","","Volume(LNG)","","P(oil)","","Can.GDP","","US GDP","")
titles <- c("Levels","","","","","Log Difference","","","","")
par(mfrow = c(5, 2), mar = c(0.3, 6, 0, 2), oma = c(5, 0, 3, 2))
lapply(1:10, function(ii) {
x <- plotdata1[, ii, drop = FALSE]
plot(x, xlab = "Quarter", ylab = labes1[ii], axes = FALSE)
axis(2, las = 1)
box()
if (ii %in% 9:10) {
axis(1)
title(xlab = 'Quarter', xpd = NA)
}
if (ii %in% 1:2)
title(main = c('Levels', 'Log Difference')[ii], xpd = NA, line = 1)
})
This produces the following plot:
The obvious issue is the overlaying of the y-axis labels with the y-axis values. I have tried playing around with the mar() and oma() but these just change the margins around, I was hoping this would move things out of the way. How can I move the y-axis labels as separate from the plot? I will also be moving the margins a bit so that the white space between the two columns of plots will be closer together.
You can define the ylab separately, like what you're doing for the xlab, and set the line parameter to define its distance from the plot (as stated in this post).
I got a running example from combining your code and #rawr's from your previous question.
set.seed(1)
z <- ts(matrix(rt(200 * 10, df = 3), 200, 10), start = c(1961, 1), frequency = 12)
z <- z * 1e5 # to make "wide" y-axis labels
## vectors of x, y, and main labels
xl <- sprintf('x label %s', 1:10)
yl <- sprintf('y label %s', 1:10)
ml <- sprintf('main label %s', 1:10)
labes1 <- c("P(LNG)","","Volume(LNG)","","P(oil)","","Can.GDP","","US GDP","")
titles <- c("Levels","","","","","Log Difference","","","","")
par(mfrow = c(5, 2), mar = c(0.3, 6, 0, 2), oma = c(5, 0, 3, 2))
lapply(1:10, function(ii) {
x <- z[, ii, drop = FALSE]
plot(x, xlab = "Quarter", ylab = "", axes = FALSE) # set ylab to ""
axis(2, las = 1)
title(ylab = labes1[ii], line = 4) # set the line at an appropriate distance
box()
if (ii %in% 9:10) {
axis(1)
title(xlab = 'Quarter', xpd = NA)
}
if (ii %in% 1:2)
title(main = c('Levels', 'Log Difference')[ii], xpd = NA, line = 1)
})
The code above outputs the following graph for line = 4 :
and this plot for line = 3 :
I'm a beginner in coding. I was trying to create an interaction plot. Here's my code:
data is clinicaltrials from the data of the book "Learning Statistics with R."
library(sciplot)
library(lsr)
library(gplots)
lineplot.CI(x.factor = clin.trial$drug,
response = clin.trial$mood.gain,
group = clin.trial$therapy,
ci.fun = ciMean,
xlab = "Drug",
ylab = "Mood Gain")
and it produces the graph like this:
As can be seen in the graph, the legend box is not within my screen.
Also I tried creating another plot using the following code:
interaction.plot(x.factor = clin.trial$drug,
trace.factor = clin.trial$therapy,
response = clin.trial$mood.gain,
fun = mean,
type = "l",
lty = 1, # line type
lwd = 2, # line width
legend = T,
xlab = "Drug", ylab = "Mood Gain",
col = c("#00AFBB", "#E7B800"),
xpd = F,
trace.label = "Therapy")
For this code, I got the graph like this:
In this graph, the legend does not have labels.
Could anyone help me with these problems regarding legend?
You probably plan to save the plot via RStudio GUI. When you resize the plot window with your mouse, you need to run the code again to refresh the legend dimensions.
However, it's advantageous to use a more sophisticated method, e.g. to save it as a png with fixed dimensions like so:
library("sciplot")
library("lsr")
library("gplots")
png("Plot_1.png", height=400, width=500)
lineplot.CI(x.factor=clin.trial$drug,
response=clin.trial$mood.gain,
group=clin.trial$therapy,
ci.fun=ciMean,
xlab="Drug",
ylab="Mood Gain"
)
dev.off()
png("Plot_2.png", height=400, width=500)
interaction.plot(x.factor=clin.trial$drug,
trace.factor=clin.trial$therapy,
response=clin.trial$mood.gain,
fun=mean,
type="l",
lty=1, # line type
lwd=2, # line width
legend=T,
xlab="Drug", ylab="Mood Gain",
col=c("#00AFBB", "#E7B800"),
xpd=F,
trace.label="Therapy")
dev.off()
The plots are saved into your working directory, check getwd() .
Edit
You could also adjust the legend position.
In lineplot.CI you may use arguments; either by using characters just for x, e.g. x.leg="topleft" or both coordinates as numeric x.leg=.8, y.leg=2.2.
interaction.plot does not provide yet this functionality. I provide a hacked version below. Arguments are called xleg and yleg, functionality as above.
See ?legend for further explanations.
interaction.plot <- function (x.factor, trace.factor, response, fun = mean,
type = c("l", "p", "b", "o", "c"), legend = TRUE,
trace.label = deparse(substitute(trace.factor)),
fixed = FALSE, xlab = deparse(substitute(x.factor)),
ylab = ylabel, ylim = range(cells, na.rm = TRUE),
lty = nc:1, col = 1, pch = c(1L:9, 0, letters),
xpd = NULL, leg.bg = par("bg"), leg.bty = "n",
xtick = FALSE, xaxt = par("xaxt"), axes = TRUE,
xleg=NULL, yleg=NULL, ...) {
ylabel <- paste(deparse(substitute(fun)), "of ", deparse(substitute(response)))
type <- match.arg(type)
cells <- tapply(response, list(x.factor, trace.factor), fun)
nr <- nrow(cells)
nc <- ncol(cells)
xvals <- 1L:nr
if (is.ordered(x.factor)) {
wn <- getOption("warn")
options(warn = -1)
xnm <- as.numeric(levels(x.factor))
options(warn = wn)
if (!anyNA(xnm))
xvals <- xnm
}
xlabs <- rownames(cells)
ylabs <- colnames(cells)
nch <- max(sapply(ylabs, nchar, type = "width"))
if (is.null(xlabs))
xlabs <- as.character(xvals)
if (is.null(ylabs))
ylabs <- as.character(1L:nc)
xlim <- range(xvals)
if (is.null(xleg)) {
xleg <- xlim[2L] + 0.05 * diff(xlim)
xlim <- xlim + c(-0.2/nr, if (legend) 0.2 + 0.02 * nch else 0.2/nr) *
diff(xlim)
}
dev.hold()
on.exit(dev.flush())
matplot(xvals, cells, ..., type = type, xlim = xlim, ylim = ylim,
xlab = xlab, ylab = ylab, axes = axes, xaxt = "n",
col = col, lty = lty, pch = pch)
if (axes && xaxt != "n") {
axisInt <- function(x, main, sub, lwd, bg, log, asp,
...) axis(1, x, ...)
mgp. <- par("mgp")
if (!xtick)
mgp.[2L] <- 0
axisInt(1, at = xvals, labels = xlabs, tick = xtick,
mgp = mgp., xaxt = xaxt, ...)
}
if (legend) {
yrng <- diff(ylim)
if (is.null(yleg))
yleg <- ylim[2L] - 0.1 * yrng
if (!is.null(xpd) || {
xpd. <- par("xpd")
!is.na(xpd.) && !xpd. && (xpd <- TRUE)
}) {
op <- par(xpd = xpd)
on.exit(par(op), add = TRUE)
}
# text(xleg, ylim[2L] - 0.05 * yrng, paste(" ",
# trace.label), adj = 0)
if (!fixed) {
ord <- sort.list(cells[nr, ], decreasing = TRUE)
ylabs <- ylabs[ord]
lty <- lty[1 + (ord - 1)%%length(lty)]
col <- col[1 + (ord - 1)%%length(col)]
pch <- pch[ord]
}
legend(xleg, yleg, legend = ylabs, col = col,
title = if (trace.label == "") NULL else trace.label,
pch = if (type %in% c("p", "b"))
pch, lty = if (type %in% c("l", "b"))
lty, bty = leg.bty, bg = leg.bg)
}
invisible()
}
Data:
lk <- "https://learningstatisticswithr.com/data.zip"
tmp <- tempfile()
tmp.dir <- tempdir()
download.file(lk, tmp)
unzip(tmp, exdir=tmp.dir)
load("data/clinicaltrial.Rdata")
I have a function that depends on distance and behaves different according to the direction (east or west) to where you evaluate it. Now I have two plots side by side, but I need to have them as one, where the labels of the axis are shared and the x axis label is centered. Here is an example of how the code looks right now:
x = (0:300)
par(mfrow=c(2,2))
Idriss70 = function(x){
exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(x+10)+0.00047*x+0.12)
}
plot(Idriss70(x), log = "x", type="l",xlim = c(300,1), xlab="Distancia [km]",ylab="PGA [g]", main="Aroma y Humayani extendida, Mw 7,0", col="green", panel.first = grid(equilogs = TRUE))
Idriss70 = function(x){
ifelse (x >= 0 & x<=3, exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(0+10)+0.00047*0+0.12),
exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(x+10)+0.00047*x+0.12))
}
plot(Idriss70(x), log = "x", type="l", xlab="Distancia [km]",ylab="PGA [g]", main="Aroma y Humayani extendida, Mw 7,0", col="green", panel.first = grid(equilogs = TRUE))
As you can see, the log scale of the plots don't allow "negative" values to be evaluated so I haven't been able to use only one plot.
How can I get this plot as one without using Illustrator or another graphics software, as I have to create lots of this ones for differente areas?
I haven't used ggplot in the past but I am willing to learn if necessary.
You can basically make one plot and mess around with fig so that you restrict the first plot to the left half of the device and the second to the right half
x <- 0:300
Idriss70 = function(x){
exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(x+10)+0.00047*x+0.12)
}
Idriss71 = function(x){
ifelse(x >= 0 & x<=3,
exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(0+10)+0.00047*0+0.12),
exp(5.6315-0.4104*7-(2.9832-0.2339*7)*log(x+10)+0.00047*x+0.12))
}
par(fig = c(0, .5, 0, 1), mar = c(5, 4, 4, 0), xaxs = 'i', ann = FALSE)
plot(Idriss70(x), log = "x", type="l", xlim = c(300,1),
col="green", axes = FALSE, panel.first = grid(equilogs = TRUE))
xx <- axis(1)
axis(2)
par(fig = c(.5, 1, 0, 1), new = TRUE, mar = c(5, 0, 4, 2))
plot(Idriss71(x), log = "x", type="l", col="green",
panel.first = grid(equilogs = TRUE), axes = FALSE)
axis(1, at = xx, labels = c('', xx[-1]))
title(xlab = "Distancia [km]", main = 'Aroma y Humayani extendida, Mw 7,0',
ylab = 'PGA [g]', outer = TRUE, line = -1.5)
good luck with ggplot. you'd probably have to summon #baptiste
well you could still use mfrow I suppose
graphics.off()
par(mfrow = c(1, 2), mar = c(5, 4, 4, 0), xaxs = 'i', ann = FALSE)
plot(Idriss70(x), log = "x", type="l", xlim = c(300,1),
col="green", axes = FALSE, panel.first = grid(equilogs = TRUE))
xx <- axis(1)
axis(2)
par(mar = c(5, 0, 4, 2))
plot(Idriss71(x), log = "x", type="l", col="green",
panel.first = grid(equilogs = TRUE), axes = FALSE)
axis(1, at = xx, labels = c('', xx[-1]))
title(xlab = "Distancia [km]", main = 'Aroma y Humayani extendida, Mw 7,0',
ylab = 'PGA [g]', outer = TRUE, line = -1.5)
I'm trying to achieve a similar plot to this one, using R's native plot command.
I was able to get something similar with the code below, however, I'd like the density polygons to overlap. Can anyone suggest a way to do this?
data = lapply(1:5, function(x) density(rnorm(100, mean = x)))
par(mfrow=c(5,1))
for(i in 1:length(data)){
plot(data[[i]], xaxt='n', yaxt='n', main='', xlim=c(-2, 8), xlab='', ylab='', bty='n', lwd=1)
polygon(data[[i]], col=rgb(0,0,0,.4), border=NA)
abline(h=0, lwd=0.5)
}
Outputs:
I would do it something like the following. I plot the densities in the same plot but add an integer to the y values. To make them overlapping i multiply by a constant factor fac.
# Create your toy data
data <- lapply(1:5, function(x) density(rnorm(100, mean = x)))
fac <- 5 # A factor to make the densities overlap
# We make a empty plot
plot(1, type = "n", xlim = c(-3, 10), ylim = c(1, length(data) + 2),
axes = FALSE, xlab = "", ylab = "")
# Add each density, shifted by i and scaled by fac
for(i in 1:length(data)){
lines( data[[i]]$x, fac*data[[i]]$y + i)
polygon(data[[i]]$x, fac*data[[i]]$y + i, col = rgb(0, 0, 0, 0.4), border = NA)
abline(h = i, lwd = 0.5)
}
(Note: This content was previously edited into the Question and was written by #by0.)
Thanks to #AEBilgrau, I quickly put together this function which works really nicely. Note: you need to play around with the factor fac depending on your data.
stacked.density <- function(data, fac = 3, xlim, col = 'black',
alpha = 0.4, show.xaxis = T,
xlab = '', ylab = ''){
xvals = unlist(lapply(data, function(d) d$x))
if(missing(xlim)) xlim=c(min(xvals), max(xvals))
col = sapply(col, col2alpha, alpha)
if(length(col) == 1) col = rep(col, length(data))
plot(1, type = "n", xlim = xlim, ylim = c(1,length(data) + 2),
yaxt='n', bty='n', xaxt=ifelse(show.xaxis, 'l', 'n'), xlab = xlab, ylab = ylab)
z = length(data):1
for(i in 1:length(data)){
d = data[[ z[i] ]]
lines(d$x, fac*d$y + i, lwd=1)
polygon(d$x, fac*d$y+ i, col=col[i], border=NA)
abline(h = i, lwd=0.5)
}
}
data <- lapply(1:5, function(x) density(rnorm(100, mean = x)))
stacked.density(data, col=c('red', 'purple', 'blue', 'green', 'yellow'), alpha=0.3, show.xaxis=T)
outputs:
I have a customized function for plotting filled contours which is heavily based on Carey McGilliard and Bridget Ferris work (http://wiki.cbr.washington.edu/qerm/sites/qerm/images/1/16/Filled.contour3.R) and http://wiki.cbr.washington.edu/qerm/index.php/R/Contour_Plots .
the filled.contour3 function runs perfectly in R 2.15.3 but throws an error in R 3.0.x
Error in .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), :
there is no .Internal function 'filledcontour'
Could you please help me with a solution or a workarround so that I can use the filled.contour3() function in R 3.0.x . *A great deal of my work depends on this function and I am on LInux so changing R versions is not that easy on production machines. Will be happy to offer bounty.*
To reproduce the error please source first the following
filled.contour3 <-
function (x = seq(0, 1, length.out = nrow(z)),
y = seq(0, 1, length.out = ncol(z)), z, xlim = range(x, finite = TRUE),
ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE),
levels = pretty(zlim, nlevels), nlevels = 20, color.palette = cm.colors,
col = color.palette(length(levels) - 1), plot.title, plot.axes,
key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1,
axes = TRUE, frame.plot = axes,mar, ...)
{
# modification by Ian Taylor of the filled.contour function
# to remove the key and facilitate overplotting with contour()
# further modified by Carey McGilliard and Bridget Ferris
# to allow multiple plots on one page
if (missing(z)) {
if (!missing(x)) {
if (is.list(x)) {
z <- x$z
y <- x$y
x <- x$x
}
else {
z <- x
x <- seq.int(0, 1, length.out = nrow(z))
}
}
else stop("no 'z' matrix specified")
}
else if (is.list(x)) {
y <- x$y
x <- x$x
}
if (any(diff(x) <= 0) || any(diff(y) <= 0))
stop("increasing 'x' and 'y' values expected")
# mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
# on.exit(par(par.orig))
# w <- (3 + mar.orig[2]) * par("csi") * 2.54
# par(las = las)
# mar <- mar.orig
plot.new()
# par(mar=mar)
plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1)
stop("no proper 'z' matrix specified")
if (!is.double(z))
storage.mode(z) <- "double"
.Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels),
col = col))
if (missing(plot.axes)) {
if (axes) {
title(main = "", xlab = "", ylab = "")
Axis(x, side = 1)
Axis(y, side = 2)
}
}
else plot.axes
if (frame.plot)
box()
if (missing(plot.title))
title(...)
else plot.title
invisible()
}
filled.legend <-
function (x = seq(0, 1, length.out = nrow(z)), y = seq(0, 1,
length.out = ncol(z)), z, xlim = range(x, finite = TRUE),
ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE),
levels = pretty(zlim, nlevels), nlevels = 20, color.palette = cm.colors,
col = color.palette(length(levels) - 1), plot.title, plot.axes,
key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1,
axes = TRUE, frame.plot = axes, ...)
{
# modification of filled.contour by Carey McGilliard and Bridget Ferris
# designed to just plot the legend
if (missing(z)) {
if (!missing(x)) {
if (is.list(x)) {
z <- x$z
y <- x$y
x <- x$x
}
else {
z <- x
x <- seq.int(0, 1, length.out = nrow(z))
}
}
else stop("no 'z' matrix specified")
}
else if (is.list(x)) {
y <- x$y
x <- x$x
}
if (any(diff(x) <= 0) || any(diff(y) <= 0))
stop("increasing 'x' and 'y' values expected")
# mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
# on.exit(par(par.orig))
# w <- (3 + mar.orig[2L]) * par("csi") * 2.54
#layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
# par(las = las)
# mar <- mar.orig
# mar[4L] <- mar[2L]
# mar[2L] <- 1
# par(mar = mar)
# plot.new()
plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i",
yaxs = "i")
rect(0, levels[-length(levels)], 1, levels[-1L], col = col)
if (missing(key.axes)) {
if (axes)
axis(4)
}
else key.axes
box()
}
#
# if (!missing(key.title))
# key.title
# mar <- mar.orig
# mar[4L] <- 1
# par(mar = mar)
# plot.new()
# plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
# if (!is.matrix(z) || nrow(z) <= 1L || ncol(z) <= 1L)
# stop("no proper 'z' matrix specified")
# if (!is.double(z))
# storage.mode(z) <- "double"
# .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels),
# col = col))
# if (missing(plot.axes)) {
# if (axes) {
# title(main = "", xlab = "", ylab = "")
# Axis(x, side = 1)
# Axis(y, side = 2)
# }
# }
# else plot.axes
# if (frame.plot)
# box()
# if (missing(plot.title))
# title(...)
# else plot.title
# invisible()
#}
and then run
#Example Four Panel Contour Plot with One Legend
#Author: Carey R McGilliard
#September 2010
#This code uses a modified version of filled.contour called filled.contour3 (created by Carey McGilliard, Ian Taylor, and Bridget Ferris)
#to make an example figure of four contour plots sharing a legend (to the right).
#The example demonstrates how to use various color schemes for the contour plots and legend, but the user will want to
#pick one color scheme for all four plots such that the legend matches the plots.
#Changing the x- and y-axis values will change the placement of text added to the figure using the text() function and adjustments will be necessary
#Source the following functions (change the paths as necessary)
#source("./print.letterTrevor.R")
#gplots has the function colorpanel, which is handy for making gray-scale contour plots
library(gplots)
#------------------------------------------------------
#Generate some fake data
x = rep(c(10,11,12),length = 9)
y = rep(c(1,2,3),each = 3)
z = rnorm(n=9,mean = 0,sd = 1)
xcoords = unique(x)
ycoords = unique(y)
surface.matrix = matrix(z,nrow=length(xcoords),ncol=length(ycoords),byrow=T)
#------------------------------------------------------
#plot.new() is necessary if using the modified versions of filled.contour
plot.new()
#I am organizing where the plots appear on the page using the "plt" argument in "par()"
par(new = "TRUE",
plt = c(0.1,0.4,0.60,0.95), # using plt instead of mfcol (compare
# coordinates in other plots)
las = 1, # orientation of axis labels
cex.axis = 1, # size of axis annotation
tck = -0.02 ) # major tick size and direction, < 0 means outside
#Top left plot:
#
# the filled contour - coloured areas
filled.contour3(xcoords,
ycoords,
surface.matrix,
color=terrain.colors,
xlab = "", # suppress x-axis annotation
ylab = "", # suppress y-axis annotation
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(min(surface.matrix),max(surface.matrix))
)
# the contour part - draw iso-lines
contour(xcoords,
ycoords,
surface.matrix,
color=terrain.colors,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(min(surface.matrix),max(surface.matrix)),
add=TRUE, # add the contour plot to filled-contour,
#thus making an overlay
col = grey(0.4) # color of overlay-lines
)
#
# An annotation inside first plot
#The xpd=NA allows for writing outside the plot limits, but still using the the x and y axes to place the text
par(xpd = NA)
text(x=11,y=1.5,"x",cex = 1.5,font = 2)
print.letter(text = "(a)")
######################################################################
#
#
#Top right plot:
par(new = "TRUE",
plt = c(0.5,0.8,0.60,0.95), # defining window for second plot
las = 1,
cex.axis = 1)
#
filled.contour3(
xcoords,
ycoords,
surface.matrix,
color=heat.colors,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1)
)
#
contour(
xcoords,
ycoords,
surface.matrix,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1),
add=TRUE
)
#
#Alternatively, you could set z axis limits to depend
#on the min and max values in surface.matrix.
#filled.contour3(xcoords,ycoords,surface.matrix,color=heat.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(min(surface.matrix),max(surface.matrix)))
#
# Add annotation
text(x=11,
y=1.5,
"x",
cex = 1.5,
font = 2)
######################################################################
#
#Bottom left plot:
par(new = "TRUE",
plt = c(0.1,0.4,0.15,0.5),
las = 1,
cex.axis = 1)
#
filled.contour3(xcoords,
ycoords,
surface.matrix,
col=colorpanel(11, "white", "grey10"),
nlevels=11,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1))
#
contour(xcoords,
ycoords,
surface.matrix,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1),
add = TRUE)
#
text(x=11,
y=1.5,
"x",
cex = 1.5,
font = 2,
col = "white")
######################################################################
#
#Bottom right plot:
par(new = "TRUE",
plt = c(0.5,0.8,0.15,0.5),
las = 1,
cex.axis = 1)
#
filled.contour3(
xcoords,
ycoords,
surface.matrix,
color = terrain.colors,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1)
)
#
contour(
xcoords,
ycoords,
surface.matrix,
xlab = "",
ylab = "",
xlim = c(min(xcoords),max(xcoords)),
ylim = c(min(ycoords),max(ycoords)),
zlim = c(-1,1),
add=TRUE
)
text(x=11,
y=1.5,
"hello",
cex = 1.5,
font = 2)
#
######################################################################
#Add a legend:
par(new = "TRUE",
plt = c(0.85,0.9,0.25,0.85), # define plot region for legend
las = 1,
cex.axis = 1)
#
filled.legend(
xcoords,
ycoords,
surface.matrix,
color = terrain.colors,
xlab = "",
ylab = "",
xlim = c(min(xintercepts),max(xintercepts)),
ylim = c(min(slopes),max(slopes)),
zlim = c(-1,1))
#Add some figure labels
par(xpd=NA,cex = 1.3)
text(x = -16.7,y = 0,"slope",srt = 90,cex = 1.3)
text(x = -8,y = -1.62,expression(paste(italic(x),"-intercept",sep = "")),cex = 1.3)
This happens if you use a non-standard API. You are allowed to do that, but cannot expect that it is maintained.
Change
.Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels),
col = col))
to
.filled.contour(as.double(x), as.double(y), z, as.double(levels),
col = col)
The change was announced with the release notes:
The C code underlying base graphics has been migrated to the graphics
package (and hence no longer uses .Internal() calls).
Have you ever heard of a "minimal reproducible example" (emphasis on "minimal")?