[R] Cacheing computationally expensive getter methods for S4 objects

Benilton Carvalho bcarvalh at jhsph.edu
Wed Oct 14 22:42:59 CEST 2009


Thank you very much, Martin. :)

b

On Oct 14, 2009, at 5:23 PM, Martin Morgan wrote:

> Steve Lianoglou wrote:
>> Very clever, that looks to do the trick!
>
> I think though that all Square's then share the same environment
> (created in the prototype) and hence area.
>
>> area(new("Square", length=50, width=100))
> Accessing
> [1] 50
>
>
> Which is quite efficient at doing the calculation, but maybe not  
> what is
> expected...
>
> The solution is to create the area environment in an 'initialize'  
> method.
>
> A different approach, but along similar lines, might make 'area' a
> function that exploits lexical scope. Here's an area 'factory'
>
> areaf <- function() {
>    area <- NULL
>    function(x) {
>        if (is.null(area)) {
>            message("expensive")
>            area <<- x at length * x at width
>        }
>        area
>    }
> }
>
> that we use in the initialize method
>
> setMethod(initialize, "Rect",
>          function(.Object, ..., length=.Object at length,
>                   width=.Object at width)
> {
>    callNextMethod(.Object, area=areaf(), length=length,
>                   width=width, ...)
> })
>
> setMethod(area, "Rect", function(x) x at area(x))
>
> The signature of initialize is such that one could
>
> setReplaceMethod("length", c("Rect", "numeric"), function(x, value) {
>    initialize(x, length=value)
> })
>
>
> so
>
>> a <- new("Rect", length=10, width=5)
>> area(a)
> expensive
> [1] 50
>> area(a) # cheap
> [1] 50
>> b <- a
>> area(b)
> [1] 50
>> length(b) <- 20
>> area(a)
> [1] 50
>> area(b)
> expensive
> [1] 100
>
> Martin
>
>>
>> Thanks,
>>
>> -steve
>>
>> On Oct 14, 2009, at 2:57 PM, Benilton Carvalho wrote:
>>
>>> If you change 'area' to an environment, you may be able to get
>>> something close to what you want.
>>>
>>> For example:
>>>
>>> setClass("Square",
>>>        representation(
>>>                       length='numeric',
>>>                       width='numeric',
>>>                       area='environment'
>>>                       ),
>>>        prototype(
>>>                  length=0,
>>>                  width=0,
>>>                  area=new.env()
>>>                  )
>>>        )
>>>
>>> setGeneric("area", function(x) standardGeneric("area"))
>>> setMethod("area", "Square",
>>>         function(x){
>>>           if (length(ls(x at area)) == 0){
>>>             message("Computing")
>>>             assign("area", x at width * x at length, envir=x at area)
>>>           }
>>>           message("Accessing")
>>>           get("area", envir=x at area)
>>>         })
>>>
>>> tmp <- new("Square", length=5, width=10)
>>> area(tmp) ## This should show "computing" and "accessing"
>>> area(tmp) ## the 2nd call should show 'accessing' only
>>>
>>>
>>> b
>>>
>>>
>>>
>>> On Oct 14, 2009, at 3:31 PM, Steve Lianoglou wrote:
>>>
>>>> Hi,
>>>>
>>>> I was wondering if there was a way to store the results of a
>>>> computationally expensive "getter" call on an S4 object, so that  
>>>> it is
>>>> only calculated once for each object.
>>>>
>>>> Trivial example: let's say I want to cache the "expensive" area
>>>> calculation of a square object.
>>>>
>>>> setClass("Square",
>>>> representation(
>>>>   length='numeric',
>>>>   width='numeric',
>>>>   area='numeric'
>>>> ),
>>>> prototype(
>>>>   length=0,
>>>>   width=0,
>>>>   area=-1
>>>> )
>>>> )
>>>>
>>>> setGeneric("area", function(x) standardGeneric("area"))
>>>> setMethod("area", "Square",
>>>> function(x) {
>>>> if (x at area == -1) {
>>>>   x at area <- x at width * x at height
>>>> }
>>>> x at area
>>>> })
>>>>
>>>> Now the first time I call ``area(my.square)`` it computes
>>>> ``my.square at width * my.square at height``, but each subsequent call
>>>> returns ``x at area`` since the area computation has already been  
>>>> calc'd
>>>> and set for this object.
>>>>
>>>> Is this possible? I'm guessing the R pass by value semantics is  
>>>> going
>>>> to make this one difficult ... is there some S4 reference I missed
>>>> that has this type of info from?
>>>>
>>>> Thanks,
>>>> -steve
>>>>
>>>> --
>>>> Steve Lianoglou
>>>> Graduate Student: Computational Systems Biology
>>>> |  Memorial Sloan-Kettering Cancer Center
>>>> |  Weill Medical College of Cornell University
>>>> Contact Info: http://cbio.mskcc.org/~lianos/contact
>>>>
>>>> ______________________________________________
>>>> R-help at r-project.org mailing list
>>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>>> PLEASE do read the posting guide
>>>> http://www.R-project.org/posting-guide.html
>>>> and provide commented, minimal, self-contained, reproducible code.
>>>
>>
>> --
>> Steve Lianoglou
>> Graduate Student: Computational Systems Biology
>>  |  Memorial Sloan-Kettering Cancer Center
>>  |  Weill Medical College of Cornell University
>> Contact Info: http://cbio.mskcc.org/~lianos/contact
>>
>> ______________________________________________
>> R-help at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help
>> PLEASE do read the posting guide
>> http://www.R-project.org/posting-guide.html
>> and provide commented, minimal, self-contained, reproducible code.
>
>
> --
> Martin Morgan
> Computational Biology / Fred Hutchinson Cancer Research Center
> 1100 Fairview Ave. N.
> PO Box 19024 Seattle, WA 98109
>
> Location: Arnold Building M1 B861
> Phone: (206) 667-2793




More information about the R-help mailing list