[Pomp-commits] r460 - pkg/R

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

Author: kingaa
Date: 2011-05-09 21:31:18 +0200 (Mon, 09 May 2011)
New Revision: 460

Modified:
   pkg/R/pomp-fun.R
Log:
- fix bug in error-checking
- allow pass-through of 'pomp.fun' objects


Modified: pkg/R/pomp-fun.R
===================================================================
--- pkg/R/pomp-fun.R	2011-05-09 17:34:56 UTC (rev 459)
+++ pkg/R/pomp-fun.R	2011-05-09 19:31:18 UTC (rev 460)
@@ -12,16 +12,18 @@
 ## constructor
 pomp.fun <- function (f = NULL, PACKAGE, proto = NULL) {
   if (missing(PACKAGE)) PACKAGE <- ""
-  if (is.function(f)) {
-    if (!is.null(proto)) {
-      if (!is.call(proto))
-        stop(sQuote("proto")," must be an unevaluated call")
-      prototype <- as.character(proto)
-      fname <- prototype[1]
-      args <- prototype[-1]
-      if (!all(args%in%names(formals(f))))
-        stop(sQuote(fname)," must be a function of prototype ",deparse(proto),call.=FALSE)
-    }
+  if (!is.null(proto)) {
+    if (!is.call(proto))
+      stop(sQuote("proto")," must be an unevaluated call")
+    prototype <- as.character(proto)
+    fname <- prototype[1]
+    args <- prototype[-1]
+    if (is.function(f)&&(!all(args%in%names(formals(f)))))
+      stop(sQuote(fname)," must be a function of prototype ",deparse(proto),call.=FALSE)
+  }
+  if (is(f,"pomp.fun")) {
+    retval <- f
+  } else if (is.function(f)) {
     retval <- new(
                   "pomp.fun",
                   R.fun=f,