R/cwplot.R

Defines functions cwplot cwplot.default cwplot.summary.imprecise

Documented in cwplot cwplot.default cwplot.summary.imprecise

#' @title Marginal surface of contourplot and wireframe
#' 
#' @description contourplot and wireframe using the lattice
#' 
#' @param x the object with the class \code{summary.imprecise}
#' @param ... other argument
#' 
#' @return write a returning value
#'
#' @author Chel Hee Lee <\email{gnustats@@gmail.com}>
#' @export
cwplot <- function(x, ...) UseMethod("cwplot")
NULL

#' @rdname cwplot
#' @method cwplot default
#' @S3method cwplot default
cwplot.default <- function(x, ...) invisible(x)
NULL

#' @rdname cwplot
#' @method cwplot summary.imprecise
#' @S3method cwplot summary.imprecise
cwplot.summary.imprecise <- function(x, ...){

  stopifnot(x$m0shape != "sphere3d")
  
  X <- x$X
  xnames <- colnames(X)
#  xnames[which(xnames == "(Intercept)")] <- "x0"
  
  xtms <- do.call(rbind, x$xtms)
  colnames(xtms) <- xnames
  est <- x$est
  colnames(est) <- gsub("x", "b", xnames)
  dfm <- as.data.frame(cbind(xtms, est))
  
  m <- length(xnames)-1
  rhs <- t(combn(xnames,m))
  fn <- function(x, ...){
    x <- as.vector(x)
    x <- as.numeric(gsub("x", "", x))
    y <- seq_len(length(xnames))[!(seq_len(length(xnames)) %in% x)]
    return(y)
  }
  lhs <- paste("b", as.vector(apply(rhs,1,fn)), sep="")
  rhs1 <- apply(rhs,1,paste,collapse="*")
  fm <- paste(lhs, "~", rhs1, sep="")

  par(mar=rep(2,4))
  
  for(i in 1:3){
    tobj <- contourplot(as.formula(fm[i]), data=dfm, ...)
    print(tobj, split=c(i,1,3,2), more=TRUE)
  }
  for(i in 1:3){
    tobj <- wireframe(as.formula(fm[i]), data=dfm, scales=list(arrows=FALSE), par.settings = list(axis.line = list(col = "transparent"), ...))
    print(tobj, split=c(i,2,3,2), more=TRUE)
  }
  invisible(x)
}
NULL

Try the ipeglim package in your browser

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

ipeglim documentation built on May 2, 2019, 4:31 p.m.