If I understand your goal (still fuzzy) -- why don't you factor out
the bits you want to calculate repeatedly into their own little
utility function? That's just basic stuctured programming.
On Thu, Nov 8, 2012 at 5:25 PM, frespider <frespi...@hotmail.com> wrote:
> Hi,
>
> I edit my post, Can you please help with this matter?
>
> Hi,
>
> Can you please help me with this please?
>
> What I am trying to do is call a vector from R function and used in the new
> function
> # 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))
> colnames(Dat) <- c("a0","a","b","c0","c1","c2","c3","c4","c5","Y")
>
> 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)
> }
>
>
> 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)
>
>
>
>
>
>
> --
> View this message in context:
> http://r.789695.n4.nabble.com/Calling-R-object-from-R-function-tp4648714p4648919.html
> Sent from the R help mailing list archive at Nabble.com.
>
> ______________________________________________
> 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.
______________________________________________
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.
