The following plot is a first approximation to what I need:
***********************************
mu1 <- 0
mu2 <- 5
s <- 1
x <- seq(-2.5, 7.5, length = 41)
y <- seq(-2.5, 2.5, length = 41)
f <- function(x,y){
term1 <- 1/(2*pi*sqrt(s*s))
term2 <- -1/2
term3 <- (x - mu1)^2/s
term4 <- (y - mu1)^2/s
term5 <- (x - mu2)^2/s
term1*(.5 * exp(term2*(term3 + term4)) + .5 * exp(term2*(term5 +
term4)))
}
z <- outer(x, y, f)
persp(x, y, z)
require(grDevices)
filled.contour(x, y, z, axes = F, frame.plot = F, asp = 1,
col = palette(gray(seq(0, 0.9, len = 25))), nlevels = 25)
***********************************
It has four drawbacks. I would like:
(1) to remove the white grid;
(2) to remove the white contours;
(3) its appearance to be smooth;
(4) to remove the key.
_____________________________
Professor Michael Kubovy
University of Virginia
Department of Psychology
USPS: P.O.Box 400400 Charlottesville, VA 22904-4400
Parcels: Room 102 Gilmer Hall
McCormick Road Charlottesville, VA 22903
Office: B011 +1-434-982-4729
Lab: B019 +1-434-982-4751
Fax: +1-434-982-4766
WWW: http://www.people.virginia.edu/~mk9y/
Michael Kubovy <kubovy <at> virginia.edu> writes:> > The following plot is a first approximation to what I need:.. see below> *********************************** > It has four drawbacks. I would like: > (1) to remove the white grid; > (2) to remove the white contours; > (3) its appearance to be smooth; > (4) to remove the key.In partial fulfillment of your requirements, increasing the levels gives a nice smooth plot. mu1 <- 0 mu2 <- 5 s <- 1 x <- seq(-2.5, 7.5, length = 41) y <- seq(-2.5, 2.5, length = 41) f <- function(x,y){ term1 <- 1/(2*pi*sqrt(s*s)) term2 <- -1/2 term3 <- (x - mu1)^2/s term4 <- (y - mu1)^2/s term5 <- (x - mu2)^2/s term1*(.5 * exp(term2*(term3 + term4)) + .5 * exp(term2*(term5 + term4))) } z <- outer(x, y, f) persp(x, y, z) require(grDevices) filled.contour(x, y, z, axes = F, frame.plot = F, asp = 1, col = palette(gray(seq(0, 0.9, len = 500))), nlevels = 500) I thought that lattice would be more flexible, and getting rid of the keys was easy, only I could not get the smooth plot. Deepayan, are we missing something? library(lattice) dt <- expand.grid(x=x,y=y) dt$z <- apply(dt, 1,function(xy) f(xy[1],xy[2])) col.regions = palette(gray(seq(0, 0.9, len = 500))) contourplot(z~x*y,data=dt,cuts=20,col.regions=col.regions,colorkey=FALSE, contour=TRUE,region=TRUE) Dieter
On Jan 1, 2007, at 2:13 PM, Dieter Menne wrote:> Michael Kubovy <kubovy <at> virginia.edu> writes: > >> >> The following plot is a first approximation to what I need: > .. see below > >> *********************************** >> It has four drawbacks. I would like: >> (1) to remove the white grid; >> (2) to remove the white contours; >> (3) its appearance to be smooth; >> (4) to remove the key. > > > In partial fulfillment of your requirements, increasing the levels > gives a nice > smooth plot. > > mu1 <- 0 > mu2 <- 5 > s <- 1 > x <- seq(-2.5, 7.5, length = 41) > y <- seq(-2.5, 2.5, length = 41) > f <- function(x,y){ > term1 <- 1/(2*pi*sqrt(s*s)) > term2 <- -1/2 > term3 <- (x - mu1)^2/s > term4 <- (y - mu1)^2/s > term5 <- (x - mu2)^2/s > term1*(.5 * exp(term2*(term3 + term4)) + .5 * exp(term2*(term5 + > term4))) > } > > z <- outer(x, y, f) > persp(x, y, z) > require(grDevices) > filled.contour(x, y, z, axes = F, frame.plot = F, asp = 1, > col = palette(gray(seq(0, 0.9, len = 500))), nlevels = 500)Thanks, Dieter. I tried and it gave a strange result. See http://people.virginia.edu/~mk9y/mySite/twoGaussian.R and http://people.virginia.edu/~mk9y/mySite/twoGaussian.pdf ********************************* Session Info ********************************* > sessionInfo() R version 2.4.1 (2006-12-18) powerpc-apple-darwin8.8.0 locale: C attached base packages: [1] "datasets" "grid" "graphics" "grDevices" "stats" "utils" "methods" [8] "base" other attached packages: JGR iplots JavaGD MASS gridBase lattice "1.4-14" "1.0-5" "0.3-5" "7.2-30" "0.4-3" "0.14-16" latticeExtra rJava xtable "0.1-4" "0.4-12" "1.4-2" _____________________________ Professor Michael Kubovy University of Virginia Department of Psychology USPS: P.O.Box 400400 Charlottesville, VA 22904-4400 Parcels: Room 102 Gilmer Hall McCormick Road Charlottesville, VA 22903 Office: B011 +1-434-982-4729 Lab: B019 +1-434-982-4751 Fax: +1-434-982-4766 WWW: http://www.people.virginia.edu/~mk9y/
Michael Kubovy <kubovy <at> virginia.edu> writes:> > I tried and it gave a strange result. See > http://people.virginia.edu/~mk9y/mySite/twoGaussian.R > and > http://people.virginia.edu/~mk9y/mySite/twoGaussian.pdf > > ********************************* > Session Info > ********************************* > > sessionInfo() > R version 2.4.1 (2006-12-18) > powerpc-apple-darwin8.8.0Hmm, strange, I can reproduce your problem on Windows (otherwise same config) with pdf, but it looks beautifully on screen for me if I mentally remove the ugly legend. Dieter
Michael,
Although this is a rather old post I'm responding to, I recently came across
it and have a suggestions for getting rid of the legend. Simply modify the
code associated with the function and stuff it into a new function,
edm<-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, ...)
{
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()
}
Then call this new function,
edm(x, y, z, axes = F, frame.plot = F, asp = 1,
col = palette(gray(seq(0, 0.9, len = 25))), nlevels = 25)
Eric
--
View this message in context:
http://r.789695.n4.nabble.com/R-Help-with-filled-contour-tp815296p3422837.html
Sent from the R help mailing list archive at Nabble.com.