132 lines
3.9 KiB
R
132 lines
3.9 KiB
R
`solvechart` <- function(x, ...) {
|
|
|
|
dots <- list(...)
|
|
|
|
if (all(rowSums(x) > 0)) {
|
|
|
|
PIlayers <- attr(x, "PIlayers")
|
|
|
|
# number of:
|
|
PIs <- ncol(x)
|
|
poc <- nrow(x) # positive observed configurations (minterms)
|
|
|
|
# sink("timings.txt", append = TRUE)
|
|
# cat(sprintf("Minterms: %s, PIs: %s", poc, PIs))
|
|
# sink()
|
|
|
|
model <- list(
|
|
A = x,
|
|
modelsense = "min",
|
|
rhs = rep(1, poc),
|
|
sense = rep(">=", poc),
|
|
vtype = rep("B", PIs)
|
|
)
|
|
|
|
if (!is.null(PIlayers)) {
|
|
PIlayers <- PIlayers[PIlayers > 0]
|
|
}
|
|
|
|
if (length(PIlayers) < 2 || isFALSE(dots$multiobj)) {
|
|
model$obj <- rep(1, PIs)
|
|
} else {
|
|
# cat(paste(PIlayers, collapse = " "))
|
|
|
|
for (i in seq(length(PIlayers), 2)) {
|
|
PIlayers[i] <- PIlayers[i] - PIlayers[i - 1]
|
|
}
|
|
|
|
# cat(" -- ", paste(PIlayers, collapse = " "), "\n")
|
|
|
|
value <- rep(
|
|
rev(2^seq(0, length(PIlayers) - 1)),
|
|
PIlayers
|
|
)
|
|
|
|
if (length(value) < PIs) {
|
|
value <- c(value, rep(tail(value, n = 1), PIs - length(value)))
|
|
} else if (PIs < length(value)) {
|
|
value <- value[seq(PIs)]
|
|
}
|
|
|
|
# admisc::export(
|
|
# as.data.frame(t(x)),
|
|
# file = paste("pic", sample(5000, 1), ".csv", sep = ""),
|
|
# col.names = FALSE
|
|
# )
|
|
|
|
# admisc::export(
|
|
# as.data.frame(t(attr(x, "implicants"))),
|
|
# file = paste("imp", sample(5000, 1), ".csv", sep = ""),
|
|
# col.names = FALSE
|
|
# )
|
|
|
|
model$multiobj <- list(
|
|
list(
|
|
objn = rep(1, PIs),
|
|
priority = 1,
|
|
weight = 1
|
|
),
|
|
list(
|
|
objn = -1 * value,
|
|
priority = 0,
|
|
weight = 1
|
|
)
|
|
)
|
|
}
|
|
|
|
tc <- admisc::tryCatchWEM(
|
|
solution <- gurobi::gurobi(
|
|
model,
|
|
params = list(
|
|
OutputFlag = 0,
|
|
LogToConsole = 0
|
|
)
|
|
)
|
|
)
|
|
|
|
if (is.null(tc$error)) {
|
|
# sink("timings.txt", append = TRUE)
|
|
# cat(sprintf(", Time: %s\n", round(solution$runtime, 3)))
|
|
# sink()
|
|
|
|
if (round(solution$objval[1]) < solution$objval[1]) {
|
|
# the weighted method did not yield precise results
|
|
temp <- sapply(solution$pool, function(x) {
|
|
return(round(x$objval[1]) == x$objval[1])
|
|
})
|
|
|
|
if (any(temp)) {
|
|
solution <- solution$pool[[which(temp)[1]]]$xn
|
|
} else {
|
|
# There is still no ideintified solution with an integer number of PIs
|
|
# Give up weigthing
|
|
model$multiobj <- NULL
|
|
|
|
# and return the uneighted solution
|
|
model$obj <- rep(1, PIs)
|
|
solution <- gurobi::gurobi(
|
|
model,
|
|
params = list(
|
|
OutputFlag = 0,
|
|
LogToConsole = 0
|
|
)
|
|
)$x
|
|
}
|
|
} else {
|
|
solution <- solution$x
|
|
}
|
|
} else {
|
|
solution <- lpSolve::lp(
|
|
"min",
|
|
rep(1, ncol(x)),
|
|
x,
|
|
">=",
|
|
1,
|
|
int.vec = seq(nrow(x)),
|
|
all.bin = TRUE
|
|
)$solution
|
|
}
|
|
|
|
return(as.integer(which(solution > 0)))
|
|
}
|
|
}
|