Hi Michael, I dont need private help, I am not sure what do you mean by global assignment and/or lexical scoping does what you want?
What I would like to have call one r object(vectx) from the function (M1) with out me using this line of code modInd <- ModelFun(Trdat=dat,Tedat=dat,mdat=dat,nsam=-1,conv=conv) because if I used this code it will let me call vectx, but at the same time it will execute all the other code in M1 which I don't want. Hope this clear. Thank you so much > From: michael.weyla...@gmail.com > Date: Thu, 8 Nov 2012 16:46:14 +0000 > Subject: Re: [R] Calling R object from R function > To: frespi...@hotmail.com; r-help@r-project.org > > On Thu, Nov 8, 2012 at 2:44 PM, Fares Said <frespi...@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 [[alternative HTML version deleted]] ______________________________________________ R-help@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.
