# R CMD SHLIB woa.c # # source("woa.s") # woa.obj _ "woa.so" # the object file C.symbol _ symbol.C # for R woa <- function(nRow, nCol, sLevel=2, weights=NULL, xInit=NULL, loop=10, try=100, try2=try, oaOnly=F) { if (oaOnly != F) try2 <- 0 # construct OA if loop<0, NOA if loop>0 xx <- matrix(0, nRow, nCol) if(!is.null(xInit)) { xInit <- as.matrix(xInit) nInit <- ncol(xInit) if(nrow(xInit) != nRow) return("nrow(xInit) != nRow"); for(i in 1:nInit) xx[,i] <- xInit[,i] } else nInit <- 0 co <- matrix(0, nRow, nRow) i <- length(sLevel) ss <- c(sLevel, rep(sLevel[i], nCol-i)) if(!is.null(weights)){ i <- length(weights) ww <- c(weights, rep(weights[i], nCol-i)) } else ww <- ss # defaulted weights by levels xk <- rep(0, nRow) # to store a column vector oabound <- ssdbound <- rep(0, nCol) # lower bounds storage.mode(xx) <- storage.mode(ss) <- storage.mode(ww) <- "integer" storage.mode(oabound) <- storage.mode(ssdbound) <- "integer" storage.mode(co) <- storage.mode(xk) <- "integer" yy <- xx # temporary if(!is.loaded(C.symbol("woa"))) dyn.load(woa.obj) seed <- runif(1, min=0, max=30000) # random seed junk <- .C("woa", x=xx, s=ss, w=ww, oabound=oabound, ssdbound=ssdbound, co=co, xk, yy, K2=as.integer(0), n0=as.integer(nInit), n=as.integer(nCol), m=as.integer(nRow), loop=as.integer(loop), try=as.integer(try),try2=as.integer(try2), time=as.double(seed)) if(try2 <= 0) xx <- junk$x[,1:junk$n0] else xx <- junk$x dimnames(xx) <- list(1:nrow(xx), 1:ncol(xx)) list(x=xx, s=junk$s, w=junk$w, K2=junk$K2, n0=junk$n0, oabound=junk$oabound, ssdbound=junk$ssdbound, loop=junk$loop, seconds=junk$time) }