[R] Calling R object from R function

[R. Michael Weylandt]

On Thu, Nov 8, 2012 at 4:57 PM, Fares Said <frespider at hotmail.com> wrote:
> Hi Micheal,
>
> Please Can you tell me how I do that?

How to do what? I wrote you a very long reply with many nouns....

I'll assume you mean keeping your reply on list: it's what I've done
differently than you in each step of our communication up to now --
making sure that r-help at r-project.org is in the cc: field of your
email. Depending on your mail client, this is as easy as hitting
"reply all" instead of "reply."

Michael Weylandt

>
> THanks
>
>> From: michael.weylandt at gmail.com
>> Date: Thu, 8 Nov 2012 16:46:14 +0000
>> Subject: Re: [R] Calling R object from R function
>> To: frespider at hotmail.com; r-help at r-project.org
>>
>> On Thu, Nov 8, 2012 at 2:44 PM, Fares Said <frespider at hotmail.com> wrote:
>> > Hi Michael,
>> >
>> > you mentioned I can get help, can you give more details please.
>>
>> Hi Fares,
>>
>> I also asked that you keep our correspondance on the mailing list.
>> Please do so. If you want private help, you can seek a local
>> statistical consultancy, but free help is available here, if you
>> follow protocol.
>>
>> >
>> > I also edited the example to make productive.
>>
>> But I'm not using Nabble and neither are most of your other potential
>> respondents: if you want to use an email help list, it's much better
>> to use email. For instance, if we check the official R help archives
>> -- https://stat.ethz.ch/pipermail/r-help/2012-November/328391.html --
>> you'll see your post wasn't changed. It's rather wretched that Nabble
>> allows that, in my opinion, as it invalidates conversations.
>>
>> >
>> > and you might tell me to create the M1 function on the get.m function
>> > but I
>> > prefer not because I have 9 to ten function and they have lots statement
>> > and
>> > I prefer to keep them separate
>> >
>>
>> I've copied your Nabble post here:
>>
>> -------------------------------------------------------
>>
>> a0=rep(1,40)
>> a=rep(0:1,20)
>> b=c(rep(1,20),rep(0,20))
>> c0=c(rep(0,12),rep(1,28))
>> c1=c(rep(1,5),rep(0,35))
>> c2=c(rep(1,8),rep(0,32))
>> c3=c(rep(1,23),rep(0,17))
>> c4=c(rep(1,6),rep(0,34))
>> x=matrix(cbind(a0,a,b,c0,c1,c2,c3,c4,rnorm(40)),nrow=40,ncol=9)
>> Dat <- cbind(x,rnorm(40,2,30));colnames(Dat) <-
>> c("a0","a","b","c0","c1","c2","c3","c4","c5","Y")
>>
>> M1 <- function(Trdat,Tedat,mdat,nsam,conv){
>> M1list <- NULL
>> vectx <- c(1,4,6,7,9)
>> vectz <- c(2,3,7,1,4,9)
>> X <- Trdat[,vectx]
>> Z <- Trdat[,vectz]
>> Y <- Trdat[,ncol(Trdat)]
>> TesX <- Tedat[,vectx]
>> TesZ <- Tedat[,vectz]
>> TesY <- Tedat[,ncol(Tedat)]
>> Treig <- eigen(crossprod(X))$values
>> if(any(abs(Treig) < conv))stop("In M1 the design matrix (X) is
>> singular for simulation ",paste(nsam))
>> Comp <- c("nCol(X)"= ncol(X),"nCol(Z)"= ncol(Z),"Is
>> length(Y)=nrow(X)"= length(Y)==nrow(X),
>> "Is length(Y)=nrow(Z)"= length(Y)==nrow(Z))
>>
>> M1list$vectx <- vectx
>> M1list$vectz <- vectz
>> M1list$X <- X
>> M1list$Z <- Z
>> M1list$Y <- Y
>> M1list$TesX <- TesX
>> M1list$TesZ <- TesZ
>> M1list$TesY <- TesY
>> M1list$Comp <- Comp
>> return(M1list)
>> }
>>
>>
>> get.m <- function(dat,asim,ModelFun,M,conv){
>> Sim <- list()
>> modInd <- ModelFun(Trdat=dat,Tedat=dat,mdat=dat,nsam=-1,conv=conv) #
>> HERE WHERE I NEED HELP i only need to import vectx and vectz that is
>> why I set Trdat=Tedat=dat
>> if(M==1){
>> vecx <- modInd$vectx
>> vecz <- modInd$vectz
>> px <- length(vecx)
>> pz <- length(vecz)
>> pk <- length(modInd$Comp)
>> nam <-colnames(dat[,vecx])
>> Asse <- matrix(NA,nrow=asim,ncol=px)
>> Check <- matrix(NA,nrow=pk,ncol=asim)
>> colnames(Check) <- paste("CheckIter",1:asim,sep="")
>> }
>> else {
>> vecx <- modInd$vectx
>> vecz <- modInd$vectz
>> px <- length(vecx)
>> pz <- length(vecz)
>> pk <- length(modInd$Comp)
>> nam <-colnames(dat[,vecx])
>> Asse <- matrix(NA,nrow=asim,ncol=px)
>> Check <- matrix(NA,nrow=pk,ncol=asim)
>> colnames(Check) <- paste("CheckIter",1:asim,sep="")
>> }
>>
>> for(k in 1:asim){
>> cat("Iter #",paste(k),"\n")
>>
>> #==========================================================================================
>> # Start Sampling code
>>
>> #==========================================================================================
>> # Sample the Index for Train Set
>> set.seed(k)
>> Indx<-sample(1:nrow(dat),nrow(dat),replace=T)
>> SamDat <- dat[Indx,]
>> # Split Data
>> set.seed(k)
>> TrainInd <- sample(1:nrow(SamDat), trunc(2*length(1:nrow(SamDat))/3))
>> # Sample 2/3 of the data
>> TrSet <- SamDat[TrainInd,] # Train data
>> ######## Hold 1/3 of the data
>> TeSet <- SamDat[-TrainInd,] # hold 1/3 of the data
>> Trind <- ceiling((2*length(Indx))/3)
>> Model <- ModelFun(Trdat=TrSet,Tedat=TeSet,mdat=dat,nsam=k,conv=conv)
>> Y <- Model$Y
>> X <- Model$X
>> Z <- Model$Z
>> TesX <- Model$TesX
>> TesZ <- Model$TesZ
>> TesY <- Model$TesY
>> xnam <-colnames(X)
>> znam <-colnames(Z)
>> pc <- ncol(X)
>> fmla <- as.formula(paste("Y ~",paste(xnam, collapse= "+"),"-1",sep=""))
>> fitlm <- lm(formula=fmla,data = data.frame(cbind(X,Y)))
>> ResiSqr <- (residuals(fitlm))*(residuals(fitlm))
>> Check[,k] <- Model$Comp
>> Asse[k,1:pc] <- coef(fitlm)
>>
>> }
>> Sim$Check <- Check
>> Sim$Asse <- Asse
>> return(Asse)
>> }
>> get.m(dat=Dat,asim=6,ModelFun=M1,M=1,conv=1e-4)
>>
>> ------------------------------------------------------
>>
>> Your code is quite messy and difficult to follow: I'd write it as follows:
>>
>> # Initialize some data
>> Dat <- cbind(
>> a0 = rep(1, 40),
>> a = rep(0:1, 20),
>> b = rep(c(1,0), each = 20),
>> c0=c(rep(0,12),rep(1,28)),
>> c1=c(rep(1,5),rep(0,35)),
>> c2=c(rep(1,8),rep(0,32)),
>> c3=c(rep(1,23),rep(0,17)),
>> c4=c(rep(1,6),rep(0,34)),
>> Y = rnorm(40,2,30))
>>
>> M1 <- function(Trdat,Tedat,mdat,nsam,conv){
>> vectx <- c(1,4,6,7,9)
>> vectz <- c(2,3,7,1,4,9)
>>
>> X <- Trdat[,vectx]
>> Z <- Trdat[,vectz]
>> Y <- Trdat[,ncol(Trdat)]
>>
>> TesX <- Tedat[,vectx]
>> TesZ <- Tedat[,vectz]
>> TesY <- Tedat[,ncol(Tedat)]
>>
>> Treig <- eigen(crossprod(X))$values
>>
>> if(any(abs(Treig) < conv))
>> stop("In M1 the design matrix (X) is singular for simulation ", nsam)
>>
>> Comp <- c(`nCol(X)`= ncol(X),`nCol(Z)`= ncol(Z),
>> `Is length(Y)=nrow(X)` = length(Y)==nrow(X),
>> `Is length(Y)=nrow(Z)` = length(Y)==nrow(Z))
>>
>> list(vectx = vectx,
>> vectz = vectz,
>> X = X, Z = Z, Y = Y,
>> TesX = TesX, TesZ = TesZ,
>> TesY = TesY, Comp = Comp)
>> }
>>
>> with similar modifications throughout the rest of your code. Hopefully
>> you find that easier to read: I certainly do.
>>
>> Now, it's still not entirely clear to me what you're asking: but
>> perhaps global assignment and/or lexical scoping does what you want?
>>
>> Consider these tricks:
>>
>> #########################
>> add_magic_Z <- function(z){
>> Z <- z
>> function(x) x + z
>> }
>>
>> add_2 <- function(2)
>>
>> add_2(5) # 7
>>
>> add_3 <- function(3)
>>
>> add_3(0) # 3
>> ##########################
>> f <- function(x) {
>> X <<- X + x
>> return(x^2)
>> }
>>
>> X <- -3
>>
>> f(5)
>> f(10)
>>
>> print(X) # increased by the `<<-` inside of f()
>> ###########################
>>
>> The latter is considered bad programming practice however.
>>
>> Cheers,
>> Michael