library(QCA) nofcond <- 5:15 simulations <- 50 testeqmc <- function(nofcond, simulations) { speed <- mem <- matrix(nrow=length(nofcond), ncol=3) for (j in seq(length(nofcond))) { noflevels <- rep(2, nofcond[j]) totlines <- base3rows(nofcond[j]) temp1 <- temp2 <- rep(NA, simulations) set.seed(j) for (i in seq(simulations)) { expexcl <- sample(totlines, 20) expl <- floor(length(expexcl)/2) + ifelse(length(expexcl) %% 2 > 0, 1, 0) explain <- expexcl[seq(expl)] exclude <- expexcl[-seq(expl)] include <- setdiff(totlines, expexcl) gc() msbefore <- memory.size() temp1[i] <- system.time(eqmc(noflevels, explain, exclude))[3] temp2[i] <- memory.size() - msbefore } speed[j, 1] <- mean(temp1) mem[j, 1] <- mean(temp2) speed[j, 2] <- min(temp1) mem[j, 2] <- min(temp2) speed[j, 3] <- max(temp1) mem[j, 3] <- max(temp2) } return(list(speed, mem)) } testqmc <- function(nofcond, simulations) { speed <- mem <- matrix(nrow=length(nofcond), ncol=3) for (j in seq(length(nofcond))) { noflevels <- rep(2, nofcond[j]) totlines <- base3rows(nofcond[j]) temp1 <- temp2 <- rep(NA, simulations) set.seed(j) for (i in seq(simulations)) { expexcl <- sample(totlines, 20) expl <- floor(length(expexcl)/2) + ifelse(length(expexcl) %% 2 > 0, 1, 0) explain <- expexcl[seq(expl)] exclude <- expexcl[-seq(expl)] include <- setdiff(totlines, expexcl) gc() msbefore <- memory.size() temp1[i] <- system.time(qmc(noflevels, sort(c(explain, include))))[3] temp2[i] <- memory.size() - msbefore } speed[j, 1] <- mean(temp1) mem[j, 1] <- mean(temp2) speed[j, 2] <- min(temp1) mem[j, 2] <- min(temp2) speed[j, 3] <- max(temp1) mem[j, 3] <- max(temp2) } return(list(speed, mem)) } ## eqmc eqmc <- function(noflevels, explain, exclude) { mvector <- rev(c(1, cumprod(rev(noflevels + 1))))[-1] expressions <- sort(setdiff(findSupersets(noflevels + 1, explain), findSupersets(noflevels + 1, exclude))) expressions <- .Call("removeRedundants", expressions, noflevels, mvector, package="QCA") } # qmc qmc <- function(noflevels, primelines) { mbase <- rev(c(1, cumprod(rev(noflevels + 1))))[-1] diffmatrix <- sapply(seq(length(noflevels)), function(x) { as.vector(outer(seq_len(mbase[x]), seq(mbase[x], 3*mbase[1] - mbase[x] - 1, 3*mbase[x]), "+")) }) minimized <- TRUE while (any(minimized)) { max.diffs <- ceiling(length(primelines)*length(noflevels)/2) result <- matrix(nrow=max.diffs, ncol=2) startrow <- 1 for (i in seq(length(noflevels))) { match.lines <- primelines[primelines %in% diffmatrix[, i]] match.lines <- match.lines[(match.lines + mbase[i]) %in% primelines] length.match <- length(match.lines) if (length.match > 0) { endrow <- startrow + length.match - 1 result[startrow:endrow, ] <- c(match.lines, match.lines + mbase[i]) } startrow <- startrow + length.match } result <- result[-(startrow:max.diffs), , drop=FALSE] minimized <- primelines %in% result if (any(minimized)) { primelines <- unique(c(primelines[!minimized], 2*result[,1] - result[,2])) } else { primelines <- sort(unique(primelines)) } } }