R/latex.R

In Reza1317/funcly: Useful Functions in R for All-Purpose Analysis

#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#    https://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# author: Alireza Hosseini, Reza Hosseini

## define a function to add sep
AddSepFcn = function(sep) {

	function(x) {
		return(paste0(x, sep=sep))
	}

}

PlusVec = AddSepFcn('+')
AddVec = AddSepFcn('&')

Example = function() {
	x = c('a', 'b', 'c', 'd')
	PlusVec(x)
}

LatexMatrix = function(y) {
	n1 = dim(y)[1]
	n2 = dim(y)[2]

	cc = NULL
	for (k in 1:n2) {
		cc = paste(cc, "c")
	}

	z = paste("{", cc, "}")

	for (i in 1:n1) {
		for (j in 1:(n2-1)) {
			x = "&"
			z = paste(z, y[i, j], x)
		}
		z = paste(z, y[i, n2], "\\")
	}

	return(z)
}

LatexVector = function(y, sep=',') {

	n = length(y)
	z = "("
	z = paste(z, y[1])

	for (i in 2:n) {
		z = paste(z, sep)
		z = paste(z, y[i])
	}

	z = paste(z, ")")
	return(z)
}

# creates latex table
LatexTableRow = function(y, sep='&') {

	n = length(y)
	z = NULL
	z = paste(z, y[1])

	for (i in 2:n) {
		z = paste(z, sep)
		z = paste(z, y[i])
	}

	return(z)
}


Create_latexTableRow = function(char_vec, sep='&') {

	n = length(char_vec)
	if (n == 1) {
		out = char_vec
	}

	if (n > 1) {
		out = char_vec[1]
		for (i in 2:n) {
			out = paste(out, sep, sep=' ')
			out = paste(out, char_vec[i], sep=' ')
		}
	}
	return(out)
}

# char_vec = c('khar',1,'gaav','asb')
# Create_latexTableRow(char_vec)
WriteTableLine = function(fn, rowName, row, hline=FALSE) {

	line = paste(rowName, '&', row, '\\\\', sep=' ')
	write(line, file=fn, append=TRUE)

	if (hline) {
		write('\\hline', file=fn, append=TRUE)
	}
}


Write_hLine = function(fn) {
	write('\\hline', file=fn, append=TRUE)
}

# Write_hLine(fn)
WriteTableBegin = function(
  	fn,
    caption,
    column_num,
    col_names=rep(' ',column_num),
   	col_names2=NA,
    append=FALSE,
    align=rep('l', column_num),
  	label=NA) {

	write('\\begin{table}[H]', file=fn, append=append)
	caption_text = paste('\\caption{', caption, '}', sep='')
	write(caption_text, file=fn, append=TRUE)

	if (!is.na(label[1])) {
		label_text = paste('\\label{', label, '}', sep='')
		write(label_text, file=fn, append=TRUE)
	}
	#write('\\begin{tabular}',file=fn,append=TRUE)
	#write('\\centering',file=fn,append=TRUE)
	write('\\centering', file=fn, append=TRUE)
	column_format_text = "{|"

	for (i in 1:column_num) {
		column_format_text = paste0(column_format_text, ' ', align[i], ' |')
	}

	column_format_text = paste(column_format_text, '}')
	begin_tabular_text = paste0('\\begin{tabular}', column_format_text)
	write(begin_tabular_text, file=fn, append=TRUE)
	write('\\hline', file=fn, append=TRUE)
	row = Create_latexTableRow(col_names)
	write(paste(row,'\\\\'), file=fn, append=TRUE)

	if (!is.na(col_names2[1])) {
		row2 = Create_latexTableRow(col_names2)
		write(paste(row2,'\\\\'), file=fn, append=TRUE)
	}

	#write('\\midrule',file=fn,append=TRUE)
	write('\\hline', file=fn, append=TRUE)
}

WriteTableEnd = function(fn, hline=FALSE) {

	if (hline) {
		write('\\hline', file=fn, append=TRUE)
	}

	write('\\end{tabular}', file=fn, append=TRUE)
	write('\\end{table}', file=fn, append=TRUE)
}

### latex file creation functions and adding figs etc

## create directories
CreateDirs = function(mainDir, subDirs) {
	for (i in 1:length(subDirs)) {
		dir.create(file.path(mainDir, subDirs[i]), showWarnings = FALSE)
	}
}

## create latex project directories
CreateLatexDirs = function(
    mainDir,
    projName,
	  projectDirs=c('figs', 'tables', 'diagrams')) {

	CreateDirs(mainDir, subDirs=projName)
	mainDir2 = paste(mainDir, '/', projName, sep='')
	CreateDirs(mainDir2, subDirs=projectDirs)
}


## this function creates a latex file skin. ie the main document
LatexSkin = function(
  	mainDir,
    projName,
    skinName='skin.tex',
  	type='article',
    figsPath='figs',
    tablesPath='tables',
  	diagramsPath='diagrams',
    inputs=c('input.tex'),
  	template=paste(mainDir, '/templ_skin1.tex', sep='')) {

	projectDirs = c(figsPath, tablesPath, diagramsPath)
	CreateLatexDirs(mainDir, projName, projectDirs=projectDirs)
	fn = paste(mainDir, '/', projName, '/', skinName, sep='')
	print(fn)

	file.copy(from=template, to=fn, overwrite = TRUE)
	print(template)

	for (i in 1:length(inputs)) {
		inputName = inputs[i]
		fn2 = paste(mainDir, '/', projName, '/', inputName, sep='')
		# create the input file i
		cat(
			'%% started this input via LatexSkin from R \n',
			file=fn2, append=TRUE)
		# add the path to the main skin
		#latex5 = paste('\\input{',inputName,'}\n',sep='')
		#cat(latex5,file=fn,append=TRUE)
	}
}


### this function writes the text in the center for a given latex file
WriteLatexCenter = function(fn, text) {
	#fileConn = file(fn)
	cat('\\begin{center} \n ', file=fn, append=TRUE)
	cat('\\begin{center} \n ', file=fn, append=TRUE)
	cat(paste(text, '\n', sep=''), file=fn, append=TRUE)
	cat('\\end{center} \n ', file=fn, append=TRUE)
}


RemoveStrs = function(s, removeStrings, replace="") {

  for (s1 in removeStrings) {
    s = gsub(s1, replace, s)
  }
  return(s)
}

TestRemoveStrs = function() {
  RemoveStrs("cat_dog.asb", removeStrings=c("cat", "_"))

}

### this function adds a figure with caption and label to a latex file
LatexFig = function(
    latexFn,
    figFn,
    figLabel=NULL,
    figCaption=NULL,
    fromFileName=TRUE,
    scale=0.5) {

	if (fromFileName && is.null(figLabel)) {

    figLabel = RemoveStrs(
        s=figFn,
        removeStrings=c(".png", ".pdf", ".svg", ".jpg", "-"),
        replace="_")

  }

  if (fromFileName && is.null(figCaption)) {

    figCaption = RemoveStrs(
        s=figFn,
        removeStrings=c(".png", ".pdf", ".svg", ".jpg", "_", "-"),
        replace=" ")

  }


  cat('\n \\begin{figure}[H] \n', file=latexFn, append=TRUE)
	cat('\\centering \n', file=latexFn, append=TRUE)
	cat(
      paste('\\includegraphics[scale=', scale, ']{', figFn, '} \n', sep=''),
      file=latexFn,
      append=TRUE)

	if (!is.null(figCaption)) {
		cat(
			paste0('\\caption{', figCaption, '} \n'),
			file=latexFn,
      append=TRUE)
	}

	if (!is.null(figLabel)) {
		cat(paste0('\\label{', figLabel, '} \n'), file=latexFn, append=TRUE)
	}

	cat('\\end{figure} \n', file=latexFn, append=TRUE)
}


SaveFig = function(fn, Plt, format='jpg', ggPlot=FALSE) {

	print(fn)
	if (format == 'pdf' & !ggPlot) {
		pdf(fn)
	} else if (format == 'jpg' & !ggPlot) {
		jpeg(fn)
	} else {
		ggsave(filename=fn)
	}

	Plt()
	dev.off()
}

### save fig and add to input
SaveFigAddLatex = function(
	  figCaption,
    figFn=NULL,
    latexFn,
    Plt,
    figsPath,
	  format='png',
	  addLatexFig=TRUE,
    ggPlot=FALSE) {

	if (is.null(figFn)) {
		figFn = paste(figsPath, gsub(' ',  '_', figCaption), '.', format, sep='')
		print(figFn)
	}

	if (format == 'pdf' & !ggPlot) {
		pdf(figFn)
	} else if (format == 'jpg' & !ggPlot) {
		jpeg(figFn)
	} else if (format == 'png' & !ggPlot) {
		png(figFn)
	} else {
		ggsave(filename=fn)
	}

	Plt()

	figFn0 = figLabel = paste(gsub(' ', '_', figCaption), '.', format, sep='')

	if (addLatexFig) {
		LatexFig(
			  latexFn=latexFn,
        figFn=figFn0,
        figLabel=figLabel,
			  figCaption=figCaption)
	}

	dev.off()
}

AddFrame = function(
   	latexFn='',
    Inner,
    frameTitle='',
    figsPath=NULL,
    Plt=NULL,
	  figCaption=NULL, ...) {

	cat('\n \\begin{frame} \n', file=latexFn, append=TRUE)

	Inner(
		figCaption=figCaption, figFn=NULL, latexFn=latexFn,
		Plt=Plt, figsPath=figsPath, format='png', skipCaption=FALSE,
		skipLabel=FALSE)

	cat('\n \\end{frame} \n', file=latexFn, append=TRUE)
}

AddFrameFig = function(
  	figCaption,
    figFn=NULL,
    latexFn,
    Plt,
    figsPath,
  	format='png') {

  print(figsPath)
	AddFrame(
		latexFn=latexFn, innerFcn=SaveFigAddLatex, frameTitle=figCaption,
		figsPath=figsPath, Plt=Plt, figCaption=figCaption)
}

## custom xtable with seperating lines
xtable2 = function(x, ...) {

	MakeAlignString = function(x) {
	  k = ncol(x)
	  format_str = ifelse(sapply(x, is.numeric), "r", "l")
	  alighnStr = paste0(c("r", format_str), collapse = "|")
	  alighnStr = paste0("|", alighnStr, "|")
	  return(alighnStr)
	}

	return(xtable(x, ..., align=MakeAlignString(x)))
}

Example = function() {

  df = head(iris)
  xtable2(df)

  ## add horizontal lines
  print(xtable2(df), hline.after=1:nrow(xtable2(df)))


}