I'm still having problems getting a package to define both S3 and S4 methods 
for the same new generic, on a current r-devel (version 48144).

Symptoms
example(bigglm)

bigglm> data(trees)

bigglm> ff<-log(Volume)~log(Girth)+log(Height)

bigglm> a <- bigglm(ff,data=trees, chunksize=10, sandwich=TRUE)
Error in UseMethod("bigglm", data) : no applicable method for "bigglm"

showMethods("bigglm")
Function: bigglm (package biglm)
formula="ANY", data="ANY"
formula="ANY", data="DBIConnection"
formula="formula", data="data.frame"
    (inherited from: formula="ANY", data="ANY")

bigglm
standardGeneric for "bigglm" defined from package "biglm"

function (formula, data, family = gaussian(), ...) standardGeneric("bigglm")
<environment: 0x8554240>
Methods may be defined for arguments: formula, data
Use  showMethods("bigglm")  for currently available ones.
getMethod("bigglm",c("ANY","ANY"))
Method Definition (Class "derivedDefaultMethod"):

function (formula, data, family = gaussian(), ...) UseMethod("bigglm", data)
<environment: namespace:biglm>

Signatures:
formula data target "ANY" "ANY"
defined "ANY"   "ANY"

 methods("bigglm")
[1] bigglm.data.frame* bigglm.function*   bigglm.RODBC*

   Non-visible functions are asterisked
Warning messages:
1: In findGeneric(generic.function, parent.frame()) :
  'bigglm' is a formal generic function; S3 methods will not likely be found
2: In methods("bigglm") : function 'bigglm' appears not to be generic

In the NAMESPACE file I have
import(stats)
useDynLib(biglm)
importClassesFrom(DBI)
exportMethods(bigglm)
export(biglm)
export(bigglm)
S3method(bigglm,data.frame)
S3method(bigglm,"function")
S3method(bigglm, RODBC)

and in the code
bigglm<-function(formula, data, family=gaussian(),...)
    UseMethod("bigglm", data)
setGeneric("bigglm", signature=c("formula","data"))


bigglm.data.frame<-function(formula, data, ..., chunksize=5000){ <snip>

setMethod("bigglm",
           c("ANY","DBIConnection"),
           function(formula, data, family = gaussian(),
                                   tablename, ..., chunksize=5000){
             terms<-terms(formula)
             modelvars<-all.vars(formula)
     <snip>


Any suggestions?

    -thomas

Thomas Lumley                   Assoc. Professor, Biostatistics
tlum...@u.washington.edu        University of Washington, Seattle

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to