#' Solve a linear system over the rationals
#'
#' qsolve runs 4ti2's qsolve program to compute the
#' configuration matrix A corresponding to graphical statistical
#' models given by a simplicial complex and levels on the nodes.
#'
#' @param mat The A matrix (see the 4ti2 documentation or examples)
#' @param rel A vector of "<" or ">" relations
#' @param sign The signs of the individual
#' @param dir Directory to place the files in, without an ending /
#' @param quiet If FALSE, messages the 4ti2 output
#' @param shell Messages the shell code used to do the computation
#' @param ... Additional arguments to pass to the function
#' @return The configuration matrix of the model provided
#' @export
#' @examples
#'
#' if (has_4ti2()) {
#'
#' # x + y > 0
#' # x + y < 0
#'
#' mat <- rbind(
#' c( 1, 1),
#' c( 1, 1)
#' )
#' rel <- c(">", "<")
#' sign <- c(0, 0)
#'
#' qsolve(mat, rel, sign, p = "arb")
#' qsolve(mat, rel, sign, p = "arb", quiet = FALSE)
#' qsolve(mat, rel, sign, p = "arb", shell = TRUE)
#'
#' }
#'
#'
qsolve <- function(mat, rel, sign,
dir = tempdir(), quiet = TRUE, shell = FALSE, ...
){
if (!has_4ti2()) missing_4ti2_stop()
## compute other args
opts <- as.list(match.call(expand.dots = FALSE))[["..."]]
if("rhs" %in% names(opts)) stop("qsolve only solve homogeneous systems (b = 0).")
if(is.null(opts)){
opts <- ""
} else {
opts <- paste0("-", names(opts), "", unlist(opts))
opts <- paste(opts, collapse = " ")
}
## create and move to dir
####################################
## make dir to put 4ti2 files in (within the tempdir) timestamped
dir.create(scratch_dir <- file.path(dir, time_stamp()))
## switch to temporary directory
user_working_directory <- getwd()
setwd(scratch_dir); on.exit(setwd(user_working_directory), add = TRUE)
## arg check
####################################
if(!missing(mat) && !all(is.wholenumber(mat)))
stop("The entries of mat must all be integers.")
if(!missing(sign) && !all(is.wholenumber(sign)))
stop("The entries of sign must all be integers.")
if(!all(rel %in% c("<", ">")))
stop("rel must be a vector of \"<\"'s or \">\"'s.")
## write files
####################################
if(!missing(mat)) write.latte(mat, "system.mat")
write.latte(t(rel), "system.rel")
if(!missing(sign)) write.latte(t(sign), "system.sign")
## move to dir and run 4it2 qsolve
####################################
## run 4ti2
if (is_mac() || is_unix()) {
system2(
file.path(get_4ti2_path(), "qsolve"),
paste(opts, file.path(scratch_dir, "system")),
stdout = "qsolve_out",
stderr = "qsolve_err"
)
# generate shell code
shell_code <- glue(
"{file.path(get_4ti2_path(), 'qsolve')} {paste(opts, file.path(scratch_dir, 'system'))} > qsolve_out 2> qsolve_err"
)
if(shell) message(shell_code)
} else if (is_win()) {
matFile <- file.path(scratch_dir, "system")
matFile <- chartr("\\", "/", matFile)
matFile <- str_c("/cygdrive/c", str_sub(matFile, 3))
system2(
"cmd.exe",
glue("/c env.exe {file.path(get_4ti2_path(), 'qsolve')} {opts} {matFile}"),
stdout = "qsolve_out",
stderr = "qsolve_err"
)
# generate shell code
shell_code <- glue(
"cmd.exe /c env.exe {file.path(get_4ti2_path(), 'qsolve')} {opts} {matFile} > qsolve_out 2> qsolve_err"
)
if(shell) message(shell_code)
}
## print output, if desired
if(!quiet) message(paste(readLines("qsolve_out"), "\n"))
std_err <- readLines("qsolve_err")
if(any(std_err != "")) warning(str_c(std_err, collapse = "\n"), call. = FALSE)
## read and return
list(
qhom = read.latte("system.qhom"),
qfree = read.latte("system.qfree")
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.