#
# Copyright 2006 Université de Liège, Nicolas Mazziotta, 
# sous les termes de la licence GPL2

require("Hmisc", quiet=T)

toLatex.default<- function(df,...) {toLatex.data.frame(as.data.frame(df[]),...)}
toLatex.table<- function(df,...) {toLatex.data.frame(df,...)}




toLatex.tricroise<- function(tri, caption=NULL, label=NULL, float.type="table", position="H", contrib.stat=TRUE, test=T, ...) {
	maincaption<-caption
	if (test==T) {
		float<-c(paste("\\begin{",float.type,"}[",position,"]\\centering\n{\\scriptsize", sep=""))
	} else {
		float<-"\n{\\scriptsize"
	}
	table.float.type<-"tabular";
	table.caption<-NULL;
	table.label<-NULL;
	if (test==F) { 
		table.caption<-caption
		table.label<-label
		table.float.type<-"longtable" 
	}
	float<-c(float, toLatex(tri$tab, total.cols=TRUE, float.type=table.float.type, caption=table.caption, label=table.label, ...))

	if (!is.null(tri$pem) & test ) {
		tri$chi2contrib<-tri$chi2contrib*sign(tri$pem)
		# tri$pem<-paste("$",tri$pem,"$", sep="")
		if (!(dim(tri$tab)[1] == 2 & dim(tri$tab)[2] == 2)) {
		contrib.dim<-dim(tri$chi2contrib)
		#new.names<-c(colnames(tri$chi2contrib), "PRB")
		tri$chi2contrib<-paste('$',tri$chi2contrib,'$')
		dim(tri$chi2contrib)<-contrib.dim
		if (contrib.stat) {
		tri$chi2contrib<-ifelse(
			is.na(tri$chi2signif), paste( tri$chi2contrib ,"{\\tiny \\ding{73}\\ding{73}\\ding{73}}"),
			ifelse(tri$chi2signif>=0.01, paste( tri$chi2contrib ,"{\\tiny \\ding{73}\\ding{73}\\ding{72}}"), 
			ifelse(tri$chi2signif>=0.001, paste( tri$chi2contrib ,"{\\tiny \\ding{73}\\ding{72}\\ding{72}}"), 
			paste( tri$chi2contrib ,"{\\tiny \\ding{72}\\ding{72}\\ding{72}}"))
			))
		}
		#colnames(tri$chi2contrib)<-new.names
		}
		float<-c(float, texCommand("hspace", "2em"))
		if (!is.null(tri$chi2contrib)) {
			if (!is.null(tri$oddsratio)) {
				tri$chi2contrib<-rbind(tri$chi2contrib,c("\\cmidrule{1-2}$\\theta$",paste("\\emph{",format(ifelse(tri$oddsratio >=1, tri$oddsratio, 1/tri$oddsratio), dig=3),"}", sep="")))
			}
			float<-c(float, toLatex(tri$chi2contrib, rownames=F, caption=NULL, total.cols=FALSE, total.rows=FALSE))
		}
	}
	float<-c(float, "\\vspace{5pt}")
	if (test) {
	if (!is.null(tri$fisher)) {
		float<-c(float, paste("\n\n Test exact de Fisher,", "$ p = $", starredprb(tri$fisher$p.value)))
		if (tri$multiple) { float<-c(float, paste( "\n\n Après ajustement de \\v{S}idàk pour ",tri$multiple,"	comparaisons", ": ", starredprb(tri$fisher$p.value, p.values=tri$sidak, stars=T)," (seuils: ", format(tri$sidak[1], dig=3), ", ", format(tri$sidak[2], dig=3), ", ", format(tri$sidak[3], dig=3),")",  sep=""))	}
	} else {

			if (tri$chi2minexp >= 5) {
				float<-c(float, paste( "\n\n $\\chi^2 = ", round(tri$chi2$stat, dig=2),	"$, $ddl = ", tri$chi2$parameter, "$, $p = $",		sep=""))	
				float<-c(float, starredprb(tri$chi2$p.value))

		if (tri$multiple) { float<-c(float, paste( "\n\n Après ajustement de \\v{S}idàk pour ",tri$multiple,"	comparaisons", ": ", starredprb(tri$chi2$p.value, p.values=tri$sidak, stars=T), " (seuils: ", format(tri$sidak[1], dig=3), ", ", format(tri$sidak[2],dig=3), ", ", format(tri$sidak[3],dig=3),")", sep=""))	}

			}
			else { float<-c(float, paste("\n\n$\\chi^2$ et test exact de Fisher inadaptés"))	}
		}
		
		if (tri$chi2minexp < 10) float<-c(float, paste("\n\nValeur attendue minimale =", format(tri$chi2minexp, dig=3)))
	}

		float<-c(float, "}")
		if (test==T) {
		float<-c(float, texCommand("caption", maincaption))
		if (!is.null(label))  { float<-c(float, "", texCommand("label", label)) }
		float<-c(float, paste("\\end{",float.type,"}\n", sep=""))
		}
	return(float)
}

toLatexFig <-function(file, caption=NULL, angle=270, position="H", scale=1, label=NULL, wrap=T,...) {
	dev.print(..., file=paste(file,"ps", sep="."))
	system(paste("ps2eps -g -f -P -B -C -l ", file,".ps && rm ", file,".ps", sep=""))
	sink(paste(file,"tex", sep="."))
	if (wrap==T) catlat(paste('\\begin{figure}[',position,']\\centering', sep=""))
	catlat(paste('\\includegraphics[angle=',angle,',width=',scale,'\\textwidth]{', sep=""))
	catlat(paste(file,"eps",sep="."))
	cat('}')
	if (!is.null(caption)) { catlat(paste('\\caption{',caption,'}', sep="")) }
	if (!is.null(label)) { catlat(paste('\\label{',label,'}', sep="")) }
	if (wrap==T) catlat("\\end{figure}")
	sink()
	#system(paste("convert -rotate 90 ", file,".eps ", file, ".png", sep=""))
	#sink(paste(file,"html", sep="."))
	#cat("<div class='graphics'><img src='")
	#catlat(paste(gsub(".*/(.*?)$","\\1",file), "png", sep="."))
	#cat("' alt='no description'/><div class='caption'>")
	#catlat(caption)
	#cat("</div></div>")
	#sink()		
}

toLatex.spec<-function(spec, caption=NULL, sign=NULL, ...) {
	spec<-spec$tab;
	if (!is.null(sign)){
		if (sign == "+") { spec<-spec[spec[,"SPC"]>0,] } 
		else if (sign == "-") {	spec<-spec[spec[,"SPC"]<0,]	}
	}
	spec[,"SPC"]<-ifelse(spec[,"SPC"]>0, "$+$", "$-$")
	spec[,"PRB"]<-paste("$", format(spec[,"PRB"],digits=2),"$", sep="")
#	spec[,"PRB"]<-paste("$", format(spec[,"PRB"],digits=2),"$", c(
#			ifelse(spec[,"PRB"] >.001, " \\ding{73}\\ding{73}\\ding{73}", 
#			ifelse(spec[,"PRB"] >.0001, " \\ding{73}\\ding{73}\\ding{72}", ifelse(spec[,"PRB"] >.00001, " \\ding{73}\\ding{72}\\ding{72}", " \\ding{72}\\ding{72}\\ding{72}")))))
	float<-toLatex.data.frame(spec, caption=caption, total.cols=FALSE, total.rows=FALSE, ...)
	
	return(float)
}

toLatex.coasummary <- function(summary, print.rows=F, print.cols=T, f=1:2, merge=F, caption=NULL, ...) {
	latex<-list()
	if (merge==TRUE) {
			i<-min(f)
			j<-max(f)
			i<-(i-1)*3+1
			j<-j*3
			if (print.cols) {
					while (dim(summary$cols)[2] < j) { j <- j-3} 
					toprint<-summary$cols[,c(i:j)];
					toprint<-round(toprint, d=2)
					latex$cols[[paste(f,sep="",collapse="-")]]<-toLatex(toprint, total.rows=F, total.cols=F, caption=caption,...)
			}
			if (print.rows) {
					while (dim(summary$rows)[2] < j) { j <- j-3} 
					toprint<-summary$rows[,c(i:j)];
					toprint<-round(toprint, d=2)
					latex$rows[[paste(f,sep="",collapse="-")]]<-toLatex(toprint, total.rows=F, total.cols=F, caption=caption,...)
			}
	}
	else {
		for (i in f) {
			j<-(i-1)*3+1
			if (print.cols) {
					while (! dim(summary$cols)[2] < j) { j <- j-3} 
					toprint<-summary$cols[,c(j:(j+2))];
					toprint<-round(toprint, d=2)
					latex$cols[[i]]<-toLatex(toprint, total.rows=F, total.cols=F, caption=paste("Données numériques, points-colonnes sur f",i, sep="",...))
			}
			if (print.rows) {
					while (! dim(summary$rows)[2] < j) { j <- j-3} 
					toprint<-summary$rows[,c(j:(j+2))];
					toprint<-round(toprint,d=2)
					latex$rows[[i]]<-toLatex(toprint, total.rows=F, total.cols=F, caption=paste("Données numériques, points-lignes sur f",i, sep="",...))
			}
		}
	} 
	return(latex)
}

toLatex.triplat<-function(tri, caption=NULL, barplot.plot=T, barplot.file=NULL, float.type="table", position="H", ...) {
				subfloat.type<-float.type
				subfloat.caption<-caption
				float<-'';
        if (float.type == "table") {
					float<-c(paste("\\begin{",float.type,"}[",position,"]\n\\centering{\\scriptsize",sep=""))
					subfloat.type<-"tabular"
					subfloat.caption<-NULL
				}
        float<-c(float, toLatex.data.frame(tri, caption=subfloat.caption, float.type=subfloat.type, ...))
				if (barplot.plot==T) {
					if (dev.cur()!=1) dev.off()
					rownames(tri)<-ifelse(rownames(tri)=="TRUE","1",ifelse(rownames(tri)=="FALSE","0",rownames(tri)))
					barplot(rev(tri[rownames(tri),1]), hor=T, las=1, ylim=c(0, 48/dim(tri)[1]), width=2/dim(tri)[1], main="", font.main=3)
					if (is.null(barplot.file)) {
						op <- options(digits.secs=6)
						barplot.file<-paste("out/autoimage",format(Sys.time(),"%y%m%d%h%m%s"), sep="")
					}
					toLatexFig(barplot.file, scale=.6, position="t", family="Times", wrap=F)
					dev.off()
					
					float<-c(float, texCommand("hspace", "2em"))
					float<-c(float, paste("\\input{",barplot.file,"}\n", sep=""))
				}
		    if (float.type=="table") {float<-c(float, texCommand("caption", caption))
        float<-c(float, paste("}\\end{",float.type,"}\n", sep=""))
				}

        return(float)
}




toLatex.data.frame <- function(df, rownames=T, escape.rownames=T, escape.colnames=T, info=NULL, label=NULL, position="t", caption=NULL, total.rows=TRUE, total.cols=FALSE, float.type="tabular", escape.latex=F, ...) {
	table<-c("");
	fist_col_align<-"r"
	if (rownames==T) {fist_col_align<-"l"}
	table<-c(table, paste('{\\scriptsize\\begin{',float.type,'}[',position,']{',fist_col_align,sep=""))
	names<-colnames(df)
	dim<-dim(df)
	
	# format des  cols
	for (i in 1:dim[2]) {
		if (!(all(all.digits(df[,i]))) & is.numeric(df[,i])) {
			#table<-c(table, "D{.}{.}{-1}")
			table<-c(table, "r")
		} 
		else  {
			table<-c(table, "r")
		}
	}
	if (total.cols) {
		table<-c(table, "r")
	}
	table<-c(table, '}\n')
	lines<-rownames(df);
	
	# en-tête
	for (i in 1:dim[2]) {
		if ((rownames==T) | (i !=1)) table<-c(table, '&')
		if (escape.colnames==T) { table<-c(table, paste('\\multicolumn{1}{r}{',escapeLatex(as.vector(names[i])),'}', sep='')) }
		else { table<-c(table, paste('\\multicolumn{1}{r}{',(as.vector(names[i])),'}', sep='')) }
	}
	headerbreak<-""
	if (float.type == "longtable") {
		headerbreak<-"\\endhead "
	}

	if (rownames==T ) {		table<-c(table, paste('\n\\\\*\\cmidrule{1-',dim[2]+1,'}', headerbreak,sep="")) }
		else { 	table<-c(table, paste('\n\\\\*\\cmidrule{1-',dim[2],'}', headerbreak,sep=""))  }
	

	if (float.type == "longtable") {
		table<-c(table, '(suite p. sv.)')
	#	for (i in 1:dim[2]) {
	#		if ((rownames==T) | (i !=1)) table<-c(table, paste('&\\multicolumn{1}{r}{}', sep=''))
	#	}
		table<-c(table, paste('\\endfoot', sep=""))
	#	for (i in 1:dim[2]) {
	#		if ((rownames==T) | (i !=1)) table<-c(table, paste('&\\multicolumn{1}{r}{}', sep=''))
	#	}
		table<-c(table, paste('\\endlastfoot\n', sep=""))
	}
	
	
	# corps du tableau
	for (i in 1:dim[1]) {
		if (escape.rownames==T) { rowname<-escapeLatex(lines[i]) }
		else { rowname<-lines[i] }
		if (rownames==T) {
			table<-c(table, rowname)
			table<-c(table, '&') 
		}
		for (j in 1:dim[2]) {
			cell<-as.vector(df[i,j]);
			#cell<-escapeLatex(cell);
			if (is.numeric(cell)) {
				cell<-paste('$',cell,'$',sep="")
			}
			table<-c(table, cell)
			if (j != dim[2]) { table<-c(table, '&') }
		}
		if (total.cols) {
			table<-c(table, '&')
			table<-c(table, paste("\\emph{",sum(df[i,]), "}", sep=""))
		}
		if (i != dim[1]) table<-c(table, '\n\\\\')
	}
	
	# totaux
	total<-FALSE
	if (total.rows) {
		totalline<-c("\n\\\\")
	#	totalline<-paste('\\cmidrule{1-',dim[2]+1,'}',sep="")
		for (i in 1:dim[2]) {
			if (is.numeric(df[,i])) {
				totalline<-c(totalline, '&')
				totalline<-c(totalline, paste("\\multicolumn{1}{r}{\\emph{",sum(df[,i]),"}}", sep=""))
				if (total==FALSE) {total=TRUE}
			} 
			else  {
				totalline<-c(totalline, '&')
				totalline<-c(totalline, "")
			}
		}
		if (total.cols) {
			totalline<-c(totalline, '&')
			totalline<-c(totalline, paste("\\emph{",sum(df), "}", sep=""))
		}
		if (total==TRUE) {table<-c(table, totalline)}
	}
	if (!is.null(label))  { table<-c(table, "\\\\*", texCommand("label", label)) }
	if (!is.null(caption)){ table<-c(table, "\\\\*\\caption{",caption,"}") }
	table<-c(table, paste('\n\\end{',float.type,'}}', sep=""))
	return(paste(table, collapse=""))
}

toLatex.glm <- function(mod, caption=NULL, label=NULL, ...) {
	table<-c("\\begin{table}[H]\\centering")
	smry<-summary(mod)
	co<-smry$coeff
	num<-co
	num[,4]<-starredprb(num[,4])
	num[,-4]<-paste("$",format(as.numeric(num[,-4]),dig=3),"$", sep="")
	colnames(num)<-c("Effet","Erreur","z","PRB")
	rownames(num)<-c("Moyenne", rownames(co)[-1])
	table<-c(table,toLatex(num, ...))
	table<-c(table, "\n\n\\vspace{5pt}")
	table<-c(table, "{\\scriptsize Déviance résiduelle = $", format(mod$deviance, dig=3), "$, $ddl$ residuels = $", format(mod$df.residual, dig=3), "$, AIC = $", format(mod$aic, dig=3),"$}")
	if (!is.null(label))  { table<-c(table, texCommand("label", label)) }
	if (!is.null(caption)){ table<-c(table, texCommand("caption", escapeLatex(caption))) }
	table<-c(table, "\\end{table}")
	return(table)
}

starredprb<-function(df, p.values=c(.05,.01,.001), stars.only=FALSE, ...) {
	stars<-ifelse(is.na(df), "", ifelse(
				df>=p.values[1], "{\\tiny \\ding{73}\\ding{73}\\ding{73}}",
				ifelse(df>=p.values[2],
					"{\\tiny \\ding{73}\\ding{73}\\ding{72}}",
					ifelse(df>=p.values[3],
						"{\\tiny \\ding{73}\\ding{72}\\ding{72}}",
						"{\\tiny \\ding{72}\\ding{72}\\ding{72}}")
					)))
		df<-format(df, dig=3)
		df<-ifelse(df=="NA"|is.na(df),"-",df)
		df<-paste("$", df, "$", sep="")
		if (stars.only==FALSE) df<-paste(df, stars) else df<-stars
			return(df)
}


texCommand <- function(name, arg=NULL, options=NULL) {
	# TODO: plus d'un argument
	command<-paste("\\", name, sep="", col="")
	if (!is.null(options)) {
		command<-paste(command, "[",options,"]", sep="", col="")
	}
	command<-paste(command, "{", sep="", col="")
	if (!is.null(arg)) {
		command<-paste(command, arg, sep="", col="")
	}
	command<-paste(command, "}", sep="", col="")
	return(command)
}

escapeLatex <- function(string) {
	string<-gsub("([_\\\\{}&#%])", "\\\\\\1{}", string)
	string<-gsub("\\$", "\\\\klongs{}", string)
	string<-gsub("~", "$\\\\sim$", string)
	string<-gsub("¶", "\\\\textparagraph{}", string)
	string<-gsub("\\|", "~\\\\ksmallspace{}", string)
	string<-gsub("·", "\\\\textperiodcentered{}", string)
	string<-gsub("!", "\\\\kpelb{}", string)
	string<-gsub("\\?", "\\\\kpela{}", string)
	string<-gsub("\\^", "\\\\textlnot{}", string)
	string<-gsub("¬", "\\\\textlnot{}", string)
	string<-gsub("&", "\\ket", string)
	string<-gsub("\\[(.*)\\]", "\\\\emph{\\1}", string)
	string<-gsub("TRUE", "1", string)
	string<-gsub("FALSE", "0", string)
	return(string)
}


#vim: encoding=utf-8 fileencoding=utf-8
