Writing 'as.data.frame' method for custom

2019-09-20 19:01发布

问题:

In many variants, similar questions have been asked many times ... but i do not find a clear advice about:

"exporting S3 methods as functions"

I wrote a custom S3 class with roxygen2, call it 'my_item'. This is the constructor function:

my_item <- function(n) structure(list(n=n),class='my_item')

What I need is a way to define a "list of my_items => data.frame" cast function:

 #' @method as.data.frame my_item
 #' @export

 as.data.frame.my_item <- function(x) ...

As soon as I call it with a my_item in this way, it is fine:

as.data.frame(my_item('a'))

But applying the same call to a list of objects cannot work, because class(list) is empty:

as.data.frame(list(my_item('a'),my_item('b')))

This cannot work also because the function/method is not exported

as.data.frame.my_item(list(my_item('a'),my_item('b')))

This does not work with explicit namespace qualification:

my_pkg::as.data.frame.my_item(...)

Error: 'as.data.frame.my_item' is not an exported object from 'namespace:my_pkg'

In the package zoo, this is possible for plot generic function.

See plot.zoo, an S3 method, exported as a function:

In zoo::NAMESPACE

export(
   ...
   "plot.zoo"
   ...
)
S3method("plot", "zoo")
S3method("as.data.frame", "zoo")

The resulting package scoping is:

library(zoo)

methods('as.data.frame')

[1] as.data.frame.aovproj*        as.data.frame.array           as.data.frame.AsIs           
[4] as.data.frame.character       as.data.frame.chron*          as.data.frame.complex        
[7] as.data.frame.data.frame      as.data.frame.data.table*     as.data.frame.Date           
[10] as.data.frame.dates*          as.data.frame.default         as.data.frame.difftime       
[13] as.data.frame.factor          as.data.frame.ftable*         as.data.frame.integer        
[16] as.data.frame.ITime*          as.data.frame.list            as.data.frame.logical        
[19] as.data.frame.logLik*         as.data.frame.matrix          as.data.frame.model.matrix   
[22] as.data.frame.noquote         as.data.frame.numeric         as.data.frame.numeric_version
[25] as.data.frame.ordered         as.data.frame.POSIXct         as.data.frame.POSIXlt        
[28] as.data.frame.raw             as.data.frame.shingle*        as.data.frame.table          
[31] as.data.frame.times*          as.data.frame.ts              as.data.frame.vector         
[34] as.data.frame.yearmon*        as.data.frame.yearqtr*        as.data.frame.zoo*           
see '?methods' for accessing help and source code

methods('plot')

[1] plot.acf*           plot.data.frame*    plot.decomposed.ts* plot.default        plot.dendrogram*   
[6] plot.density*       plot.ecdf           plot.factor*        plot.formula*       plot.function      
[11] plot.hclust*        plot.histogram*     plot.HoltWinters*   plot.isoreg*        plot.lm*           
[16] plot.medpolish*     plot.mlm*           plot.ppr*           plot.prcomp*        plot.princomp*     
[21] plot.profile.nls*   plot.raster*        plot.shingle*       plot.spec*          plot.stepfun       
[26] plot.stl*           plot.table*         plot.times*         plot.trellis*       plot.ts            
[31] plot.tskernel*      plot.TukeyHSD*      plot.zoo           
see '?methods' for accessing help and source code

This shows that plot.zoo is exported, as.data.frame.zoo* is not exported


So probably the question is wrong.

A better one would be:

"How implement cast-protocol ('as-...') when using 'lists-of-list-based-S3-objects'?

回答1:

I've taken a different approach:

  • adding 'my_item'+'_list' class to a generic list via an as.my_item_list() function
  • defining an as.data.frame.my_item_list method working on my "custom" lists
  • invoke DF conversion with generics: as.data.frame(as.my_item_list(some_list))

In the following example, I substituted my_item class name with a shorter ob


DEFINITION

# ---( the 'ob' S3 constructor )---------------------------------------------

ob <- function(a,b) structure(list(a=a,b=b), class='ob')
is.ob <- function(x) inherits(x,'ob')

#---( the 'ob_list' cast for lists )-----------------------------------------

as.ob_list <- function(x, ...) UseMethod('as.ob_list')
as.ob_list.list <- function(x, ...) {
    stopifnot(all(sapply(x,is.ob)))
    class(x) <- append(class(x),'ob_list',after=0)
    x
}

#---( as.data.frame.* methods )----------------------------------------------

as.data.frame.ob <- function(x, ...) data.frame(t(as.matrix(unlist(x))))
as.data.frame.ob_list <- function(x, ...) do.call('rbind', lapply(x,as.data.frame))

TEST

o1 <- ob(1,10)
o2 <- ob(2,20)
o3 <- ob(3,30)

ol <- list(o1,o2,o3)

df <- as.data.frame(as.ob_list(ol))

print(df)

  a  b
1 1 10
2 2 20
3 3 30

It looks good!