Nothing
R/write.rtf.R
In connect3: A Tool for Reproducible Research by Converting 'LaTeX' Files Generated by R Sweave to Rich Text Format Files
Defines functions
write.rtf
Documented in
write.rtf
#' @title A function for writing Rich Text Format (rtf) files
#' @description \code{write.rtf} converts LaTeX files (with extension .tex) generated by R Sweave using package 'knitr' to Rich Text Format (RTF) files.
#' Features include: 1) conversion of R syntax highlighting; 2) conversion of tables generated by \code{Hmisc::describe}, \code{Hmisc::summary}, and
#' \code{Hmisc::latex}; 3) conversion of mathematical equations; 4) conversion of graphics; 5) conversion of itemize and enumerate; 6) conversion of references.
#' @param tex is the tex value returned by \code{read.latex}.
#' @param path is the path value returned by \code{read.latex}.
#' @param name is the name of the output Rich Text Format file.
#' @param outputlocation is the location where the Rich Text Format file is to be saved. The default location is the same as path.
#' @export
#' @details For files with graphics, dev must be set to 'png' in 'knitr' chunk options for \code{write.rtf} to run properly.
#' @return \code{write.rtf} returns a file in Rich Text Format (rtf).
#' @seealso \code{\link{read.latex}}
#' @references Yihui Xie (2015). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.10.5.
#' @references Frank E Harrell Jr, with contributions from Charles Dupont and many others. (2014). Hmisc: Harrell Miscellaneous. R package version 3.14-4. http://CRAN.R-project.org/package=Hmisc
#' @examples
#' ##Example 1
#' #Read a sample LaTeX file
#' file<-'connect3-minimal.tex'
#' filepath<-paste(sub("examples/.*","\\1",
#' system.file("examples","connect3-minimal.tex",package="connect3")),
#' "examples", sep='')
#' obj<-read.latex(file, filepath)
#' obj
#'
#' #Convert a LaTeX file to a Rich Text Format file
#' tex<-obj$tex
#' path<-obj$path
#' name<-'connect3-minimal'
#' outputlocation<-gsub('\\\\','/',tempdir())
#' write.rtf(tex,path,name,outputlocation)
#'
#' ##Example 2
#' ## Step 1: Download an R Sweave file using 'knitr' from:
#' ## 'https://github.com/yihui/knitr/blob/master/inst/examples/knitr-minimal.Rnw'
#' ## Step 2: Save it as 'knitr-minimal.Rnw' in a folder such: 'C:/Users/Desktop/tmp'.
#' ## Change r code chunck options
#' ## "<<boring-plots, fig.width=4, fig.height=4, out.width='.4\\linewidth'>>="
#' ## to
#' ## "<<boring-plots, fig.width=3, fig.height=3, out.width='.4\\linewidth', dev='png'>>=".
#' ## Step 3: Click Compile PDF in RStudio
#' ## Step 4: Read 'knitr-minimal.tex' file in the folder using function read.latex
#' # file<-'knitr-minimal.tex'
#' # filepath<-'C:/Users/Desktop/tmp'
#' # obj<-read.latex(file, filepath)
#' # obj
#' ## Step 5: Converts 'knitr-minimal.tex' file to 'knitr-minimal.rtf' file using function write.rtf
#' # tex<-obj$tex
#' # path<-obj$path
#' # name<-'knitr-minimal'
#' # write.rtf(tex,path,name,outputlocation)
write.rtf<-function(tex,path,name,outputlocation=path){
#Part 1. Preprocessing Functions
#Function Set1: countCharOccurrences, trim, trim2
#countCharOccurrences: count character occurrences
countCharOccurrences <- function(char, s){
s2 <- gsub(char,"",s, fixed=T)
return (nchar(s) - nchar(s2))
}
#trim, trim2: trim leading and trailing space
trim <- function (x){
gsub("^\\s+|\\s+$", "", x)
}
trim2 <- function (x){
gsub("^Connect3END+|Connect3BEGIN+$", "", x)
}
#Part 1. Preprocessing Functions
#Function Set2: mathsymbol and mathmode
#mathsymbol: convert LaTeX command to unicodes
mathsymbol<-function(x){
#1 Math Operators
x<-gsub("\\ne","\\u8800*",x, fixed=T)
x<-gsub("\\times","\\u215*",x, fixed=T)
x<-gsub("\\leq","\\u8804*",x, fixed=T)
x<-gsub("\\geq","\\u8805*",x, fixed=T)
x<-gsub("\\leq","\\u8804*",x, fixed=T)
x<-gsub("\\ll","\\u8810*",x, fixed=T)
x<-gsub("\\gg","\\u8811*",x, fixed=T)
#2 Greek letters
x<-gsub("\\Alpha","\\u0913\\3",x, fixed=T)
x<-gsub("\\Beta","\\u0914\\3",x, fixed=T)
x<-gsub("\\Gamma","\\u0915\\3",x, fixed=T)
x<-gsub("\\Delta","\\u0916\\3",x, fixed=T)
x<-gsub("\\Epsilon","\\u0917\\3",x, fixed=T)
x<-gsub("\\Zeta","\\u0918\\3",x, fixed=T)
x<-gsub("\\Eta","\\u0919\\3",x, fixed=T)
x<-gsub("\\Theta","\\u0920\\3",x, fixed=T)
x<-gsub("\\Iota","\\u0921\\3",x, fixed=T)
x<-gsub("\\Kappa","\\u0922\\3",x, fixed=T)
x<-gsub("\\Lambda","\\u0923\\3",x, fixed=T)
x<-gsub("\\Mu","\\u0924\\3",x, fixed=T)
x<-gsub("\\Nu","\\u0925\\3",x, fixed=T)
x<-gsub("\\Xi","\\u0926\\3",x, fixed=T)
x<-gsub("\\Omicron","\\u0927\\3",x, fixed=T)
x<-gsub("\\Pi","\\u0928\\3",x, fixed=T)
x<-gsub("\\Rho","\\u0929\\3",x, fixed=T)
x<-gsub("\\Sigma","\\u0931\\3",x, fixed=T)
x<-gsub("\\Tau","\\u0932\\3",x, fixed=T)
x<-gsub("\\Upsilon","\\u0933\\3",x, fixed=T)
x<-gsub("\\Phi","\\u0934\\3",x, fixed=T)
x<-gsub("\\Chi","\\u0935\\3",x, fixed=T)
x<-gsub("\\Psi","\\u0936\\3",x, fixed=T)
x<-gsub("\\Omega","\\u0937\\3",x, fixed=T)
x<-gsub("\\alpha","\\u0945\\3",x, fixed=T)
x<-gsub("\\beta","\\u0946\\3",x, fixed=T)
x<-gsub("\\gamma","\\u0947\\3",x, fixed=T)
x<-gsub("\\delta","\\u0948\\3",x, fixed=T)
x<-gsub("\\epsilon","\\u0949\\3",x, fixed=T)
x<-gsub("\\zeta","\\u0950\\3",x, fixed=T)
x<-gsub("\\eta","\\u0951\\3",x, fixed=T)
x<-gsub("\\theta","\\u0952\\3",x, fixed=T)
x<-gsub("\\iota","\\u0953\\3",x, fixed=T)
x<-gsub("\\kappa","\\u0954\\3",x, fixed=T)
x<-gsub("\\lambda","\\u0955\\3",x, fixed=T)
x<-gsub("\\mu","\\u0956\\3",x, fixed=T)
x<-gsub("\\nu","\\u0957\\3",x, fixed=T)
x<-gsub("\\xi","\\u0958\\3",x, fixed=T)
x<-gsub("\\omicron","\\u0959\\3",x, fixed=T)
x<-gsub("\\pi","\\u0960\\3",x, fixed=T)
x<-gsub("\\rho","\\u0961\\3",x, fixed=T)
x<-gsub("\\sigmaf","\\u0962\\3",x, fixed=T)
x<-gsub("\\sigma","\\u0963\\3",x, fixed=T)
x<-gsub("\\tau","\\u0964\\3",x, fixed=T)
x<-gsub("\\upsilon","\\u0965\\3",x, fixed=T)
x<-gsub("\\phi","\\u0966\\3",x, fixed=T)
x<-gsub("\\chi","\\u0967\\3",x, fixed=T)
x<-gsub("\\psi","\\u0968\\3",x, fixed=T)
x<-gsub("\\omega","\\u0969\\3",x, fixed=T)
x
}
#mathsymbol: convert LaTeX math command to rtf math command
mathmode<-function(x){
m<-sub(".*?\\$(.*?)\\$.*", "\\1", x)
m.o<-paste('$', m, '$', sep='')
m<-mathsymbol(m)
#mode 1
m.o2<-m
m.o2<-unlist(strsplit(m.o2, "\\^\\s*\\{[^\\}*]\\}\\s*\\_\\s*\\{[^\\}*]\\}"))
m.diff<-m
for (i in 1:length(m.o2)){
m.diff<-sub(m.o2[i], '', m.diff, fixed=T)
}
if (m.diff!=''){
m.diff<-paste('^',unlist(strsplit(m.diff, "\\^"))[-1], sep='')
for (i in 1:length(m.diff)){
df1<-sub("^.*\\^\\s*\\{(.*?)\\}\\s*\\_\\s*\\{.*$", "\\1", m.diff[i])
df2<-sub("^.*\\_\\s*\\{(.*?)\\}.*$", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\up({\\fs13 ", df1, ',',df2, "})",sep=''), m, fixed=T)
}
}
#mode 2
m.o3<-m
m.o3<-unlist(strsplit(m.o3, "\\^\\s*\\{[^\\}*]\\}"))
m.diff<-m
for (i in 1:length(m.o3)){
m.diff<-sub(m.o3[i], '', m.diff, fixed=T)
}
if (m.diff!=''){
m.diff<-paste('^',unlist(strsplit(m.diff, "\\^"))[-1], sep='')
for (i in 1:length(m.diff)){
df3<-sub("^.*\\^\\s*\\{(.*?)\\}", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\up4({\\fs13 ", df3, "})",sep=''), m, fixed=T)
}
}
#mode 3
m.o4<-m
m.o4<-unlist(strsplit(m.o4, "\\_\\{(.*?)\\}"))
m.diff<-m
for (i in 1:length(m.o4)){
m.diff<-sub(m.o4[i], '', m.diff, fixed=T)
}
if (m.diff!='' & gregexpr(pattern =',',m.diff, fixed=T)[[1]][1]>0){
m.diff<-paste('_',unlist(strsplit(m.diff, "\\_"))[-1], sep='')
for (i in 1:length(m.diff)){
df4<-sub("^.*\\_\\s*\\{(.*?)\\,.*$", "\\1", m.diff[i])
df5<-sub("^.*\\,(.*?)\\}.*$", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\do4({\\fs13 ", df4, '\\\\,',df5, "})",sep=''), m, fixed=T)
}
}
if (m.diff!='' & gregexpr(pattern =',',m.diff, fixed=T)[[1]][1]<0){
m.diff<-paste('_',unlist(strsplit(m.diff, "\\_"))[-1], sep='')
for (i in 1:length(m.diff)){
m.diff2<-sub("^.*\\_\\{(.*?)\\}.*$", "\\1", m.diff)
m<-sub(m.diff[i], paste("\\\\s\\\\do4({\\fs13 ", m.diff2[i], "})",sep=''), m, fixed=T)
}
}
#end of modes
m<-gsub("\\,\\s+P", "\\, P", m)
m<-gsub(" \\\\s\\\\up4({\\fs13", "\\\\s\\\\up4({\\fs13", m, fixed=T)
m<-paste('{{\\field{\\*\\fldinst{ EQ ', m, ' }}{\\fldrslt }}}', sep='')
x<-sub(m.o, m, x, fixed=T)
x
}
#Part 1. Preprocessing Functions
#Function Set3: Command dictionary (convert LaTeX command to RTF command)
#General command
comdictionary<-data.frame(latex='\\textbf', rtfb='\\b ', rtfe=' \\b0 ')
comdictionary<-rbind(comdictionary, data.frame(latex='\\textit', rtfb='\\i ', rtfe='\\i0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\section', rtfb='\\pard \\insrsid \\line \\par \\b ',rtfe='\\pard \\insrsid \\par \\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\subsection', rtfb='\\pard \\insrsid \\line \\par \\b ',rtfe='\\pard \\insrsid \\par \\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\emph', rtfb='\\b ', rtfe='\\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\title', rtfb='\\pard\\qc\\b\\fs32 ', rtfe='\\qc0\\b0\\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\author', rtfb='\\pard\\qc\\fs24', rtfe='\\qc0\\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\url', rtfb='{\\field{\\*\\fldinst HYPERLINK "', rtfe='"}{\\fldrslt }}'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\label', rtfb='\\v ', rtfe='\\v0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\ref', rtfb='\\v ', rtfe='\\v0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\caption', rtfb='\\pard\\b Figure: \\b0 ', rtfe='\\par \\pard \\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\underline', rtfb='{\\ul ', rtfe='}'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\bibitem', rtfb='\\v ', rtfe='\\v0'))
#Math related command
comdictionary<-rbind(comdictionary, data.frame(latex='\\textrm', rtfb='\\i ', rtfe='\\i0'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\bar', rtfb='\\u563 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\hat', rtfb='\\u375 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\acute', rtfb='\\u563 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\dot', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\breve', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\check', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\grave', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\vec', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\ddot', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\tilde', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt', rtfb='\\\\R(, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt[3]', rtfb='\\R(3, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt[4]', rtfb='\\R(4, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac', rtfb='\\frac1{', rtfe='}\\frac2'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac1', rtfb='\\\\F(', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac2', rtfb=',', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\textsuperscript', rtfb='{\\up6 ', rtfe=' }'))
comdictionary$latex<-as.character(comdictionary$latex)
comdictionary$rtfb<-as.character(comdictionary$rtfb)
comdictionary$rtfe<-as.character(comdictionary$rtfe)
commanddictionary<-function(x, n){
parentheses.l<-paste(comdictionary$latex[n], '{', sep='')
parentheses.r<-'}'
if (grepl(parentheses.l, x, fixed=T)){
target<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
target.r<-unlist(strsplit(target, "}", fixed=T))
n.rp<-countCharOccurrences("{", target.r)
n.rp1<-rep(NA, length(n.rp))
for (i in 1:length(n.rp)){
n.rp1[i]<-sum(n.rp[1:i])
}
n.rp2<-1:length(n.rp)
location<-which(n.rp2>n.rp1)[1]
parentheses.m<-paste(unlist(strsplit(target, "}", fixed=T))[1:location], collapse='}')
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste(comdictionary$rtfb[n],parentheses.m, comdictionary$rtfe[n],sep='')
x<-sub(latex.c, rtf.c, x, fixed=T)
}
x
}
#Part 1. Preprocessing Functions
#Function Set4: definecolor and newcommandcolor (functions to extract color information of R code Chuncks)
#Define color function
definecolor<-function(x){
colorname<-sub(".*?\\\\definecolor\\{(.*?)\\}.*", "\\1", x)
colorvalue<-sub(".*?rgb\\}\\{(.*?)\\}.*", "\\1", x)
colorvalue1<-round(as.numeric(sub(",.*", "\\1", colorvalue))*255, 0)
colorvalue2<-round(as.numeric(sub(".*?,(.*?),.*", "\\1", colorvalue))*255, 0)
colorvalue3<-round(as.numeric(sub(".*?,(.*?)$", "\\1", colorvalue))*255, 0)
color<-paste("\\red", colorvalue1, "\\green", colorvalue2, "\\blue", colorvalue3, sep='')
font<-NA
list(colorname, color, font)
}
tex.definecolor<-tex
n<-countCharOccurrences("definecolor", tex.definecolor)/nchar("definecolor")
#Recursive loop
if (n!=0){
definecolor.data<-matrix(data=NA, nrow=n, ncol=3)
for (i in 1:n){
definecolor1<-paste("\\definecolor{",sub(".*?\\\\definecolor\\{(.*?)\\}Connect3END.*", "\\1", tex.definecolor), '}',sep='')
tex.definecolor<-sub(definecolor1, '', tex.definecolor, fixed=T)
x<-definecolor1
color1<-definecolor(x)
definecolor.data[i,]<-c(color1[[1]][1],color1[[2]][1],color1[[3]][1])
}
definecolor.data<-as.data.frame(definecolor.data)
names(definecolor.data)<-c('name', 'color', 'font')
}
#newcommandcolor function
newcommandcolor<-function(x){
colorname<-sub(".*?\\\\newcommand\\{(.*?)\\}.*", "\\1", x)
colorvalue<-sub(".*?rgb\\]\\{(.*?)\\}.*", "\\1", x)
colorvalue1<-round(as.numeric(sub(",.*", "\\1", colorvalue))*255, 0)
colorvalue2<-round(as.numeric(sub(".*?,(.*?),.*", "\\1", colorvalue))*255, 0)
colorvalue3<-round(as.numeric(sub(".*?,(.*?)$", "\\1", colorvalue))*255, 0)
color<-paste("\\red", colorvalue1, "\\green", colorvalue2, "\\blue", colorvalue3, sep='')
font<-sub(".*?\\}\\{(.*?)\\{#.*", "\\1", x)
if (font==x){
font<-NA
}
list(colorname, color, font)
}
tex.newcommandcolor<-tex
n<-countCharOccurrences("textcolor", tex.newcommandcolor)/nchar("textcolor")
#Recursive loop
if (n!=0){
commandcolor.data<-matrix(data=NA, nrow=n, ncol=3)
for (i in 1:n){
newcommandcolor1<-paste("\\newcommand{", sub(".*?\\\\newcommand\\{(.*?)\\}\\}%.*", "\\1", tex.newcommandcolor), "}}", sep='')
tex.newcommandcolor<-sub(newcommandcolor1, '', tex.newcommandcolor, fixed=T)
x<-newcommandcolor1
color1<-newcommandcolor(x)
color1
commandcolor.data[i,]<-c(color1[[1]][1],color1[[2]][1],color1[[3]][1])
}
commandcolor.data<-as.data.frame(commandcolor.data)
names(commandcolor.data)<-c('name', 'color', 'font')
}
default.data<-data.frame(name=replicate(16,'default'),
color=c('\\red0\\green0\\blue0',
'\\red0\\green0\\blue255',
'\\red0\\green255\\blue255',
'\\red0\\green255\\blue0',
'\\red255\\green0\\blue255',
'\\red255\\green0\\blue0',
'\\red255\\green255\\blue0',
'\\red255\\green255\\blue255',
'\\red0\\green0\\blue128',
'\\red0\\green128\\blue128',
'\\red0\\green128\\blue0',
'\\red128\\green0\\blue128',
'\\red128\\green0\\blue0',
'\\red128\\green128\\blue0',
'\\red128\\green128\\blue128',
'\\red192\\green192\\blue192'),
font=replicate(16,NA))
color<-rbind(default.data,definecolor.data, commandcolor.data)
color.unique<-data.frame(color=unique(color$color))
color.unique$rtfcolororder<-paste('\\cf', seq(2, nrow(color.unique)+1), ' ',sep='')
rtfcolorcode<-paste('{\\colortbl;', paste(color.unique$color, collapse=';'), ';}')
color<-merge(color, color.unique, all.x=T, by='color', sort=F)
color<-color[!duplicated(color),]
#Part 1. Preprocessing Functions
#Function Set5: rtfrow.color, rtfrow.verbatim0, kframeblock, knitrfig, knitoutrblock
#rtfrow.color: Function to convert color text of R code chuncks
rtfrow.color<-function(y){
x<-sub(".*?\\\\begin\\{alltt\\}(.*?)\\\\end\\{alltt\\}.*", "\\1", y)
x<-trim(x)
x<-trim2(x)
clcolorsub<-function(x, n){
parentheses.l<-paste(trim(color$name[n]), '{', sep='')
parentheses.r<-'}'
parentheses.m<-sub(paste(".*?", paste(trim(color$name[n]), '\\{', sep=''), "(.*?)", '\\}', ".*", sep=''), "\\1", x)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste(color$rtfcolororder[n],parentheses.m, sep='' )
x<-sub(latex.c, rtf.c, x, fixed=T)
x
}
n1<-NROW(color)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(trim(color$name[n]), x)/(nchar(trim(color$name[n]))-1)
for (j in 1:n2){
x<-clcolorsub(x, n)
}
}
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='shadecolor'][1])],4,5))
x<-gsub("Connect3BEGIN",paste("{\\trowd \\clcbpat", shade.n, "\\cellx9500{\\pard\\intbl\\ql{", sep=''), x, fixed=T)
x<-gsub("Connect3END", "}\\cell}\\row}",x, fixed=T)
x<-gsub("$","\\u036\\0",x, fixed=T)
y<-sub(paste("\\begin{alltt}", sub(".*?\\\\begin\\{alltt\\}(.*?)\\\\end\\{alltt\\}.*", "\\1", y), "\\end{alltt}", sep=''),x, y, fixed=T)
y
}
#rtfrow.verbatim0: function to convert verbatim text
rtfrow.verbatim0<-function(shade.n, verbatim.color){
function(y){
x<-sub(".*?\\\\begin\\{verbatim\\}(.*?)\\\\end\\{verbatim\\}.*", "\\1", y)
x<-trim(x)
x<-trim2(x)
table.ncol<-countCharOccurrences('+', sub(".*?Connect3BEGIN ## \\+(.*?)Connect3END.*", "\\1", x))
cell.width<-round(9500/table.ncol,0)
n.plus<-countCharOccurrences('Connect3BEGIN ## +', x)/18
for (j in 1:n.plus){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.shade<-paste("\\clcbpat", shade.n, '\\cell',sep='')
row.top<-gsub('\\cell', cell.shade, row.top, fixed=T)
x<-sub('Connect3BEGIN ## +', paste(row.top, '{\\pard\\intbl\\ql{## +', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('-+-', paste('-+}\\cell}{\\pard\\intbl\\ql{-', sep=''),x,fixed=T)
}
x<-sub('-+Connect3END', paste('-+}\\cell}\\row}', sep=''),x,fixed=T)
}
n.vertical<-countCharOccurrences('Connect3BEGIN ## |', x)/18
for (j in 1:n.vertical){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.shade<-paste("\\clcbpat", shade.n, '\\cell',sep='')
row.top<-gsub('\\cell', cell.shade, row.top, fixed=T)
x<-sub('Connect3BEGIN ## |', paste(row.top, '{\\pard\\intbl\\ql{##', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('|', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub('|Connect3END', paste('}\\cell}\\row}', sep=''),x,fixed=T)
}
x<-gsub("Connect3BEGIN", paste("{\\trowd \\clcbpat", shade.n, "\\cellx9500{\\pard\\intbl\\ql { ", verbatim.color,sep=''), x, fixed=T)
x<-gsub("Connect3END", "}\\cell}\\row}",x, fixed=T)
x<-gsub("$","\\u036\\0",x, fixed=T)
y<-sub(paste("\\begin{verbatim}", sub(".*?\\\\begin\\{verbatim\\}(.*?)\\\\end\\{verbatim\\}.*", "\\1", y), "\\end{verbatim}", sep=''), x, y, fixed=T)
y
}
}
#kframeblock, knitrfig, knitoutrblock: functions to convert R chunck blocks and figures
kframeblock<-function(x){
rtf.content<-sub(".*?\\\\begin\\{kframe\\}(.*?)\\\\end\\{kframe\\}.*", "\\1", x)
rtf.content<-gsub("Connect3END|Connect3BEGIN", "",rtf.content )
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd", rtf.content)
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
rtf.content
}
knitrfig<-function(y){
path<-sub("\\\\\\\\", "//", path)
figure.name<-sub(".*?\\{figure/(.*?)\\}.*", "\\1", y)
figure.path<-paste(path, "/figure/",figure.name, ".png", sep='')
rtf.figure<-paste('{\\field\\fldedit{\\*\\fldinst { INCLUDEPICTURE \\\\d', figure.path, '\\\\* MERGEFORMATINET }}{\\fldrslt { }}}', sep='')
rtf.figure
}
knitoutrblock<-function(x){
x.o<-x
n<-countCharOccurrences("begin{kframe}", tex)/13
rtf.content<-rep(NA, n)
for (i in 1:n){
rtf.content[i]<-paste(kframeblock(x),"\\pard \\par")
block1.o<-paste("\\begin{kframe}", sub(".*?\\\\begin\\{kframe\\}(.*?)\\\\end\\{kframe\\}.*", "\\1", x),"\\end{kframe}",sep='')
x<-sub(block1.o, '', x, fixed=T)
x.o<-sub(block1.o,rtf.content[i], x.o, fixed=T)
}
n<-countCharOccurrences("includegraphics", x)/15
rtf.fig<-rep(NA, n)
y<-x.o
if (n!=0){
for (i in 1:n){
rtf.fig[i]<-paste(knitrfig(y), "\\pard \\par")
block1.o<-paste("\\includegraphics", sub(".*?includegraphics(.*?)\\}.*", "\\1", y),"}",sep='')
y<-sub(block1.o, '', y, fixed=T)
x.o<-sub(block1.o,rtf.fig[i], x.o, fixed=T)
}
}
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd",x.o )
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
rtf.content<-sub(".*?\\{\\\\trowd", "\\\\pard \\\\par \\{\\\\trowd", rtf.content)
rtf.content
}
#Part 1. Preprocessing Functions
#Function Set6: inputtable.describe, inputtable.summary (functions to Hmisc latex generated tables)
#inputtable.describe: function to convert Hmisc describe
inputtable.describe<-function(x){
#Read table input R
path<-sub("\\\\\\\\", "//", path)
table.name<-sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content)
table.path<-paste(path, "/",table.name, ".tex", sep='')
file<-table.path
tex<-read.latex(file,path)$tex
n<-countCharOccurrences("begin{picture}", tex)/14
for (i in 1:n){
parentheses.l<-'\\setlength'
parentheses.r<-'\\end{picture}'
parentheses.m<-sub(".*?\\\\setlength(.*?)\\\\end\\{picture\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
tex<-sub(latex.c, '', tex, fixed=T)
tex
}
n<-countCharOccurrences("textbf", tex)/6
for (i in 1:n){
parentheses.l<-'\\textbf{'
parentheses.r<-'}'
parentheses.m<-sub(".*?\\\\textbf\\{(.*?)\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste('\\b ',parentheses.m, ' \\b0 ',sep='' )
tex<-sub(latex.c, rtf.c, tex, fixed=T)
tex
}
n<-countCharOccurrences("begin{center}", tex)/13
for (i in 1:n){
parentheses.l<-'\\begin{center}'
parentheses.r<-'\\end{center}'
parentheses.m<-sub(".*?\\\\begin\\{center\\}(.*?)\\\\end\\{center\\}.*", "\\1", tex)
parentheses.m.c<-gsub("\\\\\\\\", "\\\\\\line", parentheses.m)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste('\\qc ',parentheses.m.c, ' \\qc0 ',sep='' )
tex<-sub(latex.c, rtf.c, tex, fixed=T)
tex
}
n<-countCharOccurrences("begin{tabular}", tex)/14
for (i in 1:n){
parentheses.l<-'\\begin{tabular}'
parentheses.r<-'\\end{tabular}'
parentheses.m<-sub(".*?\\\\begin\\{tabular\\}(.*?)\\\\end\\{tabular\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
latex.c.o<-latex.c
col.adj<-trim(gsub('.*\\\\begin\\{tabular\\}\\{(.*?)\\}.*', "\\1", latex.c))
table.ncol<-nchar(col.adj)
table.nrow<-countCharOccurrences("&", latex.c)/(table.ncol-1)
for (i in 1:table.nrow){
for (k in 2: table.ncol){
latex.c<-sub('&', paste('}\\cell}{\\pard\\intbl\\q',strsplit(col.adj,'')[[1]][k],'{', sep=''),latex.c,fixed=T)
}
}
row.top<-'{\\trowd'
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx', (7*i),'00 ', sep='')
}
row.top<-paste(row.top,'{\\pard\\intbl\\q', strsplit(col.adj,'')[[1]][1] ,'{', sep='')
latex.c<-sub('Connect3END Connect3BEGIN', row.top,latex.c, fixed=T)
row.bottom<-'}\\cell}\\row}{\\trowd'
for (i in 1:table.ncol){
row.bottom<-paste(row.bottom,'\\cellx', (7*i),'00', sep='')
}
row.bottom<-paste(row.bottom, '{\\pard\\intbl\\q', strsplit(col.adj,'')[[1]][1],'{', sep='')
latex.c<-sub('\\\\Connect3END Connect3BEGIN', row.bottom,latex.c, fixed=T)
latex.c<-gsub('\\end{tabular}', '}\\cell}\\row}',latex.c, fixed=T)
latex.c<-sub(".*?\\{\\\\trowd", "\\{\\\\trowd",latex.c)
tex<-sub(latex.c.o, latex.c, tex, fixed=T)
}
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color=='\\red255\\green255\\blue255')],4,5))
verbatim.color<-trim(color.unique$rtfcolororder[which(color.unique$color=='\\red0\\green0\\blue0')])
rtfrow.verbatim2<-rtfrow.verbatim0(shade.n, verbatim.color)
n<-countCharOccurrences("begin{verbatim}", tex)/15
for (i in 1:n){
y<-tex
tex<-rtfrow.verbatim2(y)
}
tex<-gsub("\\smallskip\\hrule\\smallskip", " \\brdrb\\brdrs\\brdrw10\\brsp20 ", tex, fixed=T)
tex<-gsub("\\noindent", " \\fi0 ", tex, fixed=T)
tex<-gsub("\\begin{spacing}{0.7}", "",tex, fixed=T)
tex<-gsub("\\end{spacing}", "",tex, fixed=T)
tex<-gsub("{\\smaller", "",tex, fixed=T)
tex<-gsub("{\\small", "",tex, fixed=T)
tex<-gsub("\\vbox{", "",tex, fixed=T)
tex<-gsub("} \\vbox{", "",tex, fixed=T)
tex<-gsub("\\begin{spacing}{0.7}", "",tex, fixed=T)
tex<-gsub("} }\\end{spacing} ", "",tex, fixed=T)
tex<-gsub("~", " ",tex, fixed=T)
tex<-gsub("Connect3END Connect3BEGIN }Connect3END Connect3BEGIN", "Connect3END Connect3BEGIN Connect3END Connect3BEGIN",tex, fixed=T)
tex<-gsub("Connect3BEGIN", "\\pard",tex, fixed=T)
tex<-gsub("Connect3END", "\\par",tex, fixed=T)
tex<-gsub("\\pard \\par", "",tex, fixed=T)
tex<-gsub("\\pard } \\par", "",tex, fixed=T)
tex<-paste('\\fs20', tex)
tex
}
#inputtable.summary: function to convert Hmisc summary
inputtable.summary<-function(rtf.content){
#Read table input R
path<-sub("\\\\\\\\", "//", path)
table.name<-sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content)
table.path<-paste(path, "/",table.name, ".tex", sep='')
file<-table.path
tex<-read.latex(file, path)$tex
decision<-nchar(sub(".*?latex.default(.*?)\\).*", "\\1", tex))
if (decision<nchar(tex)){
x<-sub(".*?\\\\begin\\{table\\}(.*?)\\\\end\\{table\\}.*", "\\1", tex)
#1. Caption
caption<-sub(".*?\\\\caption\\{(.*?)\\}.*", "\\1", x)
if (caption==x){
caption<-''
}else{
caption<-paste("{\\pard\\qc",sub("\\\\label\\{.*", "\\1", caption), "\\par}")
}
#2. FootNote
footnote<-sub(".*?\\\\noindent", "\\1", x)
if (footnote==x){
footnote<-''
}else{
footnote<-sub("\\\\label\\{.*", "\\1", footnote)
footnote<-paste("{\\pard\\fi-500\\li0\\ri0",footnote, "\\par}")
}
#3. Table Body
table.ncol<-nchar(sub(".*?begin\\{tabular\\}\\{(.*?)\\}.*", "\\1", x))
list5<-unlist(strsplit(sub(".*?begin\\{tabular\\}\\{(.*?)\\}.*", "\\1", x), ''))
cell.width<-round(9500/table.ncol,0)
x<-sub(".*?\\\\begin\\{tabular\\}(.*?)\\\\end\\{tabular\\}.*", "\\1", x)
x<-sub(".*?\\hline", "\\1", x)
x<-sub(".*?Connect3BEGIN", "\\1", x)
x<-gsub("Connect3END", "\\1", x)
x<-gsub("Connect3BEGIN", "\\1", x)
x<-gsub("\\\\hline", "\\1", x)
x<-paste("\\tabularnewline", x)
#Calculate multicolumn rows
list0<-unlist(strsplit(x, "multicolumn"))
list0<-sub(".*?\\{(.*?)}.*", "\\1", list0)
list0<-as.numeric(list0[-1])
multicol.n.r<-ceiling(sum(list0)/table.ncol)
for (a in 1:multicol.n.r){
x2<-sub(".*?\\\\tabularnewline(.*?)\\\\tabularnewline.*", "\\1", x)
x2.o<-paste('\\tabularnewline', x2, sep='')
n.multicol<-countCharOccurrences('multicolumn', x2)/11
#Extract multicolumn columns
list1<-unlist(strsplit(x2, "multicolumn"))
list1<-sub(".*?\\{(.*?)}.*", "\\1", list1)
list1<-as.numeric(list1[-1])
#Extract column alignment
list1a<-unlist(strsplit(x2, "multicolumn"))[-1]
list1a<-sub("\\{.\\}\\{(.*?)}.*", "\\1", list1a)
#Remove non-neccessary information
x2<-gsub('\\bfseries', '\\b', x2, fixed=T)
x2<-gsub('{l}', '', x2, fixed=T)
x2<-gsub('{c}', '', x2, fixed=T)
x2<-gsub('{r}', '', x2, fixed=T)
if (sum(list1)!=table.ncol){
list1a<-unlist(strsplit(x2.o, "multicolumn"))
list1a<-sub("\\{.\\}\\{(.*?)}.*", "\\1", list1a)
list1a<-gsub('&', 'l', list1a, fixed=T)
list1a<-gsub('\\', '', list1a, fixed=T)
list1a<-gsub('tabularnewline', '', list1a, fixed=T)
list1a<-trim(paste(list1a, collapse=''))
if (nchar(list1a<table.ncol)){
list1a<-paste(list1a, 'l', sep='')
}
list1a<-unlist(strsplit(list1a, ""))
x2 <-gsub("&\\s*&", "&\\\\multicolumn{1}{}&", x2)
x2 <-gsub("^\\s*&", "\\\\multicolumn{1}{}&", x2)
x2 <-gsub("&\\s*$", "&\\\\multicolumn{1}{}", x2)
n.multicol<-countCharOccurrences('multicolumn', x2)/11
}
if (n.multicol!= table.ncol){
list1c<-unlist(strsplit(x2, "\\\\multicolumn"))[-1]
for (i in 1:length(list1)){
if (list1[i]!=1){
list1c[i]<-sub("\\{.\\}", "\\{1\\}", list1c[i])
list1c[i]<-paste(list1c[i], paste(replicate(list1[i]-1, "\\multicolumn{1}{}&"), collapse=''), sep='')
list1a[i]<-paste(replicate(list1[i], list1a[i]), collapse='')
}
}
list1c<-paste('\\multicolumn', list1c, sep='')
list1a<-paste(list1a, collapse='')
list1a<-unlist(strsplit(list1a, ''))
x2<-paste(list1c, collapse='')
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
row.top<-unlist(strsplit(row.top, "x"))
for (i in 1:length(list1)){
if (list1[i]!=1){
n.start <-sum(list1[1:(i-1)])+1
n.end<-sum(list1[1:i])
row.top[n.start]<-gsub("\\cell", "\\clmgf\\cell",row.top[n.start], fixed=T)
row.top[(n.start+1): n.end]<-gsub("\\cell","\\clmrg\\cell", row.top[(n.start+1): n.end], fixed=T)
}
}
row.top<-paste( row.top, collapse='')
row.top<-gsub("\\cell","\\cellx", row.top, fixed=T)
}else{
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
}
#Add border
if (nchar(sub(".*?\\\\cline\\{(.*?)\\}.*", "\\1", x2))!=nchar(x2)){
##Calculate multicolumn rows
list2<-unlist(strsplit(x2, " \\\\cline"))
list2<-sub(".*?\\{(.*?)}.*", "\\1", list2)
list2<-list2[-1]
row.top<-unlist(strsplit(row.top, "x"))
for (i in 1:length(list2)){
n.start <-as.numeric(unlist(strsplit(list2[i], "-")))[1]
n.end<-as.numeric(unlist(strsplit(list2[i], "-")))[2]
row.top[n.start:n.end]<-gsub("\\cell", "\\clbrdrt\\brdrs\\cell",row.top[n.start:n.end], fixed=T)
}
row.top<-paste( row.top, collapse='')
row.top<-gsub("\\cell","\\cellx", row.top, fixed=T)
x2<-gsub('\\\\cline\\{.*?\\}', '', x2)
}
x2<-gsub('\\multicolumn{1}{', '', x2, fixed=T)
x2<-gsub('}&', '&', x2, fixed=T)
x2<-gsub('&}', '&', x2, fixed=T)
x2<-gsub('&\\s*$', '&\\}', x2)
x2<-paste('\\tabularnewline',x2, '\\tabularnewline')
x2<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x2, fixed=T)
for (i in 2: table.ncol){
x2<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x2,fixed=T)
}
x2<-sub("\\tabularnewline", "\\cell}\\row}", x2, fixed=T)
#Add column alignment
list3<-unlist(strsplit(x2, "\\\\pard\\\\intbl"))
list1a<-paste('\\\\pard\\\\intbl\\\\q', list1a, sep='')
for (i in 2:length(list3)){
list3[i]<-sub('\\\\q.', list1a[i-1], list3[i])
}
x2<-paste(list3, collapse='')
x<-sub(x2.o, x2,x, fixed=T)
}
n.vertical<-countCharOccurrences('&', x)/(table.ncol-1)
#Top row
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.border<-"\\clbrdrt\\brdrs\\cell"
row.top<-gsub('\\cell', cell.border, row.top, fixed=T)
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
#Middle rows
for (j in 1:(n.vertical-2)){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
}
#Bottom rows
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.border<-"\\clbrdrb\\brdrs\\cell"
row.top<-gsub('\\cell', cell.border, row.top, fixed=T)
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
x<-gsub('\\textless', '<', x, fixed=T)
x<-gsub("\\\\tabularnewline", "\\1", x)
#Add border to top row
x3<-sub(".*?\\{\\\\trowd(.*?)\\{\\\\pard\\\\intbl.*", "\\1", x)
x3.o<-x3
x3<-unlist(strsplit(x3, "x"))
x3<-gsub("\\cell","\\clbrdrt\\brdrs\\cellx", x3, fixed=T)
x3<-paste( x3, collapse='')
x<-sub(x3.o, x3, x, fixed=T)
#Add column alignment
list4<-unlist(strsplit(x, "\\\\pard\\\\intbl"))
list5<-rep(paste('\\\\pard\\\\intbl\\\\q', list5, sep=''), n.vertical )
for (i in 2:(table.ncol*multicol.n.r+1)){
list4[i]<-sub('\\\\q', '\\\\pard\\\\intbl\\\\q', list4[i])
}
for (i in (table.ncol*multicol.n.r+2):length(list4)){
list4[i]<-sub('\\\\q.', list5[i-(table.ncol*multicol.n.r+1)], list4[i])
}
x<-paste(list4, collapse='')
#Remove leading and trailing space for each cell
x<-gsub('\\\\pard\\\\intbl\\\\qr\\{\\s+', '\\\\pard\\\\intbl\\\\qr\\{', x)
x<-gsub('\\\\pard\\\\intbl\\\\ql\\{\\s+', '\\\\pard\\\\intbl\\\\ql\\{', x)
x<-gsub('\\\\pard\\\\intbl\\\\qc\\{\\s+', '\\\\pard\\\\intbl\\\\qc\\{', x)
x<-gsub('~', ' ', x)
x<-gsub('\\%', '%', x, fixed=T)
x<-paste(caption, x, footnote)
}
n.mathmode<-countCharOccurrences('$', x)/2
for (i in 1:n.mathmode){
x<-mathmode(x)
}
x
}
##Part 1. Preprocessing Functions
#Function Set7: description, enumerate, itemize
#description
description<-function(x){
parentheses.l<-"\\begin{description}"
parentheses.r<-"\\end{description}"
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
latex.c<-unlist(strsplit(latex.c, parentheses.r, fixed=T))[1]
rtf.c<-latex.c
item<-function(x2){
parentheses.l<-'\\item['
parentheses.r<-']'
parentheses.m<-sub(".*?\\\\item\\[(.*?)\\].*", "\\1", x2)
latex.c2<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c2<-paste('\\line \\tab \\b ', parentheses.m, '\\b0 ', sep='')
x2<-sub(latex.c2, rtf.c2, x2, fixed=T)
x2
}
n<-countCharOccurrences('\\item[', latex.c)/6
for (i in 1:n){
rtf.c<-item(rtf.c)
}
x<-sub(paste("\\begin{description}", latex.c, "\\end{description}", sep=''), rtf.c, x, fixed=T)
x
}
#enumerate2: level2 enumerate function
enumerate2<-function(x){
parentheses.l<-"\\begin{enumerate}"
parentheses.r<-'\\end{enumerate}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 (", letters[seq( from = 1, to = n )][i], ") \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#itemize2: level2 itemize function
itemize2<-function(x){
parentheses.l<-"\\begin{itemize}"
parentheses.r<-'\\end{itemize}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#enumerate1: level1 enumerate function
enumerate1<-function(x){
parentheses.l<-"\\begin{enumerate}"
parentheses.r<-'\\end{enumerate}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
if (grepl("\\begin{itemize}", latex.c, fixed=T)){
latex.c2<-itemize2(latex.c)
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c2, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 (", letters[seq( from = 1, to = n )][i], ") \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#itemize1: level1 itemize function
itemize1<-function(x){
parentheses.l<-"\\begin{itemize}"
parentheses.r<-'\\end{itemize}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
if (grepl("\\begin{enumerate}", latex.c, fixed=T)){
latex.c2<-enumerate2(latex.c)
target<-sub(parentheses.r,"\\end++{itemize}",latex.c2, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#End of Part 1. Preprocessing Functions
#################################################################################################
#Part 2. Stepwise Translation
#Step 1: load read.latex object and initial minor prunings
path<-path
rtf<-tex
rtf<-gsub('\\\\', '\\line ', rtf, fixed=T)
rtf<-gsub('\\definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\\color{fgcolor}', '', rtf, fixed=T)
rtf<-gsub('\\begin{figure}[!ht]', '', rtf, fixed=T)
rtf<-gsub('\\begin{figure}[!tbp]', '', rtf, fixed=T)
rtf<-gsub('\\end{figure}', '', rtf, fixed=T)
#Remove Latex comments
n.step1<-countCharOccurrences("Connect3BEGIN %", tex)/nchar("Connect3BEGIN %")
for (i in 1:n.step1){
rtf<-sub(paste('Connect3BEGIN %',sub("^.*Connect3BEGIN %(.*?)Connect3END.*", "\\1", rtf), 'Connect3END', sep=''), '', rtf, fixed=T)
}
#Part 2. Stepwise Translation
#Step 2: color of R code chunks
n.step2<-countCharOccurrences("begin{alltt}", tex)/nchar("begin{alltt}")
for (i in 1:n.step2){
rtf<-rtfrow.color(rtf)
}
#Part 2. Stepwise Translation
#Step 3: verbatim of R code chunks
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='shadecolor'][1])],4,5))
verbatim.color<-trim(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='\\hlstd'][1])])
rtfrow.verbatim<-rtfrow.verbatim0(shade.n, verbatim.color)
n.step3<-countCharOccurrences("begin{verbatim}", tex)/15
for (i in 1:n.step3){
rtf<-rtfrow.verbatim(rtf)
}
#Part 2. Stepwise Translation
#Step 4: struction and figure of R code chunks
z<-sub(".*?\\\\begin\\{document\\}(.*?)\\\\end\\{document\\}.*", "\\1", rtf)
rtf.content<-z
n.step4<-countCharOccurrences("begin{knitrout}", z)/15
knitrout.content<-rep(NA, n.step4)
for (i in 1:n.step4){
x<-sub(".*?\\\\begin\\{knitrout\\}(.*?)\\\\end\\{knitrout\\}.*", "\\1", z)
knitrout.content[i]<-knitoutrblock(x)
knitrout.block<-paste("\\begin{knitrout}",sub(".*?\\\\begin\\{knitrout\\}(.*?)\\\\end\\{knitrout\\}.*", "\\1", x), "\\end{knitrout}", sep='')
z<-sub(knitrout.block, "", z, fixed=T)
rtf.content<-sub(knitrout.block, knitrout.content[i], rtf.content, fixed=T)
}
#Reduce multiple 'Connect3BEGIN Connect3END' to one
rtf.content<-unlist(strsplit(rtf.content, 'Connect3BEGIN Connect3END'))
rtf.content<-rtf.content[rtf.content!=' ']
rtf.content<-paste(rtf.content, collapse='\\pard \\par')
rtf.content<-gsub('Connect3BEGIN', '', rtf.content, fixed=T)
rtf.content<-gsub('Connect3END', '', rtf.content, fixed=T)
rtf.content<-gsub('\\clearpage', '', rtf.content, fixed=T)
rtf.content<-gsub("\\newpage","\\pard \\insrsid \\page \\par" , rtf.content, fixed=T)
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd", rtf.content)
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
#Part 2. Stepwise Translation
#Step 5: Hmisc tables
n.step5<-countCharOccurrences('\\input{', rtf.content)/nchar('\\input{')
n.table<-data.frame(tablename=rep(NA, n.step5), tabletype=rep(NA, n.step5), tablenumbering=rep(NA, n.step5))
tmp<-rtf.content
if (n.step5!=0){
for (i in 1:n.step5){
path<-sub("\\\\\\\\", "//", path)
n.table$tablename[i]<-sub(".*?input\\{(.*?)\\}.*", "\\1", tmp)
table.path<-paste(path, "/",n.table$tablename[i], ".tex", sep='')
file<-table.path
table.tex<-read.latex(file, path)$tex
decision<-nchar(sub(".*?latex.default(.*?)\\).*", "\\1", table.tex))
if (decision==nchar(table.tex)){
n.table$tabletype[i]<-'hmisc.describe'
n.table$tablenumbering[i]<-i
}
if (decision<nchar(table.tex)){
n.table$tabletype[i]<-'hmisc.summary'
n.table$tablenumbering[i]<-i
}
tmp<-sub("\\input{", "", tmp, fixed=T)
}
n.table$tablenumbering<-n.table$tablenumbering-sum(n.table$tabletype=='hmisc.describe')
for (i in 1:n.step5){
if (n.table$tabletype[i]=='hmisc.describe'){
rtf.table<-inputtable.describe(rtf.content)
rtf.content<- sub(paste("\\input{", sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content), "}", sep=''), rtf.table, rtf.content, fixed=T)
}
if (n.table$tabletype[i]=='hmisc.summary'){
rtf.table2<-inputtable.summary(rtf.content)
rtf.table2<-sub("{\\pard\\qc", paste("{\\pard\\qc Table ",n.table$tablenumbering[i], ": ", sep=''), rtf.table2, fixed=T)
rtf.content<- sub(paste("\\input{", sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content), "}", sep=''), rtf.table2, rtf.content, fixed=T)
}
}
}
#Part 2. Stepwise Translation
#Step 6: Section Numbering
list1<-gregexpr(pattern ='\\section{',rtf.content, fixed=T)
list1<-data.frame(name=rep('\\section{', length(list1[[1]])), position=list1[[1]])
if (grepl('\\subsection{', rtf.content, fixed=T)){
list2<-gregexpr(pattern ='\\subsection{',rtf.content, fixed=T)
list2<-data.frame(name=rep('\\subsection{', length(list2[[1]])), position=list2[[1]])
list.both<-rbind(list1, list2)
list.both<-list.both[order(list.both$position),]
list.both$position2<-seq(1, nrow(list.both), by=1)
list.both$position3<-NA
list.both$position3[list.both$name=='\\section{']<-seq(1, length(list.both$position3[list.both$name=='\\section{']), by=1)
breakdown<-list.both$position2[list.both$name=='\\section{']
#listnames<-paste("list", letters[seq( from = 1, to = length(breakdown))], sep='.')
list.all<-list()
for (i in 1:length(breakdown)){
if (i<=length(breakdown)-1){
list.x<-list.both[(breakdown[i]):(breakdown[i+1]-1),]
list.x$position4<-list.x$position3[1]
list.x$position5<-seq(0, nrow(list.x)-1, by=1)
list.x$position6<-paste(list.x$position4, list.x$position5, sep='.')
list.x$position6[1]<-list.x$position3[1]
list.x$position6<-paste(list.x$name,list.x$position6, ' ',sep=' ')
#list.all[[i]]<- assign(listnames[[i]], list.x)
list.all[[i]]<-list.x
}else{
list.x<-list.both[(breakdown[i]):nrow(list.both),]
list.x$position4<-list.x$position3[1]
list.x$position5<-seq(0, nrow(list.x)-1, by=1)
list.x$position6<-paste(list.x$position4, list.x$position5, sep='.')
list.x$position6[1]<-list.x$position3[1]
list.x$position6<-paste(list.x$name,list.x$position6, ' ',sep=' ')
#list.all[[i]]<- assign(listnames[[i]], list.x)
list.all[[i]]<-list.x
}
}
list.both<-do.call("rbind", list.all)
list.both.A<-list.both[which(list.both$name=='\\section{'),]
list.both.B<-list.both[which(list.both$name=='\\subsection{'),]
for (i in 1:nrow(list.both.A)){
rtf.content<-sub('\\section{', list.both.A$position6[i], rtf.content, fixed=T)
rtf.content<-sub('\\section{', '\\section++{', rtf.content, fixed=T)
}
for (i in 1:nrow(list.both.B)){
rtf.content<-sub('\\subsection{', list.both.B$position6[i], rtf.content, fixed=T)
rtf.content<-sub('\\subsection{', '\\subsection++{', rtf.content, fixed=T)
}
rtf.content<-gsub('section++{', 'section{', rtf.content, fixed=T)
}else{
list1$position1<-seq(1, nrow(list1), by=1)
list1$position2<-paste(list1$name,list1$position1, ' ',sep=' ')
for (i in 1:nrow(list1)){
rtf.content<-sub('\\section{', list1$position2[i], rtf.content, fixed=T)
rtf.content<-sub('\\section{', '\\section++{', rtf.content, fixed=T)
}
rtf.content<-gsub('section++{', 'section{', rtf.content, fixed=T)
}
#Part 2. Stepwise Translation
#Step 7: description, enumerate, itemize
rtf.content<-gsub('\\begin{enumerate}[I.]', '\\begin{enumerate}', rtf.content, fixed=T)
n<-countCharOccurrences("\\begin{description}", rtf.content)/19
if (n!=0){
for (i in 1:n){
rtf.content<-description(rtf.content)
}
}
n<-countCharOccurrences("\\begin{enumerate}", rtf.content)/17+countCharOccurrences("\\begin{itemize}", rtf.content)/15
if (n!=0){
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]>0&gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]>0){
for (i in 1:n){
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]<gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]){
rtf.content<-enumerate1(rtf.content)
}else{
rtf.content<-itemize1(rtf.content)
}
}
}else{
if (gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]<0){
for (i in 1:n){
rtf.content<-enumerate1(rtf.content)
}
}
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]<0){
for (i in 1:n){
rtf.content<-itemize1(rtf.content)
}
}
}
}
#Part 2. Stepwise Translation
#Step 8: Make Title
rtf.content<-sub('\\maketitle', '\\pard\\qc\\fs24 \\chdate \\par \\pard \\par', rtf.content, fixed=T)
rtf.content<-sub('\\TeX{}', '{\\plain T{\\dn6 E}X}', rtf.content, fixed=T)
#Part 2. Stepwise Translation
#Step 8: thebibliography environment
list1<-gregexpr(pattern ='\\bibitem{',rtf.content, fixed=T)
list1<-data.frame(name=rep('\\bibitem{', length(list1[[1]])), position=list1[[1]])
list1$position2<-seq(1, nrow(list1), by=1)
list1$position3<-paste('[', list1$position2, ']', sep='')
list1$position2<-paste('\\pard \\par [', list1$position2, '] ', list1$name, sep='')
list1$position4<-NA
for (i in 1:nrow(list1)){
list1$position4[i]<-sub('^.*\\\\bibitem\\{(.*?)\\}.*','\\1', rtf.content)
rtf.content<-sub('\\bibitem{', list1$position2[i], rtf.content, fixed=T)
rtf.content<-sub('\\bibitem{', '\\bibitem++{', rtf.content, fixed=T)
}
rtf.content<-gsub('bibitem++{', 'bibitem{', rtf.content, fixed=T)
list1$position4<-paste('\\cite{',list1$position4, '}', sep='')
for (i in 1:nrow(list1)){
rtf.content<-sub(list1$position4[i], list1$position3[i], rtf.content, fixed=T)
}
rtf.content<-sub(paste('\\begin{thebibliography}',sub("^.*\\\\begin\\{thebibliography\\}(.*?)\\\\par.*", "\\1", rtf.content), sep=''), '\\pard \\b References \\b0 \\par', rtf.content, fixed=T)
rtf.content<-sub('\\end{thebibliography}', '\\pard \\par', rtf.content, fixed=T)
#Part 2. Stepwise Translation
#Step 9: Command dictionary
n1<-NROW(comdictionary)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(comdictionary$latex[n], rtf.content)/(nchar(comdictionary$latex[n]))
for (j in 1:n2){
rtf.content<-commanddictionary(rtf.content, n)
}
}
rtf.content<-gsub('\\\\frac2\\s+', '\\\\frac2', rtf.content)
n1<-NROW(comdictionary)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(comdictionary$latex[n], rtf.content)/(nchar(comdictionary$latex[n]))
for (j in 1:n2){
rtf.content<-commanddictionary(rtf.content, n)
}
}
#Part 2. Stepwise Translation
#Step 10: Remove extra empty space
x<-unlist(strsplit(rtf.content, "{\\trowd", fixed=T))
for (i in 1:length(x)){
if (grepl("\\row}", x[i], fixed=T)==F){
x[i]<-gsub("\\s+", " ", x[i])
}else{
x2<-unlist(strsplit(x[i], "\\row}", fixed=T))
if (length(x2)==2){
x2[2]<-gsub("\\s+", " ", x2[2])
x[i]<-paste(x2,collapse='\\row}')
}
}
}
x<-paste(x, collapse='{\\trowd')
#Part 2. Stepwise Translation
#Step 11: Change align environment and equation environment to $ environment
n.align<-countCharOccurrences('\\begin{align}', x)/13
if (n.align!=0){
for (i in 1:n.align){
tmp0<-sub(".*?\\\\begin\\{align\\}(.*?)\\\\end\\{align\\}.*", "\\1", x)
tmp<-paste('\\pard \\par \\pard\\qc $', tmp0, '$\\qc0\\par')
tmp<-gsub('\\line', '$ \\qc0\\par \\pard\\qc $', tmp, fixed=T)
tmp<-gsub('&','',tmp, fixed=T)
x<-sub(paste('\\begin{align}', tmp0, '\\end{align}', sep=''), tmp, x, fixed=T)
}
}
n.equation<-countCharOccurrences('\\begin{equation}', x)/16
if (n.equation!=0){
for (i in 1:n.equation){
tmp0<-sub(".*?\\\\begin\\{equation\\}(.*?)\\\\end\\{equation\\}.*", "\\1", x)
tmp<-paste('\\pard\\line \\par {\\pard\\qc $', tmp0, '$\\qc0\\par}')
x<-sub(paste('\\begin{equation}', tmp0, '\\end{equation}', sep=''), tmp, x, fixed=T)
}
}
n.mathmode<-countCharOccurrences('$', x)/2
if (n.mathmode!=0){
for (i in 1:n.mathmode){
x<-mathmode(x)
}
}
#Part 2. Stepwise Translation
#Step 12: Side by side graphs
x<-gsub('{\\fldrslt { }}} \\pard \\par {\\field\\fldedit', '{\\fldrslt { }}} {\\field\\fldedit', x, fixed=T)
x<-unlist(strsplit(x, '\\\\pard \\\\par'))
x<-x[x!=' ']
x<-paste(x, collapse='\\pard \\par')
#Part 2. Stepwise Translation
#Step 13: headings and footer
rtf.head<-rtfcolorcode
footer<-"{\\footer\\pard\\plain\\f0\\fs20\\qc\\chpgn\\par}"
x<-paste("{\\rtf1\\ansi\\deff0", rtf.head,footer,x,"}", sep='')
write(x, file=paste(outputlocation,'/',name,'.rtf', sep=''))
}
Try the connect3 package in your browser
Any scripts or data that you put into this service are public.
connect3 documentation built on May 29, 2017, 10:10 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions write.rtf
Documented in write.rtf
#' @title A function for writing Rich Text Format (rtf) files
#' @description \code{write.rtf} converts LaTeX files (with extension .tex) generated by R Sweave using package 'knitr' to Rich Text Format (RTF) files.
#' Features include: 1) conversion of R syntax highlighting; 2) conversion of tables generated by \code{Hmisc::describe}, \code{Hmisc::summary}, and
#' \code{Hmisc::latex}; 3) conversion of mathematical equations; 4) conversion of graphics; 5) conversion of itemize and enumerate; 6) conversion of references.
#' @param tex is the tex value returned by \code{read.latex}.
#' @param path is the path value returned by \code{read.latex}.
#' @param name is the name of the output Rich Text Format file.
#' @param outputlocation is the location where the Rich Text Format file is to be saved. The default location is the same as path.
#' @export
#' @details For files with graphics, dev must be set to 'png' in 'knitr' chunk options for \code{write.rtf} to run properly.
#' @return \code{write.rtf} returns a file in Rich Text Format (rtf).
#' @seealso \code{\link{read.latex}}
#' @references Yihui Xie (2015). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.10.5.
#' @references Frank E Harrell Jr, with contributions from Charles Dupont and many others. (2014). Hmisc: Harrell Miscellaneous. R package version 3.14-4. http://CRAN.R-project.org/package=Hmisc
#' @examples
#' ##Example 1
#' #Read a sample LaTeX file
#' file<-'connect3-minimal.tex'
#' filepath<-paste(sub("examples/.*","\\1",
#' system.file("examples","connect3-minimal.tex",package="connect3")),
#' "examples", sep='')
#' obj<-read.latex(file, filepath)
#' obj
#'
#' #Convert a LaTeX file to a Rich Text Format file
#' tex<-obj$tex
#' path<-obj$path
#' name<-'connect3-minimal'
#' outputlocation<-gsub('\\\\','/',tempdir())
#' write.rtf(tex,path,name,outputlocation)
#'
#' ##Example 2
#' ## Step 1: Download an R Sweave file using 'knitr' from:
#' ## 'https://github.com/yihui/knitr/blob/master/inst/examples/knitr-minimal.Rnw'
#' ## Step 2: Save it as 'knitr-minimal.Rnw' in a folder such: 'C:/Users/Desktop/tmp'.
#' ## Change r code chunck options
#' ## "<<boring-plots, fig.width=4, fig.height=4, out.width='.4\\linewidth'>>="
#' ## to
#' ## "<<boring-plots, fig.width=3, fig.height=3, out.width='.4\\linewidth', dev='png'>>=".
#' ## Step 3: Click Compile PDF in RStudio
#' ## Step 4: Read 'knitr-minimal.tex' file in the folder using function read.latex
#' # file<-'knitr-minimal.tex'
#' # filepath<-'C:/Users/Desktop/tmp'
#' # obj<-read.latex(file, filepath)
#' # obj
#' ## Step 5: Converts 'knitr-minimal.tex' file to 'knitr-minimal.rtf' file using function write.rtf
#' # tex<-obj$tex
#' # path<-obj$path
#' # name<-'knitr-minimal'
#' # write.rtf(tex,path,name,outputlocation)
write.rtf<-function(tex,path,name,outputlocation=path){
#Part 1. Preprocessing Functions
#Function Set1: countCharOccurrences, trim, trim2
#countCharOccurrences: count character occurrences
countCharOccurrences <- function(char, s){
s2 <- gsub(char,"",s, fixed=T)
return (nchar(s) - nchar(s2))
}
#trim, trim2: trim leading and trailing space
trim <- function (x){
gsub("^\\s+|\\s+$", "", x)
}
trim2 <- function (x){
gsub("^Connect3END+|Connect3BEGIN+$", "", x)
}
#Part 1. Preprocessing Functions
#Function Set2: mathsymbol and mathmode
#mathsymbol: convert LaTeX command to unicodes
mathsymbol<-function(x){
#1 Math Operators
x<-gsub("\\ne","\\u8800*",x, fixed=T)
x<-gsub("\\times","\\u215*",x, fixed=T)
x<-gsub("\\leq","\\u8804*",x, fixed=T)
x<-gsub("\\geq","\\u8805*",x, fixed=T)
x<-gsub("\\leq","\\u8804*",x, fixed=T)
x<-gsub("\\ll","\\u8810*",x, fixed=T)
x<-gsub("\\gg","\\u8811*",x, fixed=T)
#2 Greek letters
x<-gsub("\\Alpha","\\u0913\\3",x, fixed=T)
x<-gsub("\\Beta","\\u0914\\3",x, fixed=T)
x<-gsub("\\Gamma","\\u0915\\3",x, fixed=T)
x<-gsub("\\Delta","\\u0916\\3",x, fixed=T)
x<-gsub("\\Epsilon","\\u0917\\3",x, fixed=T)
x<-gsub("\\Zeta","\\u0918\\3",x, fixed=T)
x<-gsub("\\Eta","\\u0919\\3",x, fixed=T)
x<-gsub("\\Theta","\\u0920\\3",x, fixed=T)
x<-gsub("\\Iota","\\u0921\\3",x, fixed=T)
x<-gsub("\\Kappa","\\u0922\\3",x, fixed=T)
x<-gsub("\\Lambda","\\u0923\\3",x, fixed=T)
x<-gsub("\\Mu","\\u0924\\3",x, fixed=T)
x<-gsub("\\Nu","\\u0925\\3",x, fixed=T)
x<-gsub("\\Xi","\\u0926\\3",x, fixed=T)
x<-gsub("\\Omicron","\\u0927\\3",x, fixed=T)
x<-gsub("\\Pi","\\u0928\\3",x, fixed=T)
x<-gsub("\\Rho","\\u0929\\3",x, fixed=T)
x<-gsub("\\Sigma","\\u0931\\3",x, fixed=T)
x<-gsub("\\Tau","\\u0932\\3",x, fixed=T)
x<-gsub("\\Upsilon","\\u0933\\3",x, fixed=T)
x<-gsub("\\Phi","\\u0934\\3",x, fixed=T)
x<-gsub("\\Chi","\\u0935\\3",x, fixed=T)
x<-gsub("\\Psi","\\u0936\\3",x, fixed=T)
x<-gsub("\\Omega","\\u0937\\3",x, fixed=T)
x<-gsub("\\alpha","\\u0945\\3",x, fixed=T)
x<-gsub("\\beta","\\u0946\\3",x, fixed=T)
x<-gsub("\\gamma","\\u0947\\3",x, fixed=T)
x<-gsub("\\delta","\\u0948\\3",x, fixed=T)
x<-gsub("\\epsilon","\\u0949\\3",x, fixed=T)
x<-gsub("\\zeta","\\u0950\\3",x, fixed=T)
x<-gsub("\\eta","\\u0951\\3",x, fixed=T)
x<-gsub("\\theta","\\u0952\\3",x, fixed=T)
x<-gsub("\\iota","\\u0953\\3",x, fixed=T)
x<-gsub("\\kappa","\\u0954\\3",x, fixed=T)
x<-gsub("\\lambda","\\u0955\\3",x, fixed=T)
x<-gsub("\\mu","\\u0956\\3",x, fixed=T)
x<-gsub("\\nu","\\u0957\\3",x, fixed=T)
x<-gsub("\\xi","\\u0958\\3",x, fixed=T)
x<-gsub("\\omicron","\\u0959\\3",x, fixed=T)
x<-gsub("\\pi","\\u0960\\3",x, fixed=T)
x<-gsub("\\rho","\\u0961\\3",x, fixed=T)
x<-gsub("\\sigmaf","\\u0962\\3",x, fixed=T)
x<-gsub("\\sigma","\\u0963\\3",x, fixed=T)
x<-gsub("\\tau","\\u0964\\3",x, fixed=T)
x<-gsub("\\upsilon","\\u0965\\3",x, fixed=T)
x<-gsub("\\phi","\\u0966\\3",x, fixed=T)
x<-gsub("\\chi","\\u0967\\3",x, fixed=T)
x<-gsub("\\psi","\\u0968\\3",x, fixed=T)
x<-gsub("\\omega","\\u0969\\3",x, fixed=T)
x
}
#mathsymbol: convert LaTeX math command to rtf math command
mathmode<-function(x){
m<-sub(".*?\\$(.*?)\\$.*", "\\1", x)
m.o<-paste('$', m, '$', sep='')
m<-mathsymbol(m)
#mode 1
m.o2<-m
m.o2<-unlist(strsplit(m.o2, "\\^\\s*\\{[^\\}*]\\}\\s*\\_\\s*\\{[^\\}*]\\}"))
m.diff<-m
for (i in 1:length(m.o2)){
m.diff<-sub(m.o2[i], '', m.diff, fixed=T)
}
if (m.diff!=''){
m.diff<-paste('^',unlist(strsplit(m.diff, "\\^"))[-1], sep='')
for (i in 1:length(m.diff)){
df1<-sub("^.*\\^\\s*\\{(.*?)\\}\\s*\\_\\s*\\{.*$", "\\1", m.diff[i])
df2<-sub("^.*\\_\\s*\\{(.*?)\\}.*$", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\up({\\fs13 ", df1, ',',df2, "})",sep=''), m, fixed=T)
}
}
#mode 2
m.o3<-m
m.o3<-unlist(strsplit(m.o3, "\\^\\s*\\{[^\\}*]\\}"))
m.diff<-m
for (i in 1:length(m.o3)){
m.diff<-sub(m.o3[i], '', m.diff, fixed=T)
}
if (m.diff!=''){
m.diff<-paste('^',unlist(strsplit(m.diff, "\\^"))[-1], sep='')
for (i in 1:length(m.diff)){
df3<-sub("^.*\\^\\s*\\{(.*?)\\}", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\up4({\\fs13 ", df3, "})",sep=''), m, fixed=T)
}
}
#mode 3
m.o4<-m
m.o4<-unlist(strsplit(m.o4, "\\_\\{(.*?)\\}"))
m.diff<-m
for (i in 1:length(m.o4)){
m.diff<-sub(m.o4[i], '', m.diff, fixed=T)
}
if (m.diff!='' & gregexpr(pattern =',',m.diff, fixed=T)[[1]][1]>0){
m.diff<-paste('_',unlist(strsplit(m.diff, "\\_"))[-1], sep='')
for (i in 1:length(m.diff)){
df4<-sub("^.*\\_\\s*\\{(.*?)\\,.*$", "\\1", m.diff[i])
df5<-sub("^.*\\,(.*?)\\}.*$", "\\1", m.diff[i])
m<-sub(m.diff[i], paste("\\\\s\\\\do4({\\fs13 ", df4, '\\\\,',df5, "})",sep=''), m, fixed=T)
}
}
if (m.diff!='' & gregexpr(pattern =',',m.diff, fixed=T)[[1]][1]<0){
m.diff<-paste('_',unlist(strsplit(m.diff, "\\_"))[-1], sep='')
for (i in 1:length(m.diff)){
m.diff2<-sub("^.*\\_\\{(.*?)\\}.*$", "\\1", m.diff)
m<-sub(m.diff[i], paste("\\\\s\\\\do4({\\fs13 ", m.diff2[i], "})",sep=''), m, fixed=T)
}
}
#end of modes
m<-gsub("\\,\\s+P", "\\, P", m)
m<-gsub(" \\\\s\\\\up4({\\fs13", "\\\\s\\\\up4({\\fs13", m, fixed=T)
m<-paste('{{\\field{\\*\\fldinst{ EQ ', m, ' }}{\\fldrslt }}}', sep='')
x<-sub(m.o, m, x, fixed=T)
x
}
#Part 1. Preprocessing Functions
#Function Set3: Command dictionary (convert LaTeX command to RTF command)
#General command
comdictionary<-data.frame(latex='\\textbf', rtfb='\\b ', rtfe=' \\b0 ')
comdictionary<-rbind(comdictionary, data.frame(latex='\\textit', rtfb='\\i ', rtfe='\\i0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\section', rtfb='\\pard \\insrsid \\line \\par \\b ',rtfe='\\pard \\insrsid \\par \\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\subsection', rtfb='\\pard \\insrsid \\line \\par \\b ',rtfe='\\pard \\insrsid \\par \\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\emph', rtfb='\\b ', rtfe='\\b0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\title', rtfb='\\pard\\qc\\b\\fs32 ', rtfe='\\qc0\\b0\\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\author', rtfb='\\pard\\qc\\fs24', rtfe='\\qc0\\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\url', rtfb='{\\field{\\*\\fldinst HYPERLINK "', rtfe='"}{\\fldrslt }}'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\label', rtfb='\\v ', rtfe='\\v0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\ref', rtfb='\\v ', rtfe='\\v0 '))
comdictionary<-rbind(comdictionary, data.frame(latex='\\caption', rtfb='\\pard\\b Figure: \\b0 ', rtfe='\\par \\pard \\par'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\underline', rtfb='{\\ul ', rtfe='}'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\bibitem', rtfb='\\v ', rtfe='\\v0'))
#Math related command
comdictionary<-rbind(comdictionary, data.frame(latex='\\textrm', rtfb='\\i ', rtfe='\\i0'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\bar', rtfb='\\u563 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\hat', rtfb='\\u375 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\acute', rtfb='\\u563 ', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\dot', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\breve', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\check', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\grave', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\vec', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\ddot', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\tilde', rtfb='', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt', rtfb='\\\\R(, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt[3]', rtfb='\\R(3, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\sqrt[4]', rtfb='\\R(4, ', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac', rtfb='\\frac1{', rtfe='}\\frac2'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac1', rtfb='\\\\F(', rtfe=''))
comdictionary<-rbind(comdictionary, data.frame(latex='\\frac2', rtfb=',', rtfe=')'))
comdictionary<-rbind(comdictionary, data.frame(latex='\\textsuperscript', rtfb='{\\up6 ', rtfe=' }'))
comdictionary$latex<-as.character(comdictionary$latex)
comdictionary$rtfb<-as.character(comdictionary$rtfb)
comdictionary$rtfe<-as.character(comdictionary$rtfe)
commanddictionary<-function(x, n){
parentheses.l<-paste(comdictionary$latex[n], '{', sep='')
parentheses.r<-'}'
if (grepl(parentheses.l, x, fixed=T)){
target<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
target.r<-unlist(strsplit(target, "}", fixed=T))
n.rp<-countCharOccurrences("{", target.r)
n.rp1<-rep(NA, length(n.rp))
for (i in 1:length(n.rp)){
n.rp1[i]<-sum(n.rp[1:i])
}
n.rp2<-1:length(n.rp)
location<-which(n.rp2>n.rp1)[1]
parentheses.m<-paste(unlist(strsplit(target, "}", fixed=T))[1:location], collapse='}')
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste(comdictionary$rtfb[n],parentheses.m, comdictionary$rtfe[n],sep='')
x<-sub(latex.c, rtf.c, x, fixed=T)
}
x
}
#Part 1. Preprocessing Functions
#Function Set4: definecolor and newcommandcolor (functions to extract color information of R code Chuncks)
#Define color function
definecolor<-function(x){
colorname<-sub(".*?\\\\definecolor\\{(.*?)\\}.*", "\\1", x)
colorvalue<-sub(".*?rgb\\}\\{(.*?)\\}.*", "\\1", x)
colorvalue1<-round(as.numeric(sub(",.*", "\\1", colorvalue))*255, 0)
colorvalue2<-round(as.numeric(sub(".*?,(.*?),.*", "\\1", colorvalue))*255, 0)
colorvalue3<-round(as.numeric(sub(".*?,(.*?)$", "\\1", colorvalue))*255, 0)
color<-paste("\\red", colorvalue1, "\\green", colorvalue2, "\\blue", colorvalue3, sep='')
font<-NA
list(colorname, color, font)
}
tex.definecolor<-tex
n<-countCharOccurrences("definecolor", tex.definecolor)/nchar("definecolor")
#Recursive loop
if (n!=0){
definecolor.data<-matrix(data=NA, nrow=n, ncol=3)
for (i in 1:n){
definecolor1<-paste("\\definecolor{",sub(".*?\\\\definecolor\\{(.*?)\\}Connect3END.*", "\\1", tex.definecolor), '}',sep='')
tex.definecolor<-sub(definecolor1, '', tex.definecolor, fixed=T)
x<-definecolor1
color1<-definecolor(x)
definecolor.data[i,]<-c(color1[[1]][1],color1[[2]][1],color1[[3]][1])
}
definecolor.data<-as.data.frame(definecolor.data)
names(definecolor.data)<-c('name', 'color', 'font')
}
#newcommandcolor function
newcommandcolor<-function(x){
colorname<-sub(".*?\\\\newcommand\\{(.*?)\\}.*", "\\1", x)
colorvalue<-sub(".*?rgb\\]\\{(.*?)\\}.*", "\\1", x)
colorvalue1<-round(as.numeric(sub(",.*", "\\1", colorvalue))*255, 0)
colorvalue2<-round(as.numeric(sub(".*?,(.*?),.*", "\\1", colorvalue))*255, 0)
colorvalue3<-round(as.numeric(sub(".*?,(.*?)$", "\\1", colorvalue))*255, 0)
color<-paste("\\red", colorvalue1, "\\green", colorvalue2, "\\blue", colorvalue3, sep='')
font<-sub(".*?\\}\\{(.*?)\\{#.*", "\\1", x)
if (font==x){
font<-NA
}
list(colorname, color, font)
}
tex.newcommandcolor<-tex
n<-countCharOccurrences("textcolor", tex.newcommandcolor)/nchar("textcolor")
#Recursive loop
if (n!=0){
commandcolor.data<-matrix(data=NA, nrow=n, ncol=3)
for (i in 1:n){
newcommandcolor1<-paste("\\newcommand{", sub(".*?\\\\newcommand\\{(.*?)\\}\\}%.*", "\\1", tex.newcommandcolor), "}}", sep='')
tex.newcommandcolor<-sub(newcommandcolor1, '', tex.newcommandcolor, fixed=T)
x<-newcommandcolor1
color1<-newcommandcolor(x)
color1
commandcolor.data[i,]<-c(color1[[1]][1],color1[[2]][1],color1[[3]][1])
}
commandcolor.data<-as.data.frame(commandcolor.data)
names(commandcolor.data)<-c('name', 'color', 'font')
}
default.data<-data.frame(name=replicate(16,'default'),
color=c('\\red0\\green0\\blue0',
'\\red0\\green0\\blue255',
'\\red0\\green255\\blue255',
'\\red0\\green255\\blue0',
'\\red255\\green0\\blue255',
'\\red255\\green0\\blue0',
'\\red255\\green255\\blue0',
'\\red255\\green255\\blue255',
'\\red0\\green0\\blue128',
'\\red0\\green128\\blue128',
'\\red0\\green128\\blue0',
'\\red128\\green0\\blue128',
'\\red128\\green0\\blue0',
'\\red128\\green128\\blue0',
'\\red128\\green128\\blue128',
'\\red192\\green192\\blue192'),
font=replicate(16,NA))
color<-rbind(default.data,definecolor.data, commandcolor.data)
color.unique<-data.frame(color=unique(color$color))
color.unique$rtfcolororder<-paste('\\cf', seq(2, nrow(color.unique)+1), ' ',sep='')
rtfcolorcode<-paste('{\\colortbl;', paste(color.unique$color, collapse=';'), ';}')
color<-merge(color, color.unique, all.x=T, by='color', sort=F)
color<-color[!duplicated(color),]
#Part 1. Preprocessing Functions
#Function Set5: rtfrow.color, rtfrow.verbatim0, kframeblock, knitrfig, knitoutrblock
#rtfrow.color: Function to convert color text of R code chuncks
rtfrow.color<-function(y){
x<-sub(".*?\\\\begin\\{alltt\\}(.*?)\\\\end\\{alltt\\}.*", "\\1", y)
x<-trim(x)
x<-trim2(x)
clcolorsub<-function(x, n){
parentheses.l<-paste(trim(color$name[n]), '{', sep='')
parentheses.r<-'}'
parentheses.m<-sub(paste(".*?", paste(trim(color$name[n]), '\\{', sep=''), "(.*?)", '\\}', ".*", sep=''), "\\1", x)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste(color$rtfcolororder[n],parentheses.m, sep='' )
x<-sub(latex.c, rtf.c, x, fixed=T)
x
}
n1<-NROW(color)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(trim(color$name[n]), x)/(nchar(trim(color$name[n]))-1)
for (j in 1:n2){
x<-clcolorsub(x, n)
}
}
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='shadecolor'][1])],4,5))
x<-gsub("Connect3BEGIN",paste("{\\trowd \\clcbpat", shade.n, "\\cellx9500{\\pard\\intbl\\ql{", sep=''), x, fixed=T)
x<-gsub("Connect3END", "}\\cell}\\row}",x, fixed=T)
x<-gsub("$","\\u036\\0",x, fixed=T)
y<-sub(paste("\\begin{alltt}", sub(".*?\\\\begin\\{alltt\\}(.*?)\\\\end\\{alltt\\}.*", "\\1", y), "\\end{alltt}", sep=''),x, y, fixed=T)
y
}
#rtfrow.verbatim0: function to convert verbatim text
rtfrow.verbatim0<-function(shade.n, verbatim.color){
function(y){
x<-sub(".*?\\\\begin\\{verbatim\\}(.*?)\\\\end\\{verbatim\\}.*", "\\1", y)
x<-trim(x)
x<-trim2(x)
table.ncol<-countCharOccurrences('+', sub(".*?Connect3BEGIN ## \\+(.*?)Connect3END.*", "\\1", x))
cell.width<-round(9500/table.ncol,0)
n.plus<-countCharOccurrences('Connect3BEGIN ## +', x)/18
for (j in 1:n.plus){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.shade<-paste("\\clcbpat", shade.n, '\\cell',sep='')
row.top<-gsub('\\cell', cell.shade, row.top, fixed=T)
x<-sub('Connect3BEGIN ## +', paste(row.top, '{\\pard\\intbl\\ql{## +', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('-+-', paste('-+}\\cell}{\\pard\\intbl\\ql{-', sep=''),x,fixed=T)
}
x<-sub('-+Connect3END', paste('-+}\\cell}\\row}', sep=''),x,fixed=T)
}
n.vertical<-countCharOccurrences('Connect3BEGIN ## |', x)/18
for (j in 1:n.vertical){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.shade<-paste("\\clcbpat", shade.n, '\\cell',sep='')
row.top<-gsub('\\cell', cell.shade, row.top, fixed=T)
x<-sub('Connect3BEGIN ## |', paste(row.top, '{\\pard\\intbl\\ql{##', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('|', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub('|Connect3END', paste('}\\cell}\\row}', sep=''),x,fixed=T)
}
x<-gsub("Connect3BEGIN", paste("{\\trowd \\clcbpat", shade.n, "\\cellx9500{\\pard\\intbl\\ql { ", verbatim.color,sep=''), x, fixed=T)
x<-gsub("Connect3END", "}\\cell}\\row}",x, fixed=T)
x<-gsub("$","\\u036\\0",x, fixed=T)
y<-sub(paste("\\begin{verbatim}", sub(".*?\\\\begin\\{verbatim\\}(.*?)\\\\end\\{verbatim\\}.*", "\\1", y), "\\end{verbatim}", sep=''), x, y, fixed=T)
y
}
}
#kframeblock, knitrfig, knitoutrblock: functions to convert R chunck blocks and figures
kframeblock<-function(x){
rtf.content<-sub(".*?\\\\begin\\{kframe\\}(.*?)\\\\end\\{kframe\\}.*", "\\1", x)
rtf.content<-gsub("Connect3END|Connect3BEGIN", "",rtf.content )
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd", rtf.content)
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
rtf.content
}
knitrfig<-function(y){
path<-sub("\\\\\\\\", "//", path)
figure.name<-sub(".*?\\{figure/(.*?)\\}.*", "\\1", y)
figure.path<-paste(path, "/figure/",figure.name, ".png", sep='')
rtf.figure<-paste('{\\field\\fldedit{\\*\\fldinst { INCLUDEPICTURE \\\\d', figure.path, '\\\\* MERGEFORMATINET }}{\\fldrslt { }}}', sep='')
rtf.figure
}
knitoutrblock<-function(x){
x.o<-x
n<-countCharOccurrences("begin{kframe}", tex)/13
rtf.content<-rep(NA, n)
for (i in 1:n){
rtf.content[i]<-paste(kframeblock(x),"\\pard \\par")
block1.o<-paste("\\begin{kframe}", sub(".*?\\\\begin\\{kframe\\}(.*?)\\\\end\\{kframe\\}.*", "\\1", x),"\\end{kframe}",sep='')
x<-sub(block1.o, '', x, fixed=T)
x.o<-sub(block1.o,rtf.content[i], x.o, fixed=T)
}
n<-countCharOccurrences("includegraphics", x)/15
rtf.fig<-rep(NA, n)
y<-x.o
if (n!=0){
for (i in 1:n){
rtf.fig[i]<-paste(knitrfig(y), "\\pard \\par")
block1.o<-paste("\\includegraphics", sub(".*?includegraphics(.*?)\\}.*", "\\1", y),"}",sep='')
y<-sub(block1.o, '', y, fixed=T)
x.o<-sub(block1.o,rtf.fig[i], x.o, fixed=T)
}
}
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd",x.o )
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
rtf.content<-sub(".*?\\{\\\\trowd", "\\\\pard \\\\par \\{\\\\trowd", rtf.content)
rtf.content
}
#Part 1. Preprocessing Functions
#Function Set6: inputtable.describe, inputtable.summary (functions to Hmisc latex generated tables)
#inputtable.describe: function to convert Hmisc describe
inputtable.describe<-function(x){
#Read table input R
path<-sub("\\\\\\\\", "//", path)
table.name<-sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content)
table.path<-paste(path, "/",table.name, ".tex", sep='')
file<-table.path
tex<-read.latex(file,path)$tex
n<-countCharOccurrences("begin{picture}", tex)/14
for (i in 1:n){
parentheses.l<-'\\setlength'
parentheses.r<-'\\end{picture}'
parentheses.m<-sub(".*?\\\\setlength(.*?)\\\\end\\{picture\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
tex<-sub(latex.c, '', tex, fixed=T)
tex
}
n<-countCharOccurrences("textbf", tex)/6
for (i in 1:n){
parentheses.l<-'\\textbf{'
parentheses.r<-'}'
parentheses.m<-sub(".*?\\\\textbf\\{(.*?)\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste('\\b ',parentheses.m, ' \\b0 ',sep='' )
tex<-sub(latex.c, rtf.c, tex, fixed=T)
tex
}
n<-countCharOccurrences("begin{center}", tex)/13
for (i in 1:n){
parentheses.l<-'\\begin{center}'
parentheses.r<-'\\end{center}'
parentheses.m<-sub(".*?\\\\begin\\{center\\}(.*?)\\\\end\\{center\\}.*", "\\1", tex)
parentheses.m.c<-gsub("\\\\\\\\", "\\\\\\line", parentheses.m)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c<-paste('\\qc ',parentheses.m.c, ' \\qc0 ',sep='' )
tex<-sub(latex.c, rtf.c, tex, fixed=T)
tex
}
n<-countCharOccurrences("begin{tabular}", tex)/14
for (i in 1:n){
parentheses.l<-'\\begin{tabular}'
parentheses.r<-'\\end{tabular}'
parentheses.m<-sub(".*?\\\\begin\\{tabular\\}(.*?)\\\\end\\{tabular\\}.*", "\\1", tex)
latex.c<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
latex.c.o<-latex.c
col.adj<-trim(gsub('.*\\\\begin\\{tabular\\}\\{(.*?)\\}.*', "\\1", latex.c))
table.ncol<-nchar(col.adj)
table.nrow<-countCharOccurrences("&", latex.c)/(table.ncol-1)
for (i in 1:table.nrow){
for (k in 2: table.ncol){
latex.c<-sub('&', paste('}\\cell}{\\pard\\intbl\\q',strsplit(col.adj,'')[[1]][k],'{', sep=''),latex.c,fixed=T)
}
}
row.top<-'{\\trowd'
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx', (7*i),'00 ', sep='')
}
row.top<-paste(row.top,'{\\pard\\intbl\\q', strsplit(col.adj,'')[[1]][1] ,'{', sep='')
latex.c<-sub('Connect3END Connect3BEGIN', row.top,latex.c, fixed=T)
row.bottom<-'}\\cell}\\row}{\\trowd'
for (i in 1:table.ncol){
row.bottom<-paste(row.bottom,'\\cellx', (7*i),'00', sep='')
}
row.bottom<-paste(row.bottom, '{\\pard\\intbl\\q', strsplit(col.adj,'')[[1]][1],'{', sep='')
latex.c<-sub('\\\\Connect3END Connect3BEGIN', row.bottom,latex.c, fixed=T)
latex.c<-gsub('\\end{tabular}', '}\\cell}\\row}',latex.c, fixed=T)
latex.c<-sub(".*?\\{\\\\trowd", "\\{\\\\trowd",latex.c)
tex<-sub(latex.c.o, latex.c, tex, fixed=T)
}
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color=='\\red255\\green255\\blue255')],4,5))
verbatim.color<-trim(color.unique$rtfcolororder[which(color.unique$color=='\\red0\\green0\\blue0')])
rtfrow.verbatim2<-rtfrow.verbatim0(shade.n, verbatim.color)
n<-countCharOccurrences("begin{verbatim}", tex)/15
for (i in 1:n){
y<-tex
tex<-rtfrow.verbatim2(y)
}
tex<-gsub("\\smallskip\\hrule\\smallskip", " \\brdrb\\brdrs\\brdrw10\\brsp20 ", tex, fixed=T)
tex<-gsub("\\noindent", " \\fi0 ", tex, fixed=T)
tex<-gsub("\\begin{spacing}{0.7}", "",tex, fixed=T)
tex<-gsub("\\end{spacing}", "",tex, fixed=T)
tex<-gsub("{\\smaller", "",tex, fixed=T)
tex<-gsub("{\\small", "",tex, fixed=T)
tex<-gsub("\\vbox{", "",tex, fixed=T)
tex<-gsub("} \\vbox{", "",tex, fixed=T)
tex<-gsub("\\begin{spacing}{0.7}", "",tex, fixed=T)
tex<-gsub("} }\\end{spacing} ", "",tex, fixed=T)
tex<-gsub("~", " ",tex, fixed=T)
tex<-gsub("Connect3END Connect3BEGIN }Connect3END Connect3BEGIN", "Connect3END Connect3BEGIN Connect3END Connect3BEGIN",tex, fixed=T)
tex<-gsub("Connect3BEGIN", "\\pard",tex, fixed=T)
tex<-gsub("Connect3END", "\\par",tex, fixed=T)
tex<-gsub("\\pard \\par", "",tex, fixed=T)
tex<-gsub("\\pard } \\par", "",tex, fixed=T)
tex<-paste('\\fs20', tex)
tex
}
#inputtable.summary: function to convert Hmisc summary
inputtable.summary<-function(rtf.content){
#Read table input R
path<-sub("\\\\\\\\", "//", path)
table.name<-sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content)
table.path<-paste(path, "/",table.name, ".tex", sep='')
file<-table.path
tex<-read.latex(file, path)$tex
decision<-nchar(sub(".*?latex.default(.*?)\\).*", "\\1", tex))
if (decision<nchar(tex)){
x<-sub(".*?\\\\begin\\{table\\}(.*?)\\\\end\\{table\\}.*", "\\1", tex)
#1. Caption
caption<-sub(".*?\\\\caption\\{(.*?)\\}.*", "\\1", x)
if (caption==x){
caption<-''
}else{
caption<-paste("{\\pard\\qc",sub("\\\\label\\{.*", "\\1", caption), "\\par}")
}
#2. FootNote
footnote<-sub(".*?\\\\noindent", "\\1", x)
if (footnote==x){
footnote<-''
}else{
footnote<-sub("\\\\label\\{.*", "\\1", footnote)
footnote<-paste("{\\pard\\fi-500\\li0\\ri0",footnote, "\\par}")
}
#3. Table Body
table.ncol<-nchar(sub(".*?begin\\{tabular\\}\\{(.*?)\\}.*", "\\1", x))
list5<-unlist(strsplit(sub(".*?begin\\{tabular\\}\\{(.*?)\\}.*", "\\1", x), ''))
cell.width<-round(9500/table.ncol,0)
x<-sub(".*?\\\\begin\\{tabular\\}(.*?)\\\\end\\{tabular\\}.*", "\\1", x)
x<-sub(".*?\\hline", "\\1", x)
x<-sub(".*?Connect3BEGIN", "\\1", x)
x<-gsub("Connect3END", "\\1", x)
x<-gsub("Connect3BEGIN", "\\1", x)
x<-gsub("\\\\hline", "\\1", x)
x<-paste("\\tabularnewline", x)
#Calculate multicolumn rows
list0<-unlist(strsplit(x, "multicolumn"))
list0<-sub(".*?\\{(.*?)}.*", "\\1", list0)
list0<-as.numeric(list0[-1])
multicol.n.r<-ceiling(sum(list0)/table.ncol)
for (a in 1:multicol.n.r){
x2<-sub(".*?\\\\tabularnewline(.*?)\\\\tabularnewline.*", "\\1", x)
x2.o<-paste('\\tabularnewline', x2, sep='')
n.multicol<-countCharOccurrences('multicolumn', x2)/11
#Extract multicolumn columns
list1<-unlist(strsplit(x2, "multicolumn"))
list1<-sub(".*?\\{(.*?)}.*", "\\1", list1)
list1<-as.numeric(list1[-1])
#Extract column alignment
list1a<-unlist(strsplit(x2, "multicolumn"))[-1]
list1a<-sub("\\{.\\}\\{(.*?)}.*", "\\1", list1a)
#Remove non-neccessary information
x2<-gsub('\\bfseries', '\\b', x2, fixed=T)
x2<-gsub('{l}', '', x2, fixed=T)
x2<-gsub('{c}', '', x2, fixed=T)
x2<-gsub('{r}', '', x2, fixed=T)
if (sum(list1)!=table.ncol){
list1a<-unlist(strsplit(x2.o, "multicolumn"))
list1a<-sub("\\{.\\}\\{(.*?)}.*", "\\1", list1a)
list1a<-gsub('&', 'l', list1a, fixed=T)
list1a<-gsub('\\', '', list1a, fixed=T)
list1a<-gsub('tabularnewline', '', list1a, fixed=T)
list1a<-trim(paste(list1a, collapse=''))
if (nchar(list1a<table.ncol)){
list1a<-paste(list1a, 'l', sep='')
}
list1a<-unlist(strsplit(list1a, ""))
x2 <-gsub("&\\s*&", "&\\\\multicolumn{1}{}&", x2)
x2 <-gsub("^\\s*&", "\\\\multicolumn{1}{}&", x2)
x2 <-gsub("&\\s*$", "&\\\\multicolumn{1}{}", x2)
n.multicol<-countCharOccurrences('multicolumn', x2)/11
}
if (n.multicol!= table.ncol){
list1c<-unlist(strsplit(x2, "\\\\multicolumn"))[-1]
for (i in 1:length(list1)){
if (list1[i]!=1){
list1c[i]<-sub("\\{.\\}", "\\{1\\}", list1c[i])
list1c[i]<-paste(list1c[i], paste(replicate(list1[i]-1, "\\multicolumn{1}{}&"), collapse=''), sep='')
list1a[i]<-paste(replicate(list1[i], list1a[i]), collapse='')
}
}
list1c<-paste('\\multicolumn', list1c, sep='')
list1a<-paste(list1a, collapse='')
list1a<-unlist(strsplit(list1a, ''))
x2<-paste(list1c, collapse='')
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
row.top<-unlist(strsplit(row.top, "x"))
for (i in 1:length(list1)){
if (list1[i]!=1){
n.start <-sum(list1[1:(i-1)])+1
n.end<-sum(list1[1:i])
row.top[n.start]<-gsub("\\cell", "\\clmgf\\cell",row.top[n.start], fixed=T)
row.top[(n.start+1): n.end]<-gsub("\\cell","\\clmrg\\cell", row.top[(n.start+1): n.end], fixed=T)
}
}
row.top<-paste( row.top, collapse='')
row.top<-gsub("\\cell","\\cellx", row.top, fixed=T)
}else{
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
}
#Add border
if (nchar(sub(".*?\\\\cline\\{(.*?)\\}.*", "\\1", x2))!=nchar(x2)){
##Calculate multicolumn rows
list2<-unlist(strsplit(x2, " \\\\cline"))
list2<-sub(".*?\\{(.*?)}.*", "\\1", list2)
list2<-list2[-1]
row.top<-unlist(strsplit(row.top, "x"))
for (i in 1:length(list2)){
n.start <-as.numeric(unlist(strsplit(list2[i], "-")))[1]
n.end<-as.numeric(unlist(strsplit(list2[i], "-")))[2]
row.top[n.start:n.end]<-gsub("\\cell", "\\clbrdrt\\brdrs\\cell",row.top[n.start:n.end], fixed=T)
}
row.top<-paste( row.top, collapse='')
row.top<-gsub("\\cell","\\cellx", row.top, fixed=T)
x2<-gsub('\\\\cline\\{.*?\\}', '', x2)
}
x2<-gsub('\\multicolumn{1}{', '', x2, fixed=T)
x2<-gsub('}&', '&', x2, fixed=T)
x2<-gsub('&}', '&', x2, fixed=T)
x2<-gsub('&\\s*$', '&\\}', x2)
x2<-paste('\\tabularnewline',x2, '\\tabularnewline')
x2<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x2, fixed=T)
for (i in 2: table.ncol){
x2<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x2,fixed=T)
}
x2<-sub("\\tabularnewline", "\\cell}\\row}", x2, fixed=T)
#Add column alignment
list3<-unlist(strsplit(x2, "\\\\pard\\\\intbl"))
list1a<-paste('\\\\pard\\\\intbl\\\\q', list1a, sep='')
for (i in 2:length(list3)){
list3[i]<-sub('\\\\q.', list1a[i-1], list3[i])
}
x2<-paste(list3, collapse='')
x<-sub(x2.o, x2,x, fixed=T)
}
n.vertical<-countCharOccurrences('&', x)/(table.ncol-1)
#Top row
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.border<-"\\clbrdrt\\brdrs\\cell"
row.top<-gsub('\\cell', cell.border, row.top, fixed=T)
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
#Middle rows
for (j in 1:(n.vertical-2)){
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
}
#Bottom rows
row.top<-"{\\trowd "
for (i in 1:table.ncol){
row.top<-paste(row.top,'\\cellx',(i*cell.width), sep='')
}
cell.border<-"\\clbrdrb\\brdrs\\cell"
row.top<-gsub('\\cell', cell.border, row.top, fixed=T)
x<-sub('\\tabularnewline', paste(row.top, '{\\pard\\intbl\\ql{', sep=''), x, fixed=T)
for (i in 2: table.ncol){
x<-sub('&', paste('}\\cell}{\\pard\\intbl\\ql{', sep=''),x,fixed=T)
}
x<-sub("\\tabularnewline", "}\\cell}\\row}\\tabularnewline", x, fixed=T)
x<-gsub('\\textless', '<', x, fixed=T)
x<-gsub("\\\\tabularnewline", "\\1", x)
#Add border to top row
x3<-sub(".*?\\{\\\\trowd(.*?)\\{\\\\pard\\\\intbl.*", "\\1", x)
x3.o<-x3
x3<-unlist(strsplit(x3, "x"))
x3<-gsub("\\cell","\\clbrdrt\\brdrs\\cellx", x3, fixed=T)
x3<-paste( x3, collapse='')
x<-sub(x3.o, x3, x, fixed=T)
#Add column alignment
list4<-unlist(strsplit(x, "\\\\pard\\\\intbl"))
list5<-rep(paste('\\\\pard\\\\intbl\\\\q', list5, sep=''), n.vertical )
for (i in 2:(table.ncol*multicol.n.r+1)){
list4[i]<-sub('\\\\q', '\\\\pard\\\\intbl\\\\q', list4[i])
}
for (i in (table.ncol*multicol.n.r+2):length(list4)){
list4[i]<-sub('\\\\q.', list5[i-(table.ncol*multicol.n.r+1)], list4[i])
}
x<-paste(list4, collapse='')
#Remove leading and trailing space for each cell
x<-gsub('\\\\pard\\\\intbl\\\\qr\\{\\s+', '\\\\pard\\\\intbl\\\\qr\\{', x)
x<-gsub('\\\\pard\\\\intbl\\\\ql\\{\\s+', '\\\\pard\\\\intbl\\\\ql\\{', x)
x<-gsub('\\\\pard\\\\intbl\\\\qc\\{\\s+', '\\\\pard\\\\intbl\\\\qc\\{', x)
x<-gsub('~', ' ', x)
x<-gsub('\\%', '%', x, fixed=T)
x<-paste(caption, x, footnote)
}
n.mathmode<-countCharOccurrences('$', x)/2
for (i in 1:n.mathmode){
x<-mathmode(x)
}
x
}
##Part 1. Preprocessing Functions
#Function Set7: description, enumerate, itemize
#description
description<-function(x){
parentheses.l<-"\\begin{description}"
parentheses.r<-"\\end{description}"
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
latex.c<-unlist(strsplit(latex.c, parentheses.r, fixed=T))[1]
rtf.c<-latex.c
item<-function(x2){
parentheses.l<-'\\item['
parentheses.r<-']'
parentheses.m<-sub(".*?\\\\item\\[(.*?)\\].*", "\\1", x2)
latex.c2<-paste(parentheses.l, parentheses.m, parentheses.r, sep='')
rtf.c2<-paste('\\line \\tab \\b ', parentheses.m, '\\b0 ', sep='')
x2<-sub(latex.c2, rtf.c2, x2, fixed=T)
x2
}
n<-countCharOccurrences('\\item[', latex.c)/6
for (i in 1:n){
rtf.c<-item(rtf.c)
}
x<-sub(paste("\\begin{description}", latex.c, "\\end{description}", sep=''), rtf.c, x, fixed=T)
x
}
#enumerate2: level2 enumerate function
enumerate2<-function(x){
parentheses.l<-"\\begin{enumerate}"
parentheses.r<-'\\end{enumerate}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 (", letters[seq( from = 1, to = n )][i], ") \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#itemize2: level2 itemize function
itemize2<-function(x){
parentheses.l<-"\\begin{itemize}"
parentheses.r<-'\\end{itemize}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#enumerate1: level1 enumerate function
enumerate1<-function(x){
parentheses.l<-"\\begin{enumerate}"
parentheses.r<-'\\end{enumerate}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
if (grepl("\\begin{itemize}", latex.c, fixed=T)){
latex.c2<-itemize2(latex.c)
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c2, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\b1 ", i, ". \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{enumerate}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{enumerate}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , paste("\\line \\tab \\tab \\b1 (", letters[seq( from = 1, to = n )][i], ") \\b0", sep='') , target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#itemize1: level1 itemize function
itemize1<-function(x){
parentheses.l<-"\\begin{itemize}"
parentheses.r<-'\\end{itemize}'
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[2]
if (grepl(parentheses.r, latex.c, fixed=T)) {
if (grepl("\\begin{enumerate}", latex.c, fixed=T)){
latex.c2<-enumerate2(latex.c)
target<-sub(parentheses.r,"\\end++{itemize}",latex.c2, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}else{
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target,"\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
}else{
latex.c<-unlist(strsplit(x, parentheses.l, fixed=T))[3]
target<-sub(parentheses.r,"\\end++{itemize}",latex.c, fixed=T)
target<-unlist(strsplit(target, "\\end++{itemize}", fixed=T))
target.1<-target[1]
target.2<-target[2]
n<-countCharOccurrences("\\item", target.1)/5
for (i in 1:n){
target.1<-sub("\\item" , "\\line \\tab \\tab \\bullet ", target.1, fixed=T)
}
rtf.c<-paste(target.1, parentheses.r, target.2, sep='')
x<-sub(paste(parentheses.l,latex.c, sep=''), rtf.c, x, fixed=T)
x<-sub(parentheses.r, '', x, fixed=T)
}
x
}
#End of Part 1. Preprocessing Functions
#################################################################################################
#Part 2. Stepwise Translation
#Step 1: load read.latex object and initial minor prunings
path<-path
rtf<-tex
rtf<-gsub('\\\\', '\\line ', rtf, fixed=T)
rtf<-gsub('\\definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\\color{fgcolor}', '', rtf, fixed=T)
rtf<-gsub('\\begin{figure}[!ht]', '', rtf, fixed=T)
rtf<-gsub('\\begin{figure}[!tbp]', '', rtf, fixed=T)
rtf<-gsub('\\end{figure}', '', rtf, fixed=T)
#Remove Latex comments
n.step1<-countCharOccurrences("Connect3BEGIN %", tex)/nchar("Connect3BEGIN %")
for (i in 1:n.step1){
rtf<-sub(paste('Connect3BEGIN %',sub("^.*Connect3BEGIN %(.*?)Connect3END.*", "\\1", rtf), 'Connect3END', sep=''), '', rtf, fixed=T)
}
#Part 2. Stepwise Translation
#Step 2: color of R code chunks
n.step2<-countCharOccurrences("begin{alltt}", tex)/nchar("begin{alltt}")
for (i in 1:n.step2){
rtf<-rtfrow.color(rtf)
}
#Part 2. Stepwise Translation
#Step 3: verbatim of R code chunks
shade.n<-trim(substr(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='shadecolor'][1])],4,5))
verbatim.color<-trim(color.unique$rtfcolororder[which(color.unique$color==color$color[color$name=='\\hlstd'][1])])
rtfrow.verbatim<-rtfrow.verbatim0(shade.n, verbatim.color)
n.step3<-countCharOccurrences("begin{verbatim}", tex)/15
for (i in 1:n.step3){
rtf<-rtfrow.verbatim(rtf)
}
#Part 2. Stepwise Translation
#Step 4: struction and figure of R code chunks
z<-sub(".*?\\\\begin\\{document\\}(.*?)\\\\end\\{document\\}.*", "\\1", rtf)
rtf.content<-z
n.step4<-countCharOccurrences("begin{knitrout}", z)/15
knitrout.content<-rep(NA, n.step4)
for (i in 1:n.step4){
x<-sub(".*?\\\\begin\\{knitrout\\}(.*?)\\\\end\\{knitrout\\}.*", "\\1", z)
knitrout.content[i]<-knitoutrblock(x)
knitrout.block<-paste("\\begin{knitrout}",sub(".*?\\\\begin\\{knitrout\\}(.*?)\\\\end\\{knitrout\\}.*", "\\1", x), "\\end{knitrout}", sep='')
z<-sub(knitrout.block, "", z, fixed=T)
rtf.content<-sub(knitrout.block, knitrout.content[i], rtf.content, fixed=T)
}
#Reduce multiple 'Connect3BEGIN Connect3END' to one
rtf.content<-unlist(strsplit(rtf.content, 'Connect3BEGIN Connect3END'))
rtf.content<-rtf.content[rtf.content!=' ']
rtf.content<-paste(rtf.content, collapse='\\pard \\par')
rtf.content<-gsub('Connect3BEGIN', '', rtf.content, fixed=T)
rtf.content<-gsub('Connect3END', '', rtf.content, fixed=T)
rtf.content<-gsub('\\clearpage', '', rtf.content, fixed=T)
rtf.content<-gsub("\\newpage","\\pard \\insrsid \\page \\par" , rtf.content, fixed=T)
rtf.content<-gsub("\\s+\\{\\\\trowd", "\\{\\\\trowd", rtf.content)
rtf.content<-gsub("\\\\cell\\}\\\\row\\}\\s+", "\\\\cell\\}\\\\row\\}", rtf.content)
#Part 2. Stepwise Translation
#Step 5: Hmisc tables
n.step5<-countCharOccurrences('\\input{', rtf.content)/nchar('\\input{')
n.table<-data.frame(tablename=rep(NA, n.step5), tabletype=rep(NA, n.step5), tablenumbering=rep(NA, n.step5))
tmp<-rtf.content
if (n.step5!=0){
for (i in 1:n.step5){
path<-sub("\\\\\\\\", "//", path)
n.table$tablename[i]<-sub(".*?input\\{(.*?)\\}.*", "\\1", tmp)
table.path<-paste(path, "/",n.table$tablename[i], ".tex", sep='')
file<-table.path
table.tex<-read.latex(file, path)$tex
decision<-nchar(sub(".*?latex.default(.*?)\\).*", "\\1", table.tex))
if (decision==nchar(table.tex)){
n.table$tabletype[i]<-'hmisc.describe'
n.table$tablenumbering[i]<-i
}
if (decision<nchar(table.tex)){
n.table$tabletype[i]<-'hmisc.summary'
n.table$tablenumbering[i]<-i
}
tmp<-sub("\\input{", "", tmp, fixed=T)
}
n.table$tablenumbering<-n.table$tablenumbering-sum(n.table$tabletype=='hmisc.describe')
for (i in 1:n.step5){
if (n.table$tabletype[i]=='hmisc.describe'){
rtf.table<-inputtable.describe(rtf.content)
rtf.content<- sub(paste("\\input{", sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content), "}", sep=''), rtf.table, rtf.content, fixed=T)
}
if (n.table$tabletype[i]=='hmisc.summary'){
rtf.table2<-inputtable.summary(rtf.content)
rtf.table2<-sub("{\\pard\\qc", paste("{\\pard\\qc Table ",n.table$tablenumbering[i], ": ", sep=''), rtf.table2, fixed=T)
rtf.content<- sub(paste("\\input{", sub(".*?input\\{(.*?)\\}.*", "\\1", rtf.content), "}", sep=''), rtf.table2, rtf.content, fixed=T)
}
}
}
#Part 2. Stepwise Translation
#Step 6: Section Numbering
list1<-gregexpr(pattern ='\\section{',rtf.content, fixed=T)
list1<-data.frame(name=rep('\\section{', length(list1[[1]])), position=list1[[1]])
if (grepl('\\subsection{', rtf.content, fixed=T)){
list2<-gregexpr(pattern ='\\subsection{',rtf.content, fixed=T)
list2<-data.frame(name=rep('\\subsection{', length(list2[[1]])), position=list2[[1]])
list.both<-rbind(list1, list2)
list.both<-list.both[order(list.both$position),]
list.both$position2<-seq(1, nrow(list.both), by=1)
list.both$position3<-NA
list.both$position3[list.both$name=='\\section{']<-seq(1, length(list.both$position3[list.both$name=='\\section{']), by=1)
breakdown<-list.both$position2[list.both$name=='\\section{']
#listnames<-paste("list", letters[seq( from = 1, to = length(breakdown))], sep='.')
list.all<-list()
for (i in 1:length(breakdown)){
if (i<=length(breakdown)-1){
list.x<-list.both[(breakdown[i]):(breakdown[i+1]-1),]
list.x$position4<-list.x$position3[1]
list.x$position5<-seq(0, nrow(list.x)-1, by=1)
list.x$position6<-paste(list.x$position4, list.x$position5, sep='.')
list.x$position6[1]<-list.x$position3[1]
list.x$position6<-paste(list.x$name,list.x$position6, ' ',sep=' ')
#list.all[[i]]<- assign(listnames[[i]], list.x)
list.all[[i]]<-list.x
}else{
list.x<-list.both[(breakdown[i]):nrow(list.both),]
list.x$position4<-list.x$position3[1]
list.x$position5<-seq(0, nrow(list.x)-1, by=1)
list.x$position6<-paste(list.x$position4, list.x$position5, sep='.')
list.x$position6[1]<-list.x$position3[1]
list.x$position6<-paste(list.x$name,list.x$position6, ' ',sep=' ')
#list.all[[i]]<- assign(listnames[[i]], list.x)
list.all[[i]]<-list.x
}
}
list.both<-do.call("rbind", list.all)
list.both.A<-list.both[which(list.both$name=='\\section{'),]
list.both.B<-list.both[which(list.both$name=='\\subsection{'),]
for (i in 1:nrow(list.both.A)){
rtf.content<-sub('\\section{', list.both.A$position6[i], rtf.content, fixed=T)
rtf.content<-sub('\\section{', '\\section++{', rtf.content, fixed=T)
}
for (i in 1:nrow(list.both.B)){
rtf.content<-sub('\\subsection{', list.both.B$position6[i], rtf.content, fixed=T)
rtf.content<-sub('\\subsection{', '\\subsection++{', rtf.content, fixed=T)
}
rtf.content<-gsub('section++{', 'section{', rtf.content, fixed=T)
}else{
list1$position1<-seq(1, nrow(list1), by=1)
list1$position2<-paste(list1$name,list1$position1, ' ',sep=' ')
for (i in 1:nrow(list1)){
rtf.content<-sub('\\section{', list1$position2[i], rtf.content, fixed=T)
rtf.content<-sub('\\section{', '\\section++{', rtf.content, fixed=T)
}
rtf.content<-gsub('section++{', 'section{', rtf.content, fixed=T)
}
#Part 2. Stepwise Translation
#Step 7: description, enumerate, itemize
rtf.content<-gsub('\\begin{enumerate}[I.]', '\\begin{enumerate}', rtf.content, fixed=T)
n<-countCharOccurrences("\\begin{description}", rtf.content)/19
if (n!=0){
for (i in 1:n){
rtf.content<-description(rtf.content)
}
}
n<-countCharOccurrences("\\begin{enumerate}", rtf.content)/17+countCharOccurrences("\\begin{itemize}", rtf.content)/15
if (n!=0){
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]>0&gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]>0){
for (i in 1:n){
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]<gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]){
rtf.content<-enumerate1(rtf.content)
}else{
rtf.content<-itemize1(rtf.content)
}
}
}else{
if (gregexpr(pattern ='\\begin{itemize}',rtf.content, fixed=T)[[1]][1]<0){
for (i in 1:n){
rtf.content<-enumerate1(rtf.content)
}
}
if (gregexpr(pattern ='\\begin{enumerate}',rtf.content, fixed=T)[[1]][1]<0){
for (i in 1:n){
rtf.content<-itemize1(rtf.content)
}
}
}
}
#Part 2. Stepwise Translation
#Step 8: Make Title
rtf.content<-sub('\\maketitle', '\\pard\\qc\\fs24 \\chdate \\par \\pard \\par', rtf.content, fixed=T)
rtf.content<-sub('\\TeX{}', '{\\plain T{\\dn6 E}X}', rtf.content, fixed=T)
#Part 2. Stepwise Translation
#Step 8: thebibliography environment
list1<-gregexpr(pattern ='\\bibitem{',rtf.content, fixed=T)
list1<-data.frame(name=rep('\\bibitem{', length(list1[[1]])), position=list1[[1]])
list1$position2<-seq(1, nrow(list1), by=1)
list1$position3<-paste('[', list1$position2, ']', sep='')
list1$position2<-paste('\\pard \\par [', list1$position2, '] ', list1$name, sep='')
list1$position4<-NA
for (i in 1:nrow(list1)){
list1$position4[i]<-sub('^.*\\\\bibitem\\{(.*?)\\}.*','\\1', rtf.content)
rtf.content<-sub('\\bibitem{', list1$position2[i], rtf.content, fixed=T)
rtf.content<-sub('\\bibitem{', '\\bibitem++{', rtf.content, fixed=T)
}
rtf.content<-gsub('bibitem++{', 'bibitem{', rtf.content, fixed=T)
list1$position4<-paste('\\cite{',list1$position4, '}', sep='')
for (i in 1:nrow(list1)){
rtf.content<-sub(list1$position4[i], list1$position3[i], rtf.content, fixed=T)
}
rtf.content<-sub(paste('\\begin{thebibliography}',sub("^.*\\\\begin\\{thebibliography\\}(.*?)\\\\par.*", "\\1", rtf.content), sep=''), '\\pard \\b References \\b0 \\par', rtf.content, fixed=T)
rtf.content<-sub('\\end{thebibliography}', '\\pard \\par', rtf.content, fixed=T)
#Part 2. Stepwise Translation
#Step 9: Command dictionary
n1<-NROW(comdictionary)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(comdictionary$latex[n], rtf.content)/(nchar(comdictionary$latex[n]))
for (j in 1:n2){
rtf.content<-commanddictionary(rtf.content, n)
}
}
rtf.content<-gsub('\\\\frac2\\s+', '\\\\frac2', rtf.content)
n1<-NROW(comdictionary)
for (i in 1:n1){
n<-i
n2<-countCharOccurrences(comdictionary$latex[n], rtf.content)/(nchar(comdictionary$latex[n]))
for (j in 1:n2){
rtf.content<-commanddictionary(rtf.content, n)
}
}
#Part 2. Stepwise Translation
#Step 10: Remove extra empty space
x<-unlist(strsplit(rtf.content, "{\\trowd", fixed=T))
for (i in 1:length(x)){
if (grepl("\\row}", x[i], fixed=T)==F){
x[i]<-gsub("\\s+", " ", x[i])
}else{
x2<-unlist(strsplit(x[i], "\\row}", fixed=T))
if (length(x2)==2){
x2[2]<-gsub("\\s+", " ", x2[2])
x[i]<-paste(x2,collapse='\\row}')
}
}
}
x<-paste(x, collapse='{\\trowd')
#Part 2. Stepwise Translation
#Step 11: Change align environment and equation environment to $ environment
n.align<-countCharOccurrences('\\begin{align}', x)/13
if (n.align!=0){
for (i in 1:n.align){
tmp0<-sub(".*?\\\\begin\\{align\\}(.*?)\\\\end\\{align\\}.*", "\\1", x)
tmp<-paste('\\pard \\par \\pard\\qc $', tmp0, '$\\qc0\\par')
tmp<-gsub('\\line', '$ \\qc0\\par \\pard\\qc $', tmp, fixed=T)
tmp<-gsub('&','',tmp, fixed=T)
x<-sub(paste('\\begin{align}', tmp0, '\\end{align}', sep=''), tmp, x, fixed=T)
}
}
n.equation<-countCharOccurrences('\\begin{equation}', x)/16
if (n.equation!=0){
for (i in 1:n.equation){
tmp0<-sub(".*?\\\\begin\\{equation\\}(.*?)\\\\end\\{equation\\}.*", "\\1", x)
tmp<-paste('\\pard\\line \\par {\\pard\\qc $', tmp0, '$\\qc0\\par}')
x<-sub(paste('\\begin{equation}', tmp0, '\\end{equation}', sep=''), tmp, x, fixed=T)
}
}
n.mathmode<-countCharOccurrences('$', x)/2
if (n.mathmode!=0){
for (i in 1:n.mathmode){
x<-mathmode(x)
}
}
#Part 2. Stepwise Translation
#Step 12: Side by side graphs
x<-gsub('{\\fldrslt { }}} \\pard \\par {\\field\\fldedit', '{\\fldrslt { }}} {\\field\\fldedit', x, fixed=T)
x<-unlist(strsplit(x, '\\\\pard \\\\par'))
x<-x[x!=' ']
x<-paste(x, collapse='\\pard \\par')
#Part 2. Stepwise Translation
#Step 13: headings and footer
rtf.head<-rtfcolorcode
footer<-"{\\footer\\pard\\plain\\f0\\fs20\\qc\\chpgn\\par}"
x<-paste("{\\rtf1\\ansi\\deff0", rtf.head,footer,x,"}", sep='')
write(x, file=paste(outputlocation,'/',name,'.rtf', sep=''))
}
Try the connect3 package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.