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

# Manipulation de données (recodage, essentiel pour gagner du temps)
require(ade4)

check <-function(df, mod,  position="RMF", bool=TRUE) {
	# vérifie si le mot en "position" ("RMF"|"RMD") est au bout d'un
	# constituant qui vérifie la modalité mod ("CHAR.VALUE") (list ou string)
	# exemples: 
	#		mod="LEF.1" ou mod=c("LEF.1", "MN.pers")
	#		mod=list(LEF=1, MN=c("pers","0")) # TRUE si vérifie une des modalités pour chaque caractère
	matching<-TRUE
	if (is.list(mod)) {
		match_car<-FALSE
		for (i in 1:length(names(mod))) {
			match_car<-df[,names(mod)[i]] %in% mod[[i]]
			matching<-c(matching & match_car)
		}
		matching<-carmerge(df[matching,c("RB",position)],c("RB",position))
	} else {
		car = gsub("(.+?)\\..*", "\\1" , mod)
		val = gsub(".+?\\.(.+)", "\\1" , mod)
		match_all<-NULL
		for (i in 1:length(car)) { 
			if (is.null(match_all)) {match_all<-carmerge(df[df[,car[i]]==val[i],c("RB",position)],c("RB",position));}
			else {
				match_one<-carmerge(df[df[,car[i]]==val[i],c("RB",position)],c("RB",position))
				match_all<-match_one[paste(match_one[,"RB"],match_one[,position],sep=",") %in% paste(match_all[,"RB"],match_all[,position], sep=","),]
			}
		}
		matching<-match_all
	}
	if (bool==TRUE) return(ifelse(paste(df[,"RB"], df[,position], sep=",") %in% matching[,paste("RB",position, sep=",")], TRUE, FALSE))
	else {
		# Si "bool" est FALSE, ne retourne pas simplement TRUE ou FALSE, mais l'effectif vérifiant les modalités testées
		# TROP LENT
		counts<-table(matching[,paste("RB",position, sep=",")])
		mt<-cbind(counts, names(counts))
		colnames(mt)<-c("count","INDEX")
		df<-carmerge(df, c("RB", position), "INDEX")
		df<-carmerge(df, c("RB", "RI"), "KEY")
		keys<-as.character(df[,"KEY"])
		ret<-merge(df, mt, by="INDEX", all=TRUE, suffix=c("x","")) # Malheureusement, "merge" reclasse le tableau (oops)
		rownames(ret)<-ret[,"KEY"]
		ret[,"count"]<-ifelse(is.na(ret[,"count"]), 0, ret[,"count"])
		return(ret[keys,"count"])
		# ENCORE PLUS LENT
		# rownames<-paste("RB",position, sep=",")
		# return(ifelse(is.na(counts[rownames]), 0, counts[rownames]))
	}
}




recod <- function(df, car=list()) {
# df = TABLE BRUTE
# Recode les modalités d'un caractère
# utile pour les regroupements
	# car=list(
	#	  caractère1=c(
	#			modalité1="recodage", 
	#     modalité2="recodage"
	#	  )
	# )
	#
	# exemple: recod(tt, car=list(PON=c('separateur'=1)))
	#
	names<-names(car)
	for (i in 1:length(car)) {
		modnames<-names(car[[i]])
		for (j in 1:length(car[[i]])) {
			l<-levels(df[,names[[i]]])
			l<-ifelse(l == modnames[[j]], car[[i]][[j]], l)
			levels(df[,names[[i]]])<-l
		}
	}
	return(df)
}

carmerge <- function(df, cars=c(), name=NULL, suppress=F){
	# df = TABLE BRUTE
	# crée une colonne supplémentaire, qui concatène les valeurs de
	# plusieurs autres.
	# par exemple, la commande carmerge(df, cars=c("V1","V2")) sur
	# df = 
	#					V1	V2	V3
	#					B		B		D
	#					A		C		E
	# Retourne
	#					V1	V2	V3	V1-V2
	#					B		B		D		B-B
	#					A		C		E		A-B

	
	newcol<-paste(as.vector(df[,cars[1]]), sep="")
	for (i in 2:length(cars)) {
		newcol<-paste(newcol, df[,cars[i]], sep=",")
	}
	if (suppress) {
		# TODO
	}
	
	newcolName<-name

	if (is.null(newcolName)) { 
		newcolName<-paste(cars, collapse=",");
	}
	df[,newcolName]<-as.factor(newcol)
	return(df)
}

ignore <- function(df, cars=list()) {
# df = TABLE BRUTE
	if (is.null(cars)==TRUE) {
		return(df);
	}
	dfnames<-names(df)
	carnames<-names(cars)
	for (i in 1:length(carnames)) {
		mod<-cars[i]

		# passe à l'itération suivante si le df ne contient pas le caractère
		if (!carnames[[i]] %in% dfnames) { next } 

		for (j in 1:length(mod)) {
			for (k in 1:length(mod[[j]])) {
				df<-df[df[,carnames[[i]]]!=mod[[j]][k],]
			}
		}
	}
	return(refactor(df))
}

refactor <- function(df, factorize=F) {
# recalcule les levels de chaque col d'un df.
	for (i in 1:dim(df)[2]) {
		if (is.factor(df[,i]) | factorize==T) {
			df[,i]<-factor(df[,i])
		} else {
			df[,i]<-df[,i]
		}
	}
	return(df)
}

only <- function(df, cars=list()) {
	# TODO
}

disj <- function(df, cars=NULL, action="skip") {
# transforme une table brute en tableau disjonctif
	dj<-acm.disjonctif(df)
	if (is.null(cars)) {return(dj)}
	dj<-select(dj, cars=cars, action=action)	
	return(dj)
}

select <- function(dj, cars=NULL, action="skip") {
# df = TABLEAU DISJONCTIF
# Retourne un tableau disjonctif.
# les modalités citées sont ignorées (action="skip") ou gardées
# (action="keep") ou bien les lignes qui la contiennent sont détruites ("remove")
	# cars=list(
	#	  caractère1=c(modalité1, modalité2)
	# )
	#
	# si la liste des modalités est vide, tout est sélectionné 
	#
	# exemple: recod(tt, car=list(PON=c('separateur',1)))
	#
	carnames<-names(cars)
	djnames<-names(dj)
	if (action == "skip") {
		for (i in 1:length(carnames)) {
			mod<-cars[i]
				for (j in 1:length(mod)) {
					for (k in 1:length(mod[[j]])) {
						skip<-c(paste(carnames[[i]],mod[[j]][k], sep="."))
						djnames<-ifelse(djnames == skip, NA , djnames)
					}
				}
		}
		djnames<-na.omit(djnames)
	} else if (action == "keep") {
		for (i in 1:length(cars)) {
			keeps<-c();
			mod<-cars[i]
				for (j in 1:length(mod)) {
					for (k in 1:length(mod[[j]])) {
						keeps<-c(keeps, paste(carnames[[i]],mod[[j]][k], sep="."))
					}
				}
		}
		djnames<-keeps
	} else if (action == "remove") {
		for (i in 1:length(carnames)) {
			mod<-cars[i]
				for (j in 1:length(mod)) {
					for (k in 1:length(mod[[j]])) {
						skip<-c(paste(carnames[[i]],mod[[j]][k], sep="."))
						djnames<-ifelse(djnames == skip, NA , djnames)
						dj<-dj[dj[,skip]!=1,]
					}
				}
		}
		djnames<-na.omit(djnames)
	}
	dj<-dj[,djnames]
	return(dj)
}

skip <- function(dj, cars=NULL) {	return(select(dj, cars=cars, action="skip")) }
keep <- function(dj, cars=NULL) {	return(select(dj, cars=cars, action="keep")) }

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