[R-gregmisc-commits] r2091 - pkg/gplots/R

[noreply at r-forge.r-project.org]

Author: warnes
Date: 2016-03-24 17:07:06 +0100 (Thu, 24 Mar 2016)
New Revision: 2091

Modified:
   pkg/gplots/R/lowess.R
   pkg/gplots/R/plot.lowess.R
Log:
Rename plot.lowess to plotLowess to avoid confusions with plot() method for class 'lowess', create a plot() method for class 'lowess' and modify the lowess.default() and lowess.formula() to add the 'lowess' class to the returned object, along with a 'call' list element.

Modified: pkg/gplots/R/lowess.R
===================================================================
--- pkg/gplots/R/lowess.R	2016-03-24 15:01:02 UTC (rev 2090)
+++ pkg/gplots/R/lowess.R	2016-03-24 16:07:06 UTC (rev 2091)
@@ -1,6 +1,19 @@
 # make stats::lowess into a generic base-function
-lowess.default <- stats::lowess
+lowess.default <- function (x, y = NULL,
+                            f = 2/3,
+                            iter = 3L,
+                            delta = 0.01 * diff(range(x)),
+                            ...)
+  {
+    m <- match.call()
+    m[[1L]] <- quote(stats::lowess)
+    retval <- eval(m, envir=parent.frame())
+    class(retval) <- "lowess"
+    retval$call <- match.call()
+    retval
+  }
 
+
 # add "..." to the argument list to match the generic
 formals(lowess.default) <- c(formals(lowess.default),alist(...= ))
 
@@ -9,12 +22,12 @@
 
 
 "lowess.formula" <-  function (formula,
-                               data = parent.frame(), 
+                               data = parent.frame(),
                                ...,
-                               subset, 
-                               f=2/3,  
+                               subset,
+                               f=2/3,
                                iter=3,
-                               delta=.01*diff(range(mf[-response])) 
+                               delta=.01*diff(range(mf[-response]))
                                )
 {
   if (missing(formula) || (length(formula) != 3))
@@ -23,7 +36,7 @@
   m <- match.call(expand.dots = FALSE)
   eframe <- parent.frame()
   md <- eval(m$data, eframe)
-  if (is.matrix(md)) 
+  if (is.matrix(md))
     m$data <- md <- as.data.frame(data)
   dots <- lapply(m$..., eval, md, eframe)
   nmdots <- names(dots)
@@ -37,15 +50,19 @@
   if (!missing(subset)) {
     s <- eval(subset.expr, data, eframe)
     l <- nrow(mf)
-    dosub <- function(x) if (length(x) == l) 
+    dosub <- function(x) if (length(x) == l)
       x[s]
     else x
     dots <- lapply(dots, dosub)
     mf <- mf[s, ]
   }
-  
+
   mf <- na.omit(mf)
-  
+
   response <- attr(attr(mf, "terms"), "response" )
-  lowess.default(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta)
+  retval <- stats::lowess(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta)
+  class(retval) <- "lowess"
+  retval$call <- match.call()
+
+  retval
 }

Modified: pkg/gplots/R/plot.lowess.R
===================================================================
--- pkg/gplots/R/plot.lowess.R	2016-03-24 15:01:02 UTC (rev 2090)
+++ pkg/gplots/R/plot.lowess.R	2016-03-24 16:07:06 UTC (rev 2091)
@@ -1,10 +1,22 @@
-plot.lowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(), col.lowess="red", lty.lowess=2  )
+plotLowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(),
+                        col.lowess="red",
+                        lty.lowess=2  )
 {
   m <- match.call(expand.dots=TRUE)
   m[[1]] <- as.name("plot")
   eval(m)
   m[[1]] <- as.name("lowess")
   lw <- eval(m)
-  lines(lw, col=col.lowess, lty=lty.lowess)  
+  lines(lw, col=col.lowess, lty=lty.lowess)
   grid()
 }
+
+plot.lowess <- function(x, y, ..., col.lowess="red", lty.lowess=2)
+{
+  m <- x$call
+  m[[1]] <- quote(plot)
+  eval(m,  envir = parent.frame())
+
+  lines(x$x, x$y, col=col.lowess, lty=lty.lowess)
+  grid()
+}