Revision 722dbd95a4352965cd1492a15c6e07ddbb073986 authored by Karline Soetaert on 13 November 2009, 00:00:00 UTC, committed by Gabor Csardi on 13 November 2009, 00:00:00 UTC
1 parent c455f23
setup.prop.2D.R
##==============================================================================
## Attaches a property to a 2D grid
##==============================================================================
setup.prop.2D <- function(func = NULL, y.func = func, value = NULL, y.value = value, grid, ...) {
## check input
gn <- names(grid)
if (! "x.mid" %in% gn)
stop("error in setup.2D.prop: grid should be a list that contains x.mid")
if (! "x.int" %in% gn)
stop("error in setup.2D.prop: grid should be a list that contains x.int")
if (! "y.mid" %in% gn)
stop("error in setup.2D.prop: grid should be a list that contains x.mid")
if (! "y.int" %in% gn)
stop("error in setup.2D.prop: grid should be a list that contains x.int")
if (is.null(func) && is.null(value))
stop("error in setup.prop: function and value should not be both NULL")
if (is.null(y.func) && is.null(y.value))
stop("error in setup.prop: y.function and y.value should not be both NULL")
if (!is.null(value)) { # profile specification via value
x.int <- matrix(nrow=length(grid$x.int),ncol=length(grid$y.mid),data=value)
y.int <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.int),data=y.value)
x.mid <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.mid),data=value)
y.mid <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.mid),data=y.value)
}
if (!is.null(func)) { # profile specification via function
x.int <- matrix(nrow=length(grid$x.int),ncol=length(grid$y.mid))
x.mid <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.mid))
for (i in 1:length(grid$x.int))
{
for (j in 1:length(grid$y.mid))
x.int[i,j] <- func(grid$x.int[i],grid$y.mid[j],...)
}
for (i in 1:length(grid$x.mid))
{
for (j in 1:length(grid$y.mid))
x.mid[i,j] <- func(grid$x.mid[i],grid$y.mid[j],...)
}
}
if (!is.null(y.func)) { # profile specification via function
y.int <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.int))
y.mid <- matrix(nrow=length(grid$x.mid),ncol=length(grid$y.mid))
for (i in 1:length(grid$x.mid))
{
for (j in 1:length(grid$y.int))
y.int[i,j] <- y.func(grid$x.mid[i],grid$y.int[j],...)
}
for (i in 1:length(grid$x.mid))
{
for (j in 1:length(grid$y.mid))
y.mid[i,j] <- y.func(grid$x.mid[i],grid$y.mid[j],...)
}
}
Res <- list(x.mid = x.mid,
y.mid = y.mid,
x.int = x.int,
y.int = y.int)
class(Res) <- "prop.2D"
return(Res)
}
##==============================================================================
## S3 method: Plotting of a two-dimensional grid property
##==============================================================================
contour.prop.2D <- function(x, grid, xyswap = FALSE, filled = FALSE, ...) {
if (! filled) {
if (xyswap)
contour(x=grid$y.mid,y=rev(-grid$x.mid),z=t(x$x.mid),...)
else
contour(x=grid$x.mid,y=grid$y.mid,z=x$x.mid,...)
} else {
if (xyswap)
filled.contour(x=grid$y.mid,y=rev(-grid$x.mid),z=t(x$x.mid),...)
else
filled.contour(x=grid$x.mid,y=grid$y.mid,z=x$x.mid,...)
}
}

Computing file changes ...