Nothing
'logicopt' <- function(in_tt=NULL,
n_in=0,
n_out=0,
find_dc=FALSE,
input_sizes=NULL,
exact_cover=TRUE,
esp_file="",
mode="espresso")
########################################################################
########################################################################
#' @title Truth Table Logic Optimization
#
#' @description This function provides various options to optimize and
#' analyze an input truth table that represents a sum of Boolean or
#' multi-valued input product terms.
#' This function leverages the powerful logic minimization
#' algorithms from Espresso. These algorithms are a standard for optimizing
#' large functions in digital logic synthesis and have been modified to
#' handle general logic minimization problems to serve the R community.
#' The input truth table is an R data frame or alteratively an
#' Espresso format file. See examples section for more details.
#
#' @return The logicopt function returns a list of two items: an
#' truth table and a vector. The vector represents the size and
#' number of solutions in the output truth table. For example, a vector [10]
#' means there is a single solution in the truth table which has 10 rows.
#' A vector [5 8 2] means there are three solutions in the truth table
#' with 5, 8, and 2 rows respectively.
#
#' @param in_tt
#' An R data frame table representing a sum of product terms (PTs) truth table.
#' The PTs have one or more inputs with a positive integer
#' value or a "-" which means the input is not specified. The outputs are
#' Boolean and have possible values 1, 0, "-", or "~" and specify that the
#' corresponding PT is part of the ON set, the OFF set, the DC (don't care) set,
#' or is unspecified (not a part of any set) respectively. PTs should not
#' be in both the ON set and OFF set. When logicopt optimizes, it attempts to
#' find the fewest number of PTs in the ON set and uses PTs in the
#' DC set to further reduce the solution.
#'
#' @param n_in
#' Integer number of input columns in the truth table. Inputs
#' must come first in the truth table.
#
#' @param n_out
#' Integer number of output columns in the truth table.
#' Outputs must come after the n_in inputs of the truth table.
#' The number of columns in the in_tt must be n_in + n_out.
#
#' @param find_dc
#' FALSE (default) means any unspecified input conditions are
#' added to the OFF set for that output. TRUE means that any unspecified input
#' conditions are added to DC set for that output. The DC set
#' is used to further optimize the ON set. Don't cares can also be explicitly
#' defined by using "-" for the output in the input truth table.
#
#' @param input_sizes
#' Integer vector which represents the number of possible values for each
#' input. Default is NULL which means the size for each input will be
#' determined automatically by the software by analyzing the input truth table
#' and counting the number of values used.
#' Specifying input_sizes
#' is important when the input table has unspecified ("-") or unused input
#' values and all possible values are not used.
#'
#' @param exact_cover
#' Do an exact covering of prime implicant table. Option applies to QM based
#' algorithms (mode = "qm", "multi-min", and "multi-full"). If FALSE, the covering
#' algoirthm is heuristic and runs faster but may not find an exact solution.
#' If TRUE, algorithm is exact and finds an exact minimum solution.
#' Default is TRUE.
#'
#' @param esp_file
#' File name for espresso format file to read and process. If esp_file is
#' specified, the input truth table options (in_tt, n_in, n_out, input_sizes,
#' and find_dc) are ignored. The mode and exact_cover options still apply.
#'
#' @param mode
#' A string that specifies the mode to use for optimization:
#' \itemize{
#' \item{"espresso"}{ -- Use the classic espresso algorithm to optimize
#' the input truth table in_tt or the espresso format table in esp_file.
#' Returns a single solution of the optimized ON set. This option should
#' be used for very large truth tables.}
#' \item{"qm"}{ -- Use Quine-McCluskey (QM) algorithm to optimize in_tt
#' or esp_file and return a single solution of the optimized ON set. Use
#' with caution for large truth tables.}
#' \item{"primes"}{ -- Return set of prime implicants for in_tt or esp_file.
#' Three solutions are returned in a single truth table. These represent the
#' ESSENTIAL PRIMES, the PARTIALLY REDUNDANT PRIMES, and the TOTALLY REDUNDANT
#' PRIMES. Use the \code{\link{print_primes_tt}} function to print the results.}
#' \item{"multi-min"}{ -- Use QM to find the minimum set of non-redundant
#' solutions that cover all the ESSENTIAL PRIMES and the minimal set of
#' PARTIALLLY REDUNDANT PRIMES. Solutions are ordered
#' by size. The number of solutions found is capped at 50.}
#' \item{"multi-full"}{ -- Find additional coverings of prime implicants
#' beyond what is found in multi-min. A exhaustive covering of all PARTIALLY
#' REDUNDANT PRIMES is found. The number of solutions is capped at 50.}
#' \item{"echo"}{ -- Echo the ON, OFF, and DC sets for the in_tt or esp_file
#' truth table without any optimization. Note the resulting truth table
#' can be extremely large because it will cover the complete Boolean (or MV)
#' space for all inputs and outputs. Use with caution.}
#' }
#
#' @examples
#'
#' ######################### EXAMPLE #1 ###############################
#' # create a truth table with 4 inputs A, B, C, D and 2 outputs X and Y
#' e.ex1 <- data.frame(
#' A = c(0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1),
#' B = c(0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
#' C = c(0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1),
#' D = c(0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0),
#' X = c(1,1,1,1,0,1,1,1,"-",1,1,0,1,1,0,0),
#' Y = c("-",1,1,1,1,1,1,1,1,1,1,0,0,0,0,"-"))
#'
#' # show the unoptimized equations
#' tt2eqn(e.ex1,4,2)
#'
#' # optimize the truth table
#' tte <- logicopt(e.ex1,4,2)
#'
#' # show the optimized equations
#' tt2eqn(tte[[1]],4,2)
#'
#' # generate and print the prime implicants from optimized tte
#' ttp <- logicopt(tte[[1]],4,2,mode="primes")
#' print_primes_tt(ttp,TRUE,4,2)
#'
#' ######################### EXAMPLE #2 ###############################
#' # get path to an espresso format file
#' file <- system.file("extdata/espresso/small2.esp", package="LogicOpt")
#'
#' # get the espresso truth table without optimization
#' small2 <- logicopt(esp_file=file,mode="echo")
#'
#' # print the unoptimized equations
#' print_multi_tt(small2,TRUE,4,3)
#'
#' # optimize with espresso algorithm
#' small2_opt <- logicopt(small2[[1]],4,3,mode="espresso")
#'
#' # print the optimized equations
#' print_multi_tt(small2_opt,TRUE,4,3)
#'
#' ######################### EXAMPLE #3 ###############################
#' # load up truth table created from a QCA dataset
#' data(l.represent.1)
#'
#' # read documentation on how truth table was created
#' ?l.represent.1
#'
#' # find the set of minimum solutions that cover QCA dataset (mode="multi-min")
#' # treat unspecified input conditions as don't cares (find_dc=TRUE)
#' # find a exact covering (exact_cover=TRUE)
#' lomm <- logicopt(l.represent.1,n_in=5,n_out=1,find_dc=TRUE,
#' exact_cover=1,mode="multi-min")
#'
#' # print the solutions in equation format
#' print_multi_tt(lomm,TRUE,5,1,QCA=TRUE)
#'
#' ######################### EXAMPLE #4 ###############################
#' # optimize a truth table from Genetic Programming
#' inpath <- system.file("extdata/espresso/robot1_in.esp", package="LogicOpt")
#' robot1 <- logicopt(esp_file=inpath,mode="echo")
#'
#' # unoptimized truth table has 273 rows (256 in ON set and 18 in OFF set)
#' robot1[2]
#'
#' # optimize l.robot1
#' robot1_opt <- logicopt(robot1[[1]],8,3)
#'
#' # optimized results have 13 rows that cover outputs zero, one, and minus
#' robot1_opt[2]
#'
#' # print optimized equations (where each output is 1)
#' print_multi_tt(robot1_opt,TRUE,8,3)
#'
#' ######################### EXAMPLE #5 ###############################
#' # show how to use input_sizes
#'
#' # get vector of number of unique values for each input
#' data(l.partybans.1)
#' pb_in_vals <- num_input_values(l.partybans.1,5)
#' pb_in_vals
#'
#' # optimize with mode=espresso
#' epb <- logicopt(l.partybans.1,5,1,find_dc=TRUE,mode="espresso")
#' epb
#' pb_in_opt_vals <- num_input_values(epb[[1]],5)
#'
#' # note how some input values have been optimized away and are no longer used!
#' pb_in_opt_vals
#'
#' # we need original input sizes to process the optimized truth table
#' qmpb <- logicopt(epb[[1]],5,1,find_dc=FALSE, input_sizes=pb_in_vals,mode="qm")
#' print_multi_tt(epb,TRUE,5,1)
#' print_multi_tt(qmpb,TRUE,5,1)
#'
#' @keywords Espresso Logic Minimization Quine-McKluskey QCA
#' @export
#' @importFrom utils write.table
#
##############################################################
{
##############################################################
# sanity checks
##############################################################
if (esp_file == "") {
if (is.data.frame(in_tt) == FALSE)
stop('Bad input truth table in_tt.\n')
if ((n_in + n_out) != ncol(in_tt))
stop('Number of inputs (',n_in,') + number of outputs (',
n_out,') is not equal to number of in_tt columns (',
ncol(in_tt),').\n')
if (nrow(in_tt) == 0)
stop('in_tt has no rows.\n')
file_name <- "esptemp"
write_esp_file(file_name, input_sizes, in_tt, n_in, n_out, find_dc)
}
else {
if ((find_dc == TRUE) || (n_in > 0) || (n_out > 0) || length(input_sizes) >0)
warning("When esp_file is used, options find_dc, n_in, n_out, and input_sizes are ignored.")
if (! file.exists(esp_file))
stop('File "', esp_file, '" does not exist.\n')
file_name <- esp_file
}
##############################################################
# call espresso
##############################################################
if (exact_cover)
Sys.setenv(ESP_EXACT_COVER=1)
else
Sys.unsetenv("ESP_EXACT_COVER")
ret <- esp_system(mode, file_name, use_system=FALSE)
if ((ret != 0) || (! file.exists("esptemp.out"))) {
unlink("esptemp")
stop('Call to espresso failed.\n')
}
##############################################################
# create truth table from espresso results
##############################################################
esptt <- readLines("esptemp.out")
# get solution sizes from .p meta commands
dot_p <- grep("^.p ", esptt)
p_str <- esptt[dot_p]
p_size <- as.numeric(gsub("\\D", "", p_str))
# get input and output names from esp_file .ilb and .ob
if (esp_file != "") {
dot_ilb <- as.numeric(grep(".ilb ", esptt)[1])
ilb_str <- esptt[dot_ilb]
in_names <- unlist((strsplit(ilb_str,split=" ")))[-1]
dot_ob <- grep(".ob ", esptt)[1]
ob_str <- esptt[dot_ob]
out_names <- unlist((strsplit(ob_str,split=" ")))[-1]
col_names <- c(in_names,out_names)
}
# use names from input truth table
else {
col_names <- colnames(in_tt)[seq(ncol(in_tt))]
}
# ignore espresso meta commands and comments
esptt <- esptt[!grepl("[.#]", esptt)]
esptt <- t(sapply(esptt, function(x) {
unlist(strsplit(x, split=" "))
}))
if ((ncol(esptt) == 0) || (nrow(esptt) == 0)) {
unlink("esptemp")
unlink("esptemp.out")
stop('All terms of input truth table optimized away.\n')
}
rownames(esptt) <- seq(nrow(esptt))
if (length(col_names) == ncol(esptt))
colnames(esptt) <- col_names
else
warning("No input and output names. Will use system generated names."
,call.=FALSE)
##############################################################
# clean up and return results
##############################################################
if (Sys.getenv("LOGOPT_SAVE_TEMP_FILES") == "") {
unlink("esptemp")
unlink("esptemp.out")
}
# return list of truth table and solution sizes
return(list(as.data.frame(esptt),p_size))
}
'write_esp_file' <- function(file_name, input_sizes, in_tt, n_in, n_out, find_dc)
##############################################################
# write an espresso format file from a R truth table
##############################################################
{
espfile <- file(file_name, "w")
cat(".mv", n_in+1,"0", file=espfile)
n_sizes = length(input_sizes)
if (n_sizes > 0) {
if (n_sizes != n_in)
stop('Vector paramater input_sizes has ', n_sizes,
' elements -- it neeeds to have n_in=',
n_in, ' elements.\n')
}
for (j in 1:n_in) {
# if input_sizes specified, use it, otherwise set size must be at least 2 (Boolean)
if (n_sizes > 0) size = input_sizes[j] else size = 2
nval <- length(unique_int(in_tt[j],n_vals=size))
if (nval < 2)
stop('Input ', j, ' must have at least two values. Specify input_sizes.\n')
cat(" -", nval, sep="", file=espfile)
}
cat(" ", n_out, "\n", file=espfile)
for (j in 1:n_in) {
if (n_sizes > 0) size = input_sizes[j] else size = 2
valj <- unique_int(in_tt[j], n_vals=size)
cat('.label var=', j-1, valj,'\n', file=espfile)
}
if (find_dc)
cat(".type fr\n", file=espfile)
else
cat(".type fd\n", file=espfile)
close(espfile)
write.table(in_tt, file=file_name,sep=" ",append=TRUE, row.names=FALSE,
col.names=FALSE, quote = FALSE)
espfile <- file(file_name, "a")
cat(".e\n", file=espfile)
close(espfile)
}
'num_input_values' <- function(tt, n_in)
############################################################################
#' @title Find size of input values
#' @description Find number of unique input values for each input in
#' tt.
#' @param tt a truth table where first n_in columns are inputs
#' @param n_in number of inputs
#' @return returns a vector of number of unique input values for each input
#' @export
############################################################################
{
valv <- NULL
for (j in 1:n_in) {
valj <- length(unique_int(tt[j], strip_dc=TRUE))
valv <- c(valv, valj)
}
return (valv)
}
'unique_int' <- function(col, strip_dc=TRUE, n_vals=0)
########################################################################
########################################################################
# Return a vector of the unique values in the input column 'col'.
# The col contains possible values from an Espresso optimized
# truth table. Don't care values ("-" or "dc") are converted to -1.
# If strip_dc=TRUE, we remove the don't care value from the return
# vector. If n_vals is > 0, the return vector is filled with values
# (v1 .. vn) to make the vector size n_vals.
########################################################################
{
uniq <- unique(col)
uint <- as.data.frame(lapply(uniq, function(x) {
x <- as.character(x)
x[x %in% c("-", "dc")] <- -1
return(as.numeric(x))
}))
vect <- uint[,1]
if (strip_dc)
vect <- vect[vect != -1]
if (n_vals > 0) {
vlen <- length(vect)
if ((n_vals-vlen) > 0)
for (i in 1:(n_vals-vlen))
vect <- c(vect,paste('v',i,sep=''))
}
return (sort(vect))
}
'print_multi_tt' <- function(esp_multi, eqn=FALSE, n_in, n_out, max_sol=50, QCA=FALSE)
############################################################################
#' @title Print logicopt() results
#'
#' @description This function prints the the results from logicopt()
#' in truth table or equation format.
#
#' @return None
#
#' @param esp_multi
#' An R data frame table representing a truth table with 1 or more
#' solutions.
#'
#' @param eqn
#' Print in equation format. Default is FALSE.
#'
#' @param n_in
#' Number of inputs in the esp_multi truth table.
#'
#' @param n_out
#' Number of outputs in the esp_multi truth table.
#'
#' @param max_sol
#' Maximum number of solutions to print. Default is 50.
#'
#' @param QCA
#' Attempt to print out in a QCA like format
#'
#' @examples
#' data(l.partybans.0)
#' tt <- logicopt(l.partybans.0,n_in=5,n_out=1,find_dc=TRUE,mode="multi-full")
#' print_multi_tt(tt,5,1,eqn=TRUE,max_sol=5)
#'
#' @export
############################################################################
{
ett <- esp_multi[[1]]
esize <- esp_multi[[2]]
n_solutions = length(esize)
if (max_sol < n_solutions) {
n_solutions = max_sol
cat("\nPrinting", n_solutions,"of", length(esize), "solutions.\n")
}
first <- 1
for (i in 1:n_solutions) {
if (QCA)
cat("M", i, ": ", sep="")
else
cat("SOLUTION", i,"\n")
last <- esize[i]+first-1
tt <- ett[first:last,]
if (eqn)
cat(tt2eqn(tt,n_in,n_out,QCA),sep="\n")
else
print(tt)
first <- last+1
if (i == max_sol) return;
}
}
'tt2eqn' <- function(tt,n_in,n_out,QCA=FALSE)
############################################################################
#' @title Equations from a Truth Table
#'
#' @description This function generates the ON set equations for a truth table.
#' Inputs are uppercase if they are positive and lowercase for negative.
#
#' @return Vector of equations strings. One for each output.
#
#' @param tt
#' R data frame truth table.
#'
#' @param n_in
#' Number of inputs in the tt.
#'
#' @param n_out
#' Number of outputs in the tt.
#'
#' @param QCA
#' Print in QCA format.
#'
#' @examples
#' data(l.small)
#' tt <- logicopt(l.small,n_in=4,n_out=3)
#' eqn <- tt2eqn(tt[[1]],4,3)
#'
#' @export
############################################################################
{
have_mv <- any(apply(tt,2,function(x) x > 1))
eqn <- ""
tot_eqn <- NULL
for (j in 1:n_out) {
out_nm <- colnames(tt)[n_in+j]
out_on <- tt[tt[out_nm]=="1",]
n_rows <- nrow(out_on)
if (n_rows > 0) {
if (! QCA) eqn <- paste(out_nm,"= ")
for (i in 1:n_rows) {
row <- as.character(t(out_on[i,]))
first_and <- TRUE
for (k in 1:n_in) {
ch <- row[k]
if (ch != "-") {
if (first_and == FALSE)
# eqn <- paste(eqn,sep="")
eqn <- paste(eqn,"*",sep="")
eqn <- paste(eqn,literal(colnames(tt)[k],ch,have_mv),sep="")
first_and <- FALSE
}
}
if ((first_and == FALSE) && (i != n_rows))
eqn <- paste(eqn," + ",sep="")
# eqn <- paste(eqn,"+",sep="")
}
}
if (QCA) eqn <- paste(eqn,"<=>",out_nm)
tot_eqn <- c(tot_eqn,eqn)
eqn <- ""
}
return(tot_eqn)
}
'literal' <- function(name,value,have_mv)
{
if (have_mv)
lit <- paste(name,"{",value,"}", sep="")
else {
if (value == 0)
lit <- tolower(name)
else if (value == 1)
lit <- toupper(name)
}
return (lit)
}
'print_primes_tt' <- function(primes,eqn=FALSE,n_in,n_out)
############################################################################
#' @title Print the Primes from logicopt(mode="primes")
#'
#' @description This function prints the results from logicopt(..,,mode="primes")
#' option.
#
#' @return None
#
#' @param primes
#' An R data frame table generated by logicopt(...,mode="primes").
#'
#' @param eqn
#' Print in equation format. Default is FALSE.
#'
#' @param n_in
#' Number of inputs in the primes truth table.
#'
#' @param n_out
#' Number of outputs in the primes truth table.
#'
#'
#' @examples
#' data(l.small)
#' ptt <- logicopt(l.small,n_in=4,n_out=3,find_dc=TRUE,mode="primes")
#' print_primes_tt(ptt,eqn=TRUE,4,3)
#'
#' @export
############################################################################
{
ptt <- primes[[1]]
psize <- primes[[2]]
if (length(psize) != 3)
stop("Don't have a primes truth table.\n")
first <- 1
cat("\nESSENTIAL PRIMES\n")
if (psize[1] > 0) {
last <- psize[1]+first-1
tt <- ptt[first:last,]
if (eqn)
cat(tt2eqn(tt,n_in,n_out),sep="\n")
else
print(tt)
first <- last+1
}
else
cat(" <empty>\n")
cat("\nPARTIALLY REDUNDANT PRIMES\n")
if (psize[2] > 0) {
last <- psize[2]+first-1
tt <-ptt[first:last,]
if (eqn)
cat(tt2eqn(tt,n_in,n_out),sep="\n")
else
print(tt)
first <- last+1
}
else
cat(" <empty>\n")
cat("\nTOTALLY REDUNDANT PRIMES\n")
if (psize[3] > 0) {
last <- psize[3]+first-1
tt <- ptt[first:last,]
if (eqn)
cat(tt2eqn(tt,n_in,n_out),sep="\n")
else
print(tt)
}
else
cat(" <empty>\n")
}
'esp_system' <- function(mode, file_name, use_system=TRUE)
{
if (use_system) {
if (mode == "qm")
esp_command <- paste('yespresso -srmv -Dqm', file_name,'>esptemp.out')
else if (mode == "primes")
esp_command <- paste('yespresso -srmv -Dprimes', file_name,'>esptemp.out')
else if (mode == "espresso")
esp_command <- paste('yespresso -srmv ', file_name,'>esptemp.out')
else if (mode == "multi-min")
esp_command <- paste('yespresso -srmv -Dmulti-min', file_name,'>esptemp.out')
else if (mode == "multi-full")
esp_command <- paste('yespresso -srmv -Dmulti-full', file_name,'>esptemp.out')
else if (mode == "echo")
esp_command <- paste('yespresso -srmv -Decho', file_name,'>esptemp.out')
else
stop('Mode "', mode, '" not supported.\n', call. = FALSE)
ret = system(esp_command)
}
else {
ret <- esp_R(mode, file_name)
# need to fix return
ret <- 0
}
return(ret)
}
#' @useDynLib LogicOpt esp_main
esp_R <- function(mode, file_name) {
#libpath <- system.file("libs", package="LogicOpt")
#lib <- paste0(libpath,"/LogicOpt",.Platform$dynlib.ex)
#dyn.load(lib)
if (!is.character(mode)) {
stop("mode must be of type character.\n")
}
if ((mode == "qm") ||
(mode == "primes") ||
(mode == "espresso") ||
(mode == "multi-full") ||
(mode == "multi-min") ||
(mode == "echo")) {
result <- .C(esp_main, esp_mode=mode, esp_file=file_name, PACKAGE="LogicOpt")
return(result)
}
else {
stop("Unsupported mode\n")
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.