75 lines
1.9 KiB
R
75 lines
1.9 KiB
R
|
|
||
|
|
make_infile <- function(dat, espname = "infile.esp", copy = FALSE, ...) {
|
||
|
|
|
||
|
|
on.exit(suppressWarnings(sink()))
|
||
|
|
|
||
|
|
dots <- list(...)
|
||
|
|
# number of outcomes
|
||
|
|
no <- ifelse(is.null(dots$no), 1, dots$no)
|
||
|
|
|
||
|
|
dat <- as.data.frame(dat)
|
||
|
|
inputs <- seq(ncol(dat) - no)
|
||
|
|
outputs <- setdiff(seq(ncol(dat)), inputs)
|
||
|
|
iname <- names(dat)[inputs]
|
||
|
|
oname <- names(dat)[outputs]
|
||
|
|
outcome <- dat[, outputs, drop = FALSE]
|
||
|
|
outcome[outcome == 0] <- "-"
|
||
|
|
|
||
|
|
# espname <- paste("infile", i, ncols, nrows, "esp", sep = ".")
|
||
|
|
|
||
|
|
sink(espname)
|
||
|
|
# on.exit(sink())
|
||
|
|
cat(paste(".i", length(inputs), "\n"))
|
||
|
|
cat(paste(".o", no, "\n"))
|
||
|
|
cat(paste(".ilb", paste(iname, collapse = " "), "\n"))
|
||
|
|
cat(paste(".ob", paste(oname, collapse = " "), "\n"))
|
||
|
|
cat(
|
||
|
|
paste(
|
||
|
|
paste(
|
||
|
|
apply(dat[, inputs], 1, paste, collapse = ""),
|
||
|
|
apply(outcome, 1, paste, collapse = ""),
|
||
|
|
sep = " "
|
||
|
|
),
|
||
|
|
collapse = "\n"
|
||
|
|
)
|
||
|
|
)
|
||
|
|
cat("\n.e\n")
|
||
|
|
sink()
|
||
|
|
|
||
|
|
|
||
|
|
lo <- LogicOpt::logicopt(esp_file = espname, mode = "echo")[[1]]
|
||
|
|
outcome <- lo[, outputs, drop = FALSE]
|
||
|
|
outcome[] <- lapply(
|
||
|
|
outcome,
|
||
|
|
function(x) {
|
||
|
|
admisc::recode(x, "1=1; 0=-; else=0")
|
||
|
|
}
|
||
|
|
)
|
||
|
|
|
||
|
|
sink(espname)
|
||
|
|
cat(paste(".i", length(inputs), "\n"))
|
||
|
|
cat(paste(".o", no, "\n"))
|
||
|
|
cat(paste(".ilb", paste(iname, collapse = " "), "\n"))
|
||
|
|
cat(paste(".ob", paste(oname, collapse = " "), "\n"))
|
||
|
|
cat(
|
||
|
|
paste(
|
||
|
|
paste(
|
||
|
|
apply(lo[, inputs], 1, paste, collapse = ""),
|
||
|
|
apply(outcome, 1, paste, collapse = ""),
|
||
|
|
sep = " "
|
||
|
|
),
|
||
|
|
collapse = "\n"
|
||
|
|
)
|
||
|
|
)
|
||
|
|
cat("\n.e\n")
|
||
|
|
sink()
|
||
|
|
|
||
|
|
if (copy) {
|
||
|
|
i <- dots$i
|
||
|
|
if (is.null(i)) {
|
||
|
|
i <- get("i", envir = parent.frame())
|
||
|
|
}
|
||
|
|
file.copy(espname, paste("infile", i, ncol(dat), nrow(dat), "esp", sep = "."))
|
||
|
|
}
|
||
|
|
}
|