# 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) {
	maincaption<-caption
	float<-toLatex(tri$tab, caption=NULL, total.cols=TRUE)
	if (!is.null(tri$pem)) {
		tri$pem<-ifelse(is.na(tri$chi2signif), paste("$",tri$pem,"$ \\ding{73}\\ding{73}\\ding{73}", sep=""),
			ifelse(tri$chi2signif>=0.01, paste("$",tri$pem,"$ \\ding{73}\\ding{73}\\ding{72}", sep=""), 
				ifelse(tri$chi2signif>=0.001, paste("$",tri$pem,"$ \\ding{73}\\ding{72}\\ding{72}",sep=""), paste("$",tri$pem,"$ \\ding{72}\\ding{72}\\ding{72}",sep=""))
			))
		float<-c(float, texCommand("hspace", "2em"))
		if (!is.null(tri$pem)) {
			float<-c(float, toLatex(tri$pem, caption=NULL, total.cols=FALSE, total.rows=FALSE))
		}
	}
	float<-c(float, paste(
		"\n $\\chi^2 = ", round(tri$chi2$stat, dig=2),
		"$, $ddl = ", tri$chi2$parameter, 
		"$, $p = ", round(tri$chi2$p.value, dig=3), "$", 
		sep=""))
		float<-c(float, 
			ifelse(tri$chi2$p.value >.05, " \\ding{73}\\ding{73}\\ding{73}", 
			ifelse(tri$chi2$p.value >.01, " \\ding{73}\\ding{73}\\ding{72}", ifelse(tri$chi2$p.value >.001, " \\ding{73}\\ding{72}\\ding{72}", " \\ding{72}\\ding{72}\\ding{72}"))))

		float<-c(float, texCommand("caption", maincaption))
	return(float)
}

toLatex.spec<-function(spec, caption=NULL, ...) {
	spec<-spec$tab;
	spec[,"SPC"]<-ifelse(spec[,"SPC"]>0, "$S+$", "$S-$")
	spec[,"PRB"]<-as.numeric(format(spec[,"PRB"]))
	spec[,"PRB"]<-paste(spec[,"PRB"], c(
			ifelse(spec[,"PRB"] >.05, " \\ding{73}\\ding{73}\\ding{73}", 
			ifelse(spec[,"PRB"] >.01, " \\ding{73}\\ding{73}\\ding{72}", ifelse(spec[,"PRB"] >.001, " \\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, ...) {
	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=paste("Données numériques, points-colonnes sur f", paste(f, collapse="-f"), sep="",...))
			}
			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=paste("Données numériques, points-ligne sur f", paste(f, collapse="-f"), sep="",...))
			}
	}
	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)
}


toHTML.data.frame <- function(df, info=NULL, label=NULL, caption=NULL, total.rows=TRUE, total.cols=FALSE) {
	table<-c("");
	table<-c(table, '<table><tr>')
	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]) {
		table<-c(table, '&')
		table<-c(table, paste('<td>',escapeLatex(as.vector(names[i])),'</td>', sep=''))
	}
#		table<-c(table, paste('\n\\\\\\cmidrule{1-',dim[2]+1,'}',sep=""))
	
	# corps du tableau
	for (i in 1:dim[1]) {
		rowname<-escapeLatex(lines[i])
		table<-c(table, rowname)
		for (j in 1:dim[2]) {
			table<-c(table, '&') 
			cell<-as.vector(df[i,j]);
			#cell<-escapeLatex(cell);
			table<-c(table, cell)
		}
		if (total.cols) {
			table<-c(table, '&')
			table<-c(table, paste("<em>",sum(df[i,]), "</em>", sep=""))
		}
		table<-c(table, '\n</tr><tr>')
	}
	
	# totaux
	total<-FALSE
	if (total.rows) {
		totalline<-c("")
	#	totalline<-paste('\\cmidrule{1-',dim[2]+1,'}',sep="")
		for (i in 1:dim[2]) {
			if (is.numeric(df[,i])) {
				totalline<-c(totalline, paste("<td>",sum(df[,i]),"</td>", sep=""))
				if (total==FALSE) {total=TRUE}
			} 
			else  {
				totalline<-c(totalline, '<td></td>')
				totalline<-c(totalline, "")
			}
		}
		if (total.cols) {
			totalline<-c(totalline, paste("<td><em>",sum(df), "</em></td>", sep=""))
		}
		if (total==TRUE) {table<-c(table, totalline)}
	}

	table<-c(table, '\n</tr>\n</table>\n')
	if (!is.null(label))  { table<-c(table, texCommand("label", label)) }
	if (!is.null(caption)){ table<-c(table, texCommand("caption", escapeLatex(caption))) }
	return(paste(table, collapse=""))
}

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("!", "\\\\pelb{}", string)
	string<-gsub("\\?", "\\\\pela{}", string)
	string<-gsub("\\^", "$\\\\sim$", string)
	string<-gsub("\\[(.*)\\]", "\\\\emph{\\1}", string)
	return(string)
}


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