R devel - Nov 2006 - data.frame within a function (PR#9294) (cont'd)

This continues the message "data.frame within a function (PR#9294)"
that
was posted on 2006/10/12. Duncan Murdoch kindly replied. I'm using the 
current version R 2.4.0, but the same issue exists. Just copy and paste 
the following code under R, and compare the output of f1() and f2() and 
the output of f3() and f4(). Does anybody have any idea? Thanks.

###################################################
# R code for demonstration only #
###########################

rmvnorm<- function (n, mean = rep(0, nrow(sigma)), sigma = 
diag(length(mean))){
  if (nrow(sigma) != ncol(sigma)) {
    stop("sigma must be a square matrix")
  }
  if (length(mean) != nrow(sigma)) {
    stop("mean and sigma have non-conforming size")
  }
  ev <- eigen(sigma, sym = TRUE)$values
  if (!all(ev >= -sqrt(.Machine$double.eps) * abs(ev[1])))
    warning("sigma is numerically not positive definite")
  sigsvd <- svd(sigma)
  retval <- t(sigsvd$v %*% (t(sigsvd$u) * sqrt(sigsvd$d)))
  retval <- matrix(rnorm(n * ncol(sigma)), nrow = n) %*% retval
  retval <- sweep(retval, 2, mean, "+")
  retval
}

f<- function(obj){
     update(obj,~ .+x,evaluate=T); cat("also ok\n")
}

#########################
# compare f1() and f2() #
#########################
f1<- function(){
     x<- rnorm(10)
     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
#c("y1","y2")
     dtf<- data.frame(y,x)
     lm1<- lm(cbind(y1,y2)~1,data=dtf); cat("ok\n")
    
     update(lm1,~ .+x,evaluate=T); cat("also ok\n") # only this line
is
different
}
f2<- function(){
     x<- rnorm(10)
     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
#c("y1","y2")
     dtf<- data.frame(y,x)
     lm1<- lm(cbind(y1,y2)~1,data=dtf); cat("ok\n")
    
     f(lm1) # only this line is different
}

f1()
f2()

#########################
# compare f3() and f4() #
#########################
f3<- function(){
     x<- rnorm(10)
     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
#c("y1","y2")
     lm1<- lm(cbind(y1,y2)~1,data=data.frame(y,x)); cat("ok\n")
    
     update(lm1,~ .+x,evaluate=T); cat("also ok\n") # only this line
is
different
}
f4<- function(){
     x<- rnorm(10)
     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
#c("y1","y2")
     lm1<- lm(cbind(y1,y2)~1,data=data.frame(y,x)); cat("ok\n")
    
     f(lm1) # only this line is different
}

f3()
f4()

#########
# the end #
#########

This is not to do with your subject line, and not a bug (and PR#9294 as 
been closed).  You don't even say what you think the 'issue' is: it
seems
to be your lack of understanding of the scope rules.

I get
> f2()
ok
Error in inherits(x, "data.frame") : object "dtf" not found

which is quite correct: dtf is not visible from the body of f() where you 
call update(evaluate=T) (the default, and use TRUE please).  This is why 
update has an 'evaluate' argument, so you can manage the scope used.


On Thu, 30 Nov 2006, Riyan Cheng wrote:
> This continues the message "data.frame within a function
(PR#9294)" that
> was posted on 2006/10/12. Duncan Murdoch kindly replied. I'm using the
> current version R 2.4.0, but the same issue exists. Just copy and paste
> the following code under R, and compare the output of f1() and f2() and
> the output of f3() and f4(). Does anybody have any idea? Thanks.
>
> ###################################################
> # R code for demonstration only #
> ###########################
>
> rmvnorm<- function (n, mean = rep(0, nrow(sigma)), sigma >
diag(length(mean))){
>  if (nrow(sigma) != ncol(sigma)) {
>    stop("sigma must be a square matrix")
>  }
>  if (length(mean) != nrow(sigma)) {
>    stop("mean and sigma have non-conforming size")
>  }
>  ev <- eigen(sigma, sym = TRUE)$values
>  if (!all(ev >= -sqrt(.Machine$double.eps) * abs(ev[1])))
>    warning("sigma is numerically not positive definite")
>  sigsvd <- svd(sigma)
>  retval <- t(sigsvd$v %*% (t(sigsvd$u) * sqrt(sigsvd$d)))
>  retval <- matrix(rnorm(n * ncol(sigma)), nrow = n) %*% retval
>  retval <- sweep(retval, 2, mean, "+")
>  retval
> }
>
> f<- function(obj){
>     update(obj,~ .+x,evaluate=T); cat("also ok\n")
> }
>
> #########################
> # compare f1() and f2() #
> #########################
> f1<- function(){
>     x<- rnorm(10)
>     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
> #c("y1","y2")
>     dtf<- data.frame(y,x)
>     lm1<- lm(cbind(y1,y2)~1,data=dtf); cat("ok\n")
>
>     update(lm1,~ .+x,evaluate=T); cat("also ok\n") # only this
line is
> different
> }
> f2<- function(){
>     x<- rnorm(10)
>     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
> #c("y1","y2")
>     dtf<- data.frame(y,x)
>     lm1<- lm(cbind(y1,y2)~1,data=dtf); cat("ok\n")
>
>     f(lm1) # only this line is different
> }
>
> f1()
> f2()
>
> #########################
> # compare f3() and f4() #
> #########################
> f3<- function(){
>     x<- rnorm(10)
>     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
> #c("y1","y2")
>     lm1<- lm(cbind(y1,y2)~1,data=data.frame(y,x)); cat("ok\n")
>
>     update(lm1,~ .+x,evaluate=T); cat("also ok\n") # only this
line is
> different
> }
> f4<- function(){
>     x<- rnorm(10)
>     y<- rmvnorm(10,mean=c(1,2)); colnames(y)<-
paste("y",1:2,sep="")
> #c("y1","y2")
>     lm1<- lm(cbind(y1,y2)~1,data=data.frame(y,x)); cat("ok\n")
>
>     f(lm1) # only this line is different
> }
>
> f3()
> f4()
>
> #########
> # the end #
> #########
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
-- 
Brian D. Ripley,                  ripley at stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595