R/prime.imp.R

In LogicForest: Logic Forest

#' Internal Logic Forest Functions
#'
#' This function is called by \code{pimp.import} and \code{LBoost.PIs}. It is not intended to be used independently of these functions.
#' @returns No return value, called for side effects
#' @details
#' It generates a list of all variables and variable interactions identified by a specific logic regression tree with in a logic forest model or and LBoost model.
#'
#'
#' @export
#' @keywords internal

prime.imp<-function (tree, data, Xs, mtype)
{
  mat<-TTab(data, tree, Xs=Xs, mtype=mtype)
  mat[mat == 0] <- -1
  n.var <- ncol(mat)
  if (is.null(colnames(mat)))
    colnames(mat) <- paste("X", 1:n.var, sep = "")
  ia <- p.combos(n.var)
  ia.rowS <- rowSums(ia)
  vec.primes <- character(0)
  list.pimps<-list()
  list.cover <- list()
  mat.in <- NULL
  name.paste <- function(x)
  {
    x <- x[x != ""]
    paste(x, collapse = " & ")
  }
  tmp.list<-vector("list",n.var)
  for (i in 1:n.var)
  {
    pairt <- p.combos(i, conj = -1)
    n.p <- nrow(pairt)  #number of combos for i vars
    ia2 <- matrix(ia[ia.rowS == i, ], ncol = n.var)
    tmp <- matrix(0, nrow(ia2) * n.p, n.var)
    for (j in 1:nrow(ia2)) tmp[((j - 1) * n.p + 1):(j * n.p), ia2[j, ] == 1] <- pairt
    if (length(vec.primes) > 0) {
      tmp9 <- tmp %*% t(mat.in)
      tmp10 <- diag(mat.in %*% t(mat.in))
      tmp11 <- t(tmp10) %x% rep(1, nrow(tmp)) == tmp9
      tmp.in <- which(rowSums(tmp11) == 0)
      tmp <- tmp[tmp.in, ]
    }
    tmp2 <- tmp %*% t(mat) == i
    ids <- which(rowSums(tmp2) == 2^(n.var - i))
    tmp <- tmp[ids, ]
    tmp.list[[i]]<-tmp
    if (length(ids) > 0)
    {
      mat.in <- rbind(mat.in, tmp)
      for (k in ids) list.cover[[length(list.cover) + 1]] <- which(tmp2[k, ])
      mat.names <- matrix(rep(colnames(mat), e = length(ids)), ncol = n.var)
      mat.names[tmp == 0] <- ""
      mat.pimps<-vector("list", nrow(mat.names))
      for (m in 1:nrow(mat.names))
      {
        mat.pimps[[m]]<-which(colnames(data)%in%mat.names[m,])
      }
      list.pimps<-append(list.pimps, mat.pimps)
      mat.names[tmp == -1] <- paste("!", mat.names[tmp == -1], sep = "")
      tmp.prime <- apply(mat.names, 1, name.paste)
      vec.primes <- c(vec.primes, tmp.prime)
    }
    cover <- unique(unlist(list.cover))
    if (length(cover) == nrow(mat))
      break
  }
  tmp.mat<-NULL
  for (i in 1:length(tmp.list)){
    tmp.mat<-rbind(tmp.mat, tmp.list[[i]])
  }
  vec.pimpvars<-sort(unique(unlist(list.pimps)))
  n.prime <- length(vec.primes)
  listPI <- list(vec.primes=vec.primes, tmp.mat=tmp.mat, vec.pimpvars=vec.pimpvars, list.pimps=list.pimps)
  class(listPI) <- "primeImp"
  listPI
}