R/setup.prop.2D.R

Defines functions contour.prop.2D setup.prop.2D

Documented in contour.prop.2D setup.prop.2D

##==============================================================================
## Attaches a property to a 2D grid
##==============================================================================

setup.prop.2D <- function(func = NULL, value = NULL,  grid, 
                          y.func = func, y.value = value,...) {

  ## 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.2D: 'func' and 'value' should not both be NULL")

  if (is.null(y.func) && is.null(y.value))
    stop("error in setup.prop.2D: 'y.func' and 'y.value' should not both be NULL")

  if (!is.null(func) && !is.null(value))
    stop("error in setup.prop.2D: either 'func' or 'value' should be specified, not both")

  if (!is.null(y.func) && !is.null(y.value))
    stop("error in setup.prop.2D: either 'y.func' or 'y.value' should be specified, not both")

  Nx <- length(grid$x.mid)
  Ny <- length(grid$y.mid)  

  if (!is.null(value)) { # profile specification via constant value
    x.int <- matrix(nrow=Nx+1,ncol=Ny  ,data=value)
    y.int <- matrix(nrow=Nx  ,ncol=Ny+1,data=y.value)
    x.mid <- matrix(nrow=Nx  ,ncol=Ny  ,data=value)
    y.mid <- matrix(nrow=Nx  ,ncol=Ny  ,data=y.value)
  }

  if (!is.null(func)) { # profile specification via function
    if (is.vector(grid$x.mid)) {
    x.int <- outer(X=grid$x.int,Y=grid$y.mid, FUN=func, ...)
    y.int <- outer(X=grid$x.mid,Y=grid$y.int, FUN=y.func, ...)
    x.mid   <- outer(X=grid$x.mid,Y=grid$y.mid, FUN=func, ...)
    y.mid   <- outer(X=grid$x.mid,Y=grid$y.mid, FUN=y.func, ...)
    } else 
      stop("not yet implemented for matrix grid$x.mid")
   }
  
  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,...)
  }
}

Try the ReacTran package in your browser

Any scripts or data that you put into this service are public.

ReacTran documentation built on Aug. 15, 2017, 3:01 p.m.