[R] RAM usage

[Vaidotas Zemlys]

Hi,

  > You'll need to post the code for anyone to be able to help. There are
  >  many ways to do the same thing, some hugely more efficient than
  > others.
  >

Ok, here it is:

#main function
rptree <-
function(X,y,depth=3,count=10) {
      X <- as.matrix(X)
      y <- as.vector(y)

      m <- dim(X)[1]
      n <- dim(X)[2]

      if(!identical(m,length(y))) {
          stop("Nesutampa dimensijos")
      }

      cnames <- colnames(X)
      tree <- list()
      snames <- list()
      node <- node.div(X,y,count=count,sep="",col.names=cnames)
      l <- node$l
      paths <- node$paths
      rownames(l) <- node$snames -> rownames(paths)
      tree[[1]] <- list(subsets=l,paths=paths)
      snames[[1]] <- node$snames

      if(depth>1) {
          for(i in 2:depth) {
              nl <- dim(tree[[i-1]]$subsets)[1]
              off <-0
              l <- logical();
              paths <- numeric();
              l.snames <- character();
              for(j in 1:nl) {
                  subs <- tree[[i-1]]$subsets[j,]
                  node <- node.div(X[subs,],y[subs],count=count,name=snames[[i-1]][j],col.names=cnames)
                  if(node$bonferoni>0) {
                      nnl <- dim(node$l)[1]
                      subss <- matrix(rep(subs,nnl),nrow=nnl,byrow=TRUE)
                      subss[subss] <- node$l
                      l <- rbind(l,subss)
                      paths <- rbind(paths,cbind(matrix(rep(tree[[i-1]]$paths[j,],nnl),nrow=nnl,byrow=TRUE), node$paths))
                      l.snames[off+1:nnl] <- node$snames
                      off <- off + nnl
                  }
              }
              rownames(l) <- l.snames -> rownames(paths)
              tree[[i]] <- list(subsets=l,paths=paths)
              snames[[i]] <- l.snames
          }

      }
      names(tree) <- paste("lv",1:depth,sep="")
      tree$X <- X
      tree$y <- y

      attributes(tree)$class <- "rptree"
      tree

}

#function node.div used in main function rptree
node.div <-
function(X,y,count=10,name="subset",sep=".",col.names=NULL) {

      m <- dim(X)[1]
      n <- dim(X)[2]

      SZZ=sum(y^2)
      SZ=sum(y)

      t <- rep(0,n)
      for(i in 1:n) {
          n1_length(X[X[,i]==0,i])
          if((n1>10) && (n1<(m-10))) {
              if(min(c(n1,m-n1)==n1)) {
                  SX <- sum(y[X[,i]==0])
                  SXX <- sum(y[X[,i]==0]^2)
                  n2 <- m-n1
              }
              else {
                  SX <- sum(y[X[,i]>0])
                  SXX <- sum(y[X[,i]>0]^2)
                  n2 <- n1
                  n1 <- m-n1
              }
              SY <- SZ-SX;
              SYY <- SZZ-SXX;

              SSX <- SXX-(1/n1)*(SX)^2
              SSY <- SYY-(1/n2)*(SY)^2
              v <- (SSX+SSY)/(m-2)
              stderr <- sqrt(v*(1/n1+1/n2))
              t[i] <- abs(SX/n1-SY/n2)/stderr
          }
      }

      #t <- t[t>0]
      bonf <- length(t[t>0])
      ind <- rep(0,count)
      if(bonf>1) {
          st <- sort(t,decreasing=TRUE,index.return=TRUE)
          j <- 1
          jj <- 1
          ind[1] <- st$ix[1]
          q.value <- qt(0.975,m-2)
          while((j<count) && (st$x[jj+1]>q.value) && (j<n)) {
              max.cor <- max(abs(cor(X[,c(ind,st$ix[jj+1])])[j+1,1:j]))

              if(max.cor<0.9) {
                  j <- j + 1
                  jj <- jj + 1
                  ind[j]_st$ix[jj]
              }
              else {
                  jj <- jj + 1
              }
          }
      }
      else {
          if(bonf==1) {
              ind[1]_(1:n)[t>0]
          }
      }
      ind <- ind[ind>0]
      ni <- length(ind)
      if(ni>0) {
          l_X[,ind]>0
          l <- t(matrix(c(l,!l),nrow=m))
          paths <- cbind(rep(ind,2),rep(c(1,0),each=ni))
          if(identical(col.names,NULL)) {
              snames <- paste(name,paste(rep(ind,2),rep(c(1,0),each=ni),sep="@"),sep=sep)
          }
          else {
              snames <- paste(name,paste(rep(col.names[ind],2),rep(c(1,0),each=ni),sep="@"),sep=sep)
          }
          list(l=l,paths=paths,snames=snames,bonferoni=bonf)
      }
      else {
          list(bonferoni=bonf)
      }
}


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._