Adding gg options, cf_grid contour options

Author: CollinErickson

R/cf.R

@@ -4,8 +4,10 @@
 #' @param ... Arguments to be passed to cf_func or cf_data based on 
 #' data type of first argument. If D is given as argument, then it
 #' is passed to cf_highdim.
+#' @param gg Should ggplot2 be used instead of base graphics?
 #'
-#' @return Whatever is returned from other function, probably nothing
+#' @return Whatever is returned from other function, probably nothing.
+#' Will be a ggplot2 object if using gg=TRUE.
 #' @export
 #'
 #' @examples
@@ -15,16 +17,16 @@
 #' z <- exp(-(x-.5)^2-5*(y-.5)^2)# + rnorm(20,0,.05)
 #' cf(x,y,z)
 #' cf(function(x){x[1]^2 - x[2]}, D=3)
-cf <- function(...) {
+cf <- function(..., gg=FALSE) {
   dots <- list(...)
   if (is.function(dots[[1]])) {
     if ("D" %in% names(dots)) {
       cf_highdim(...)
     } else {
-      cf_func(...)
+      cf_func(..., gg=gg)
     }
   } else if (is.numeric(dots[[1]])) {
-    cf_data(...)
+    cf_data(..., gg=gg)
   } else {
     stop("Data not recognized. Use cf_func for function or 
          cf_data for data or cf_grid for full grid of data.")

R/cf_func.R

@@ -17,15 +17,14 @@
 #' #@param title Title for the plot
 #' #@param mainminmax_minmax Whether [min,max]= should be shown in title or just the numbers
 #' @param pts Points to plot on top of contour
-#' @param use_lines If the contour should be made with lines. Otherwise is made
-#' using colors. Defaults to colors.
+#' @param gg Should ggplot2 be used? Will use gcf_grid() instead of cf_grid().
 #' @param ...  Passed to cf_grid
 #' @examples 
 #' cf_func(function(x){x[1]*x[2]})
 #' cf_func(function(x)(exp(-(x[1]-.5)^2-5*(x[2]-.5)^2)))
 #' cf_func(function(xx){exp(-sum((xx-.5)^2/.1))}, bar=TRUE)
 #' cf_func(function(xx){exp(-sum((xx-.5)^2/.1))}, bar=TRUE, mainminmax=TRUE)
-#' cf_func(function(x)(exp(-(x[1]-.5)^2-5*(x[2]-.5)^2)), use_lines=TRUE)
+#' cf_func(function(x)(exp(-(x[1]-.5)^2-5*(x[2]-.5)^2)), with_lines=TRUE)
 #' @references
 #' [1] filled.contour R function, copied function but removed part for sidebar
 #' @references
@@ -36,7 +35,7 @@ cf_func <- function(fn0, n=100,
                     batchmax=1, out.col.name=NULL,
                     out.name=NULL,
                     pts=NULL,
-                    use_lines=FALSE,
+                    gg=FALSE,
                     ...) {
   if(!is.null(out.col.name)) {
     fn <- function(xx){fn0(xx)[,out.col.name]}
@@ -49,32 +48,9 @@ cf_func <- function(fn0, n=100,
   x <- seq(xlim[1],xlim[2],length.out = n)
   y <- seq(ylim[1],ylim[2],length.out = n)
   z <- eval_over_grid_with_batch(x, y, fn, batchmax)
-  # z <- matrix(NA,n,n)
-  # if(batchmax<=1) { # calculate single Z value at a time
-  #   #for(xi in 1:n) for(yi in 1:n) {z[xi,yi] <- fn(c(x[xi],y[yi]))}
-  #   fn_outer <- Vectorize(function(xi, yi) {fn(c(x[xi], y[yi]))})
-  #   z <- outer(1:n, 1:n, fn_outer)
-  # } else {
-  #   inbatch <- 0
-  #   for(xi in 1:n) {
-  #     for(yi in 1:n) {
-  #       if(inbatch==0) XYi <- matrix(c(xi,yi),ncol=2)
-  #       else XYi <- rbind(XYi,matrix(c(xi,yi),ncol=2))
-  #       inbatch <- inbatch + 1
-  #       if(inbatch == batchmax | (xi==n & yi==n)) {
-  #         Zbatch <- fn(matrix(c(x[XYi[,1]],y[XYi[,2]]),ncol=2,byrow=F))
-  #         for(rowbatch in 1:length(Zbatch)) {
-  #           z[XYi[rowbatch,1],XYi[rowbatch,2]] <- Zbatch[rowbatch]
-  #         }
-  #         inbatch <- 0
-  #         rm(XYi)
-  #       }
-  #     }
-  #   }
-  # }
-  if (use_lines) {
-    contour(x, y, z, ...)
-    points(pts, pch=19)
+  
+  if (gg) {
+    gcf_grid(x,y,z, pts=pts, ...)
   } else {
     cf_grid(x,y,z, pts=pts, ...)
   }

R/cf_grid_screen.R

@@ -14,6 +14,9 @@
 #' @param xlim  x limits for the plot.
 #' @param ylim  y limits for the plot.
 #' @param zlim  z limits for the plot.
+#' @param with_lines Should lines be added on top of 
+#' contour to show contours?
+#' @param lines_only Should no fill be used, only contour lines?
 #' @param levels  a set of levels which are used to partition the range of z. Must be strictly increasing (and finite). Areas with z values between consecutive levels are painted with the same color.
 #' @param nlevels  if levels is not specified, the range of z, values is divided into approximately this many levels.
 #' @param color.palette  a color palette function to be used to assign colors
@@ -81,6 +84,7 @@ cf_grid <-
             cex.main=par()$cex.main,
             par.list=NULL,
             xaxis=TRUE, yaxis=TRUE,
+            with_lines=FALSE, lines_only=FALSE,
             ...)
   {#browser()
     # filled.contour gives unnecessary legend, this function removes it
@@ -201,8 +205,10 @@ cf_grid <-
       storage.mode(z) <- "double"
     #.Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels),
     #                        col = col))
-    .filled.contour(as.double(x), as.double(y), z, as.double(levels),
-                    col = col)
+    if (!lines_only) {
+      .filled.contour(as.double(x), as.double(y), z, as.double(levels),
+                      col = col)
+    }
     # Something like this will remove axis numbers and ticks
     # Axis(x, side=1, labels=F, tick=F)
     if (missing(plot.axes)) {
@@ -227,6 +233,12 @@ cf_grid <-
                             cex.main=cex.main)
     }
 
+    # Add contour lines if required
+    if (with_lines || lines_only) {
+      contour(x=x, y=y, z=z, add=T)
+    }
+    
+    # Add points (pts) if given
     if (!is.null(pts)) {
       if (!is.matrix(pts)) { # if not a matrix, make it a matrix by row
         if (is.numeric(pts) && (length(pts)%%2==0)) {

R/gcf_func.R

@@ -31,17 +31,25 @@ gcf_func <- function(fn0, n=100,
                     out.name=NULL,
                     pts=NULL,
                     ...) {
-  if(!is.null(out.col.name)) {
-    fn <- function(xx){fn0(xx)[,out.col.name]}
-  } else if (!is.null(out.name)) {
-    fn <- function(xx){fn0(xx)[[out.name]]}
-  } else {
-    fn <- fn0
-  }
-  if (!is.null(xylim)) {xlim <- ylim <- xylim}
-  x <- seq(xlim[1],xlim[2],length.out = n)
-  y <- seq(ylim[1],ylim[2],length.out = n)
-  z <- eval_over_grid_with_batch(x, y, fn, batchmax)
-  
-  gcf_grid(x,y,z, pts=pts, ...)
+  cf_func(fn0=fn0, n=n,
+          xlim=xlim, ylim=ylim, xylim=xylim,
+          batchmax=batchmax,
+          out.col.name=out.col.name,
+          out.name=out.name,
+          pts=pts,
+          gg=TRUE,
+          ...)
+  # if(!is.null(out.col.name)) {
+  #   fn <- function(xx){fn0(xx)[,out.col.name]}
+  # } else if (!is.null(out.name)) {
+  #   fn <- function(xx){fn0(xx)[[out.name]]}
+  # } else {
+  #   fn <- fn0
+  # }
+  # if (!is.null(xylim)) {xlim <- ylim <- xylim}
+  # x <- seq(xlim[1],xlim[2],length.out = n)
+  # y <- seq(ylim[1],ylim[2],length.out = n)
+  # z <- eval_over_grid_with_batch(x, y, fn, batchmax)
+  # 
+  # gcf_grid(x,y,z, pts=pts, ...)
 }