[R] conditional assignments and calculations

[Michael Lachmann]

Thank you!
Now the conditional assignments work almost prefectly.
The current code is at the bottom of the message.
Now I can do
depends[A,B]=B+9
and this will be executed only if B was more recently updated then A, and if the last time A was updated, the expression used was 'B+9'.

And it is also possible to do
depends[A,file="table.txt"]=read.table("table.txt")
and A will only be read again if the file "table.txt" was updated more recently than it was read last time.

I have only a few remaining questions:
1. I added attributes to variables, "last.updated", and "update.expression". If the variables are just regular vectors/lists, then when I print them, I also see these attributes. Is it somehow possible to have these attributes hidden?

2. I defined an operator %set%, which is supposed to work just like "<-" and "=", but also updates "last.updated" and "update.expression". It would be best to really replace "<-" and "=" with this operator, and then any update of a variable will be registered. This doesn't seem to work, because if I define "<-" as  
function(x,value)
{
  v=as.character(as.expression(substitute(value)))
  eval.parent(substitute(.Primitive("<-")(x,value)))
  eval.parent(substitute(attr(x,"last.updated")<-Sys.time()))
  eval.parent(substitute(attr(x,"update.expression")<-v))
  x
}
then this function calls "attr<-", which then calls "<-" leading to infinite recursion. Is there a way to set an attribute on a variable without using attr<- ?

Or maybe it is a bad idea to redefine "<-" in the first place...


Thank you very much!
Michael

Gabor Grothendieck wrote:

>Michael Lachmann <lachmann <at> eva.mpg.de> writes:
>
>: 
>: Hello!
>: 
>: I am using the TeXmacs interface to R. (Though I encountered a similar 
>: problem when using Sweave)
>: In doing calculations I often ecounter this scenario: I'll have some 
>: calculations in my file:
>: --
>: A=read.lots.of.data()
>: 
>: B=huge.calculation.on(A)
>: 
>: C=another.calculation.on(B)
>: --
>: Now, if A has already been read, I don't need to re-read it. If B has 
>: already been calculated, I don't need to recalculate it. But I would 
>: like to be able to just press 'enter' on each of them.
>: 
>: So, I would like R to somehow figure out dependencies (a bit like in 
>: Makefiles)
>: 
>: I implemented something like this with the following functions 

...

>: But this solution is quite ugly, because of several problems:
>: 
>: 1. To call 'depends(A,B)=f(B)' the first time, A has to already exist, 
>: otherwise I get an error (before I enter the "depends<-" function.)
>
>The technique used to implement mulitple return values shown in 
>
>   http://tolstoy.newcastle.edu.au/R/help/04/06/1406.html
>
>could be adapted to this problem.  Using that technique the code would 
>look like this:
>
>   depends[A,B] <- f(B)
>
>and A would not have to pre-exist.
>
>You define a structure with a class of depends, say:
>
>   depends <- structure(NA, class = "depends")
>
>and then define the [<-.depends action on that structure
>in an analogous way to what was done there.
>
>: 2. I would also like to have a convenient way to do
>: "if( !exists(A) ) { A=read.lots.of.data(); A=touch(A) }"
>: maybe something like:
>: depends(A)<-read.lots.of.data()
>: But that doesn't work, because of 1.
>: or
>: A %set% read.lots.data()
>: But that doesn't work, because I haven't figured out a way for a 
>: function to change one of its variables.
>: (Maybe I could do A=A %set read.lots.of.data(), but that is really ugly...)
>
>
>Is this what you want?
>
>R> f <- function(x,v) assign(as.character(substitute(x)), v, parent.frame())
>R> x # x does not exist
>Error: Object "x" not found
>R> f(x,3)
>R> x # now it does
>[1] 3
>
><<- can be used if the   eval.parent is a third way (see #3 below).
>
>: 3. It would be nice to be able to do touch(A) instead of A=touch(A)
>
>touch <- function(x) 
>    eval.parent(substitute(attr(x,"last.updated")<-Sys.time())) 
>x <- 3
>touch(x)
>
>: 
>: 4. If I modify A without calling 'A=touch(A)', then B will not be 
>: updated next time I call 'depends(B,A)=huge.calculation.on(A)'. So it 
>: would be nice to have the variable's 'last updated' time updated 
>: automatically. (Though then it is a bit problematic to decide what the 
>: 'last updated' time should be for variables loaded from a file...)
>
>If its done in a function you could use on.exit to ensure that it gets
>updated when leaving the function.
>

touch=function(...,l=list())
{
    args <- as.list(match.call())
    if( "l" %in% names(args) ) {
	    argsl=as.list(args[[length(args)]][-1])
	    argsl=sapply(argsl,function(x) parse(text=x)[[1]])
	    args=args[-length(args)]
  } else { argsl=c() }
    args=c(args[-1],argsl)
    for( i in 1:length(args)) {
      eval.parent(substitute(attr(x,"last.updated")<-Sys.time(),
      list(x=args[[i]]) ))
    }
}

last.updated=function(a) {   
  if( length(attr(a,"last.updated")) == 0 ) {
      Sys.time()
  } else {
      attr(a,"last.updated")
  }
}


"%set%"=function(x,value)
{
  v=as.character(as.expression(substitute(value)))
  eval.parent(substitute(.Primitive("<-")(x,value)))
  eval.parent(substitute(attr(x,"last.updated")<-Sys.time()))
  eval.parent(substitute(attr(x,"update.expression")<-v))
  x
}



depends <- structure(NA,class="depends")

"[<-.depends" <- function(x,...,file=c(),value) {
	  v=as.character(as.expression(substitute(value)))
  args <- as.list(match.call())
  if( !exists(as.character(args[[3]] ), env=sys.frame(-1)) ) {
      eval(substitute(x<-v,list(x=args[[3]],v=value)),env=sys.frame(-1))
      eval(substitute(touch(x),list(x=args[[3]])),env=sys.frame(-1))
      eval.parent(substitute(attr(x,"update.expression")<-v,list(x=args[[3]],v=v)))
  } else {
    lu=list()
		xlu=eval(substitute(attr(x,"last.updated"),list(x=args[[3]]),env=sys.frame(-1)))
    if( length(file) >0 ) {
	    lu=c(lapply(file,function(f) {
		    file.info(f)$mtime
		    }),lu) 
      args=args[-(length(args)-1)]
    }
    if( length(xlu)>0 ) {
        lu=c(lapply((1:(length(args)-1))[-c(1:3)],function(i) {
            eval(substitute(last.updated(x),list(x=args[[i]])),env=sys.frame(-1))
        }),lu)
    }
    lu=prod(sapply(lu,function(x) x-xlu<0))
	  xv=eval(substitute(attr(x,"update.expression"),list(x=args[[3]]),env=sys.frame(-1))) 
	  if( length(xv)*length(v) > 0 ) {
	    if( xv != v ) lu = 0
    } else { lu=0} 
    if( (lu==0) ) {
          eval(substitute(x<-v,list(x=args[[3]],v=value)),env=sys.frame(-1))
          eval(substitute(touch(x),list(x=args[[3]])),env=sys.frame(-1))
      eval.parent(substitute(attr(x,"update.expression")<-v,list(x=args[[3]],v=v)))
    }
  }
  x
}