On Thu, Nov 8, 2012 at 4:57 PM, Fares Said <frespi...@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@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.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 ______________________________________________ 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.
