1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#' 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(), "4ti2-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")
)
}
|
