R/gfile.R

Defines functions pad11 gEffect gHeader gFormat gProcess gD gfile grun outputPDF

##' Create GENOVA control file from gdata object
##'
##' Takes a \code{gdata} object and converts to GENOVA control file
##'
##'
##'

## Simple utility to pad to 11 characters for GENOVA control cards
pad11 <- function(x) {
    size <- nchar(x)
    if(size < 11)
        return(paste0(x, paste(rep(" ", 11 - size), collapse = "")))
    else
        return(x)
}

## Creates "Effect" control cards from gdata object
gEffect <- function(gdata) {
    ## Number of each facet in the record layout
    nfacets <- length(gdata$gspecify)
    prefixes <- c("*", rep("+", nfacets - 1)) # gdata makes starred facet FIRST place
    
    paste(pad11("EFFECT"), prefixes, gdata$gspecify, gdata$sampsizes, gdata$popsizes)
}

## Create "STUDY" and "COMMENT" control cards from gdata object
## Annotates GENOVA names with R data.frame names
gHeader <- function(gdata, header = "GENOVA run generated by R genova package") {
    ## Creates title/header/comments
    title <- paste(pad11("STUDY"), header)
    leftmost <- substr(gdata$gspecify, 1, 1)
    c(title, paste(pad11("COMMENT"), leftmost, "=", names(gdata$gspecify)))
}

gFormat <- function(gdata) paste(pad11("FORMAT"), gdata$formatstr)
    
## Process control cards
gProcess <- function(gdata) c("PROCESS", gdata$process)

## Generate DSTUDY cards
gD <- function(gdata, Ds = NULL) {
    if(is.null(Ds)) {
        Ds <- gdata$sampsizes
    }

    prefixes <- ifelse(gdata$gspecify %in% gdata$object, "$", " ")

    Dchar <- as.character(Ds)
    Dchar[gdata$gspecify %in% gdata$object] <- ""
    c("DSTUDY", 
      paste(pad11("DEFFECT"), prefixes, gdata$gspecify, Dchar),
      "ENDDSTUDY", "FINISH")
}

gfile <- function(gdata, outfile = tempfile(), ...) {
    all <- c(gHeader(gdata, ...),
             gEffect(gdata),
             gFormat(gdata),
             gProcess(gdata),
             gD(gdata))
    write.table(all, outfile, quote = FALSE, sep = "", row.names = F, col.names = F)
    outfile
}

grun <- function(input, output = tempfile(),
                 gcommand = "/home/fortis/bin/genova.sh"
                 ) {
    system2(gcommand, args = c(input, output))
    output
}

outputPDF <- function(input, output = paste0(input, ".pdf")) {
    system(sprintf("enscript %s -r -f Courier8 -a 3- -b '' --output=- | ps2pdf - > %s", input, output))
}
statisfactions/genova documentation built on May 30, 2019, 9:44 a.m.