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

ignore.damaged <- function (df) {
	df<-ignore(df, car=list(PHD="DAM")) # J'ignore ce qui est endommagé
	return(df);
}

myoutput <- function (df, ...) {
	return(output(ignore.damaged(df), ...))
}

analysetable <- function (t) {
	# vérifie si une table est décomposable
	if (dim(t[rowSums(t)>=10,])[1]>=2) {

	}
	else {
		print
	}
}


sink.it <- function(file, t) {
	options("max.print"=999999)
	sink(file)
	print(t)
	sink()
}

# fonctions
do.app <- function(file, ponct, df, header=NULL, name=NULL, outdir='out/') {
	if (is.null(header)) header<-file
	if (is.null(name)) name<-file
	if (is.null(ponct)) {
		sink(paste(outdir,file, sep=""))
		cat(name)
		cat("\n")
		cat(header)
		cat(".")
		cat("\n")
		print(df[,c("RB","RI")])
		sink()
	} 
	else {
		sink(paste(outdir,file,"-",ponct,"-1", sep=""))
		cat(name)
		cat("\n")
		cat(header)
		cat(paste(". ",ponct,".1.", sep=""))
		cat("\n")
		print(df[df[[ponct]]==1,c("RB","RI")])
		sink()
		sink(paste(outdir,file,"-",ponct,"-0", sep=""))
		cat(name)
		cat("\n")
		cat(header)
		cat(paste(". ",ponct,".0.", sep=""))
		cat("\n")
		print(df[df[[ponct]]==0,c("RB","RI")])
		sink()
	}
}


kill.dev <- function() {
	if (!is.null(dev.list())) dev.off()
}
#======================================================================================#
#  FONCTIONS: pour 6.1.2 jq 7
#======================================================================================#

do.select <- function(df, mm, mi) {
	selected<-df[df$MM %in% mm & df$MI %in% mi,]
	return(selected)
}

do.analysis <- function(df, mm, mi, ponct) {
	df<-do.select(df, mm, mi)
	do.app(paste(build.filename(mm,"", prefix="", outdir="dep-"), "", sep=""), ponct, df=df, outdir="out/")
	if (!is.null(dev.list())) kill.dev()
	do.triplat(df, mm, mi, ponct)
	if (!is.null(dev.list())) kill.dev()
	ch<-do.chi(df, mm, mi, ponct, "RB")	

	X11()
	if (ponct=="PPD") {
		df<-do.select(tp, mm, mi)
		do.chi(df, mm, mi, ponct, "MMP")	
	}
	else {
		df<-do.select(tn, mm, mi)
		do.chi(df, mm, mi, ponct, "MMS")
	}
	return(ch)
}

build.filename <- function (..., outdir="out/") {
	file<- paste(outdir, currentsec,".", build.id(...), sep="") # currentsec est une globale
	return(file)
}

build.id <- function (mm, ponct, suffix="", prefix="") {
	mm<-gsub("¬","not",mm)
	id <- paste(
		prefix,
		gsub(",","",mm), 
		ponct,
		suffix,
		sep=""
	)
	return(id)
}

do.triplat <- function (df, mm, mi, ponct) {
	mmlatex<-escapeLatex(mm)
	tri<-triplat(df[,ponct])[[1]]
	file<-build.filename(mm, ponct, suffix=paste("triplat","tex",sep="."))
	lev<-escapeLatex(paste(mi, collapse=", "))
	lev.lab<-ifelse(length(mi)>1, "niveaux", "niveau")
	barplot.file<-build.filename(mm, ponct, suffix="triplat-barplot")
	caption <- paste("Tri à plat de ", ponct, ", pour les constituants de type ", mmlatex, " (", lev.lab, ": ", lev, ")",  sep="")
	sink(file)
	catlat(toLatex(tri, barplot.file=barplot.file, caption=caption))
	sink()
}

do.chi <- function(df, mm, mi, ponct, var, do.plot=T, suffix="") {
	mmlatex<-escapeLatex(mm)
	tab<-table(refactor(df[,c(var,ponct)]))
	
	lev<-escapeLatex(paste(mi, collapse=", "))
	lev.lab<-ifelse(length(mi)>1, "niveaux", "niveau")
		
	# Sink sur la table
	file<-build.filename(mm, ponct, suffix=paste("table-all",paste(var,"tex",sep="."), sep=""))
	caption <- paste("Tri croisé entre ", var, " et ", ponct, ", pour les constituants de type ", mmlatex, " (", lev.lab, ": ", lev, ")",  sep="")
	if (!is.null(dim(tab))) {
		sink(file)
		catlat(toLatex(tricroise(tab, fisher=F), test=F, caption=caption, label=paste("tab:",build.id(mm, ponct, suffix=paste("table-all",var,sep="")),sep="")))
		sink()
	}

	file<-build.filename(mm, ponct, suffix=paste("table-fqlt10",paste(var,"tex",sep="."), sep=""))
	caption <- paste("Tri croisé entre ", var, " et ", ponct, ", pour les constituants de type ", mmlatex, " (", lev.lab, ": ", lev, "); effectifs inférieurs à 10",  sep="")

	tab2<-tab[rowSums(tab)<10,]
	if (!is.null(dim(tab2))) {
	sink(file)
	catlat(toLatex(tricroise(tab2, fisher=F), test=F, caption=caption, label=paste("tab:",build.id(mm, ponct,suffix=paste("table-fqlt10",var,sep="")),sep="")))
	sink()
	}

	# graphique des écarts
	ch<-plotchi(tab)     
	if (do.plot) {
		sc<-ifelse(length(ch$pos)==0|length(ch$neg)==0,.475,1)
		caption <- paste("Liens significatifs entre ", var, " et ", ponct, ", pour les constituants de type ", mmlatex, " (", lev.lab, ": ", lev, ")",  sep="")
		file<-build.filename(mm, ponct, suffix=paste("figure",var, sep=""))
		toLatexFig(file, family="Times", scale=sc, caption=caption, label=paste("fig:",build.id(mm, ponct, suffix=paste("figure",var, sep="")), sep=""))
	}

	return(ch)
}

get.trend <- function (trends, direction="pos", threshold=.05) {
	if (length(trends[[direction]])==0) { return () }
	df<-data.frame(trends[[direction]])
	n<-rownames(df[df[,1]<threshold,])
	return(n)
}

check.stability <- function (trends, name, direction="pos") {
	if (name %in% rownames(trends[[direction]])) {
		stable<-trends[[direction]][name,]
		return(stable)
	}
	return(NULL)
}


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