R/set_grid.R

In ipeglim: Imprecise Inferential Framework on Statistical Reasoning

#' @title Generates Grid-Points in X-Y Coordinate System
#' 
#' @description The function \code{set.grid} generates grid-points in the 
#' box-constrained region (in 2D) using maximum and minimum of \code{xtms}.
#' 
#' @param obj An object of class \code{imprecise}
#' @param len A scalar value that implies a length
#' @param ... other arguments to be passed to the function \code{set.grid}.
#'
#' @note
#' The function \code{set.grid} is recommended to use on the box-constrained
#' type in two dimensional problem rather than three or more. 
#' In general, it is used for a surface of the constrained convex polygon.
#'  
#' For the safe study, \code{set.grid} stops if \code{m0shape=sphere3d}.
#'
#' @author Chel Hee Lee <\email{gnustats@@gmail.com}>
#' 
#' @seealso \code{\link{expand.grid}}
#' @export
set.grid <- function(obj, ...) {
	UseMethod("set.grid", obj)
}
NULL

#' @rdname set.grid
#' @method set.grid default
#' @S3method set.grid default
set.grid.default <- function(obj, ...) {
	invisible(obj)
}
NULL

#' @rdname set.grid
#' @method set.grid imprecise
#' @S3method set.grid imprecise 
set.grid.imprecise <- function(obj, len=5, ...){
  
  # sanity check
  stopifnot(!missing(obj))
  m0shape <- obj$m0shape
  if(m0shape == "sphere3d") stop("Not supported yet; please contact the author.\n")
  
  fn.2d <- function(...){
    stopifnot(m0shape %in% c("eqns2d", "circle2d"))
    xtms <- do.call(rbind, obj$xtms)
    xtms <- xtms[chull(xtms),]
    xlim <- range(xtms[,1])
    ylim <- range(xtms[,2])
    gridxy <- as.matrix(expand.grid(seq(from=xlim[1], to=xlim[2], length.out=len), seq(from=ylim[1], to=ylim[2], length.out=len)))
    gridxy <- as.data.frame(t(gridxy)) # returning xtms as a list
    return(gridxy)
  }
  
  fn.eqns3d <- function(){
    stopifnot(m0shape %in% c("eqns3d"))
    xtms <- do.call(rbind, obj$xtms)
    xlim <- range(xtms[,1])
    ylim <- range(xtms[,2])
    zlim <- range(xtms[,3])
    gridxyz <- as.matrix(expand.grid(x=seq(from=xlim[1], to=xlim[2], length.out=len), y=seq(from=ylim[1], to=ylim[2], length.out=len), z=seq(from=zlim[1], to=zlim[2], length.out=len)))
    gridxyz <- as.data.frame(t(gridxyz))
    return(gridxyz)
  }
  
  ## we need more generalized form (with eqns rather than a circle)
  
  xtms <- switch(m0shape, 
    "eqns2d"=fn.2d(...),
    "circle2d"=fn.2d(...),
    "eqns3d"=fn.eqns3d(...))
  names(xtms) <- paste("x", seq_len(length(xtms)), sep="")
  obj$xtms <- xtms
  invisible(obj)
}
NULL
## set.bnds -- this must make the convex hull first