R/Rxiv.R

In REBayes: Empirical Bayes Estimation and Inference

#' Archive function for auxiliary files for latex documents
#'
#' Creates a tar.gz file with all of the R files needed to recreate the tables
#' and figures that appear in the paper.  Should be considered experimental at
#' this stage.  It presumes that tables are generated with something like the
#' \pkg{Hmisc}  \code{latex} function and included in the latex document with
#' \code{input} commands.  Likewise figures are assumed to be included with
#' \code{includegraphics} and generated by R in pdf format.  This
#' was originally developed to sort out the files for "Empirical Bayesball Remixed".
#' An optional side of effect of the function to create a tar.gz file with the gzipped
#' R files required for the paper.
#'
#' @param fname name of the latex file of the paper sans .tex suffix 
#' @param figures name of the directory with the files for figures
#' @param tables name of the directory with the files for tables
#' @param tar logical flag, if TRUE generate a gzipped tar file of .R files
#'
#' @return a list with the following components
#' \item{Rtables}{a character array with two columns:  .tex files and .R files}
#' \item{Rfigures}{a character array with two columns:  .pdf files and .R files}
#' \item{Rother}{a character vector with other R files required.}
#' \item{Rcached}{a character vector with cached Rda files} 
#'
#' @author R. Koenker
#'
#' @export
#'
#'
Rxiv <- function(fname, figures = "figures", tables = "tables", tar = FALSE){
    path <- c(".", figures, tables)
    Rlist <- list.files(path = path, pattern = "\\.R$", full.names = TRUE)
    Rtab <- system(paste("grep input ", fname, ".tex", sep = ""), intern = TRUE) 
    Rtab <- gsub(".*\\{(.*)\\}.*","\\1", Rtab) # NB { needs to be escaped not ( !aargh
    Rfig <- system(paste("grep includegraphics ", fname, ".tex", sep = ""), intern = TRUE) 
    Rfig <- gsub(".*phics.*\\{(.*)\\}.*","\\1", Rfig) 
    Rfig <- gsub("}", "", Rfig) 
    Rbib <- system(paste("grep bibliograph ", fname, ".tex", sep = ""), intern = TRUE)
    Rbib <- grep("style", Rbib, value = TRUE, invert = TRUE)
    Rbib <- gsub(".*\\{(.*)\\}.*","\\1", Rbib) 
    Rbib <- gsub("$",".bib", unlist(strsplit(Rbib, ",")))

    # Level 1 dependencies
    Rtab <- cbind(Rtab,gsub(paste(tables, "/", sep = ""), "", Rtab))
    dimnames(Rtab)[[2]] <- c("Latex File", "R File")
    for(i in 1:nrow(Rtab)) { # Find .R files for Rtab's
	Rtab[i,2] <- system(paste("grep -l ", Rtab[i,2], " ", tables, "/*.R", sep = ""), intern = TRUE)
    }
    Rfig <- cbind(Rfig,gsub(paste(figures, "/", sep = ""), "", Rfig))
    dimnames(Rfig)[[2]] <- c("PDF File", "R File")
    for(i in 1:nrow(Rfig)) { # Find .R files for Rfig's
	Rfig[i,2] <- system(paste("grep -l ", Rfig[i,2], " ", figures, "/*.R", sep = ""), intern = TRUE)
    }

    Rsources <- function(Rfiles){
    # Given a list of .R files find the "source" dependencies 
	for(i in 1:length(Rfiles)){
	    if(!system(paste("grep source", Rfiles[i]), ignore.stdout = TRUE)){
		sf <- system(paste("grep source", Rfiles[i]), intern = TRUE)
		sf <- gsub("\"", "", gsub('.*(\\".*\\").*', "\\1", sf))
		if(strsplit(Rfiles[i],"/")[[1]][1] == tables)
		    sf <- paste(tables,"/",sf,sep ="")
		if(strsplit(Rfiles[i],"/")[[1]][1] == figures)
		    sf <- paste(figures,"/",sf,sep ="")
		Rfiles <- c(Rfiles, sf) 
	    }
	}
	unique(Rfiles)
    }
    Rloads <- function(Rfiles, Rdas = NULL){
    # Find Level 2 Rda dependencies
	for(i in 1:length(Rfiles)){
	    if(!system(paste("grep load", Rfiles[i]), ignore.stdout = TRUE)){
		sf <- system(paste("grep load", Rfiles[i]), intern = TRUE)
		sf <- gsub("\"", "", gsub('.*(\\".*\\").*', "\\1", sf))
		sf <- paste(strsplit(Rfiles[i],"/")[[1]][1], "/", sf, sep = "")
		Rdas <- c(Rdas, sf) 
	    }
	}
	unique(Rdas)
    }
    RdaR <- function(Rdas, Rlist){ # This is painful, would be easier if all Rda were Rbatched
	x <- gsub(".Rda", ".R", Rdas)
	x <- Rlist[match(x,Rlist)] # matches find the Rbatch files
	Slist <- system(paste("grep -l save ", paste(Rlist, collapse = " ")), intern = TRUE)
	isna <- is.na(x)
	nas <- Rdas[isna]
	for(i in 1:length(nas)){ # For NAs look for a .R file that "saves" them
	    rda <- strsplit(nas[i], "/")[[1]][2]
	    if(!system(paste("grep -l", rda, paste(Slist, collapse = " ")), ignore.stdout = TRUE)){
		sf <- system(paste("grep -l", rda, paste(Slist, collapse = " ")), intern = TRUE)
		if(length(sf) > 1) warning(paste("More than 1 .R file saves", rda))
		x[which(isna)[i]] <- sf[1]
	    }
	}
	unique(x)
    }
    Rall <- Rsources(c(Rtab[,2], Rfig[,2])) # Level 1 .R files
    Rdas <- Rloads(Rall) # Level 1 .Rda files
    rdar <- RdaR(Rdas, Rlist) # .R files for Level 1 .Rda files
    Rall <- unique(c(Rall, rdar)) 
    Rall <- Rsources(Rall)
    rdar <- RdaR(Rloads(rdar), Rlist)
    if(!all(Rsources(rdar) %in% Rall))
	Rall <- Rsources(c(Rall, rdar))
    if(length(Rloads(rdar))) cat("Do more\n")
    Rall <- Rall[!is.na(Rall)]
    Rfiles <- c(Rtab[,2], Rfig[,2], Rall)
    system(paste("tar cz -f ", fname, ".R.tar.gz ", paste(Rfiles, collapse = " "),sep = ""))
    list(Rtables = Rtab, Rfigures = Rfig, Rother = Rall, Rcached = Rdas)
}