R/filled.contour2.R

In peterkuriyama/hlsimulator: Simulate Hook and Line Survey

#' Filled Contour 2
#' Modification of filled.contour function

#' @param there are paremeters
#' @export


filled.contour2 <-
  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,mar, ...) 
{
  # modification by Ian Taylor of the filled.contour function
  # to remove the key and facilitate overplotting with contour()
  # further modified by Carey McGilliard and Bridget Ferris
  # to allow multiple plots on one page

  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[2]) * par("csi") * 2.54
 # par(las = las)
 # mar <- mar.orig
 plot.new()
 # par(mar=mar)
  plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
  if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1) 
    stop("no proper 'z' matrix specified")
  if (!is.double(z)) 
    storage.mode(z) <- "double"
  .filled.contour(x, y , z, levels, col)
  #22222222
  # .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()
}


# filled.contour2 <-
#   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,mar, ...) 
# {
#   # modification by Ian Taylor of the filled.contour function
#   # to remove the key and facilitate overplotting with contour()
#   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[2]) * par("csi") * 2.54
#   par(las = las)
#   mar <- mar.orig
#   plot.new()
#   par(mar=mar)
#   plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp)
#   if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1) 
#     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))
#   .filled.contour(x, y , z, levels, 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()
# }