R/components.R

components <- function(Q, P){
  ncomp     <- sample.int(Q, 1)
  Y_comp    <- sample(1:ncomp, Q, replace=TRUE)
  X_comp    <- sapply(1:P, function(p) sample.int(ncomp, sample.int(ncomp, 1)))
  indexbyVar <- list(Y=Y_comp, X=X_comp)
  
  indexbyComp <- vector("list", ncomp)
  
  for(n in 1:ncomp){
    indexbyComp[[n]] <- list(Y = unique(which(Y_comp==n)), X=unique(which(sapply(X_comp, function(x) any(x==n)))), Xout = unique(which(sapply(X_comp, function(x) all(x!=n)))))
    indexbyComp[[n]]$X <- indexbyComp[[n]]$X[!(indexbyComp[[n]]$X %in% indexbyComp[[n]]$Xout)]
    if( (length(indexbyComp[[n]]$X) + length(indexbyComp[[n]]$Xout)) != P) stop("All X's not in components!")
    
  }
  
  null.comp <- NULL
  for(n in 1:ncomp){
    if(n > length(indexbyComp)) break
    if(length(indexbyComp[[n]]$Y)==0) null.comp <- c(null.comp, n)
  }
  indexbyComp[null.comp] <- NULL
  
  ncomp <- length(indexbyComp)
  
  return(list(var=indexbyVar, comp=indexbyComp, ncomp=ncomp))
}
eifer4/stochasticSampling documentation built on May 14, 2019, 11:16 a.m.