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

# Classification automatique hybride
#
# suivant Lebart-Morineau-Piron 1997: 177 sv. (désormais LMP)

myclustering <- function(coa, ncenters, nfactors=NULL) {
	if (is.null(nfactors)) { nfactors<-dim(coa$li)[2] }
	data<-coa$li[,1:nfactors];
	cat(paste("Agrégation non hiérarchique par k-moyennes;", ncenters, "centres.\n"));
	k<-mykmeans(data, ncenters);
	cat("Agrégation hiérarchique (métrique du chi²).\n");
	d<-myhclust(k$center);
	d2<-as.dendrogram(d);
	plot(d2);
	cat("  Couper à quelle hauteur? ");
	h<-as.integer(readLines(n = 1));
	c<-myhclass_labels(d2, h);
	cat("  Consolidation des classes par réaffectation.\n");
	
	class_gravity<-myclass_gravity(coa, c, k$cluster, nfactors);
	
	myconsolidate(data, class_gravity);
	

} 

mykmeans <- function(data, ncenters) {
	k<-kmeans(data, ncenters);
	# TODO: centres stables
	k
}

myconsolidate <-function(data, centers) {
	# consolide les centres par réaffectation LMP: 180-181
	new_centers<-c();
	while (length(centers) != sum(centers == new_centers)) {
		new_centers<-centers;
		print(new_centers)
		print(centers)
		k<-kmeans(data, new_centers);
		centers<-k$centers;
	}
	k
}

myhclust <-function(data) {
	dist<-dist(data);
	d<-hclust(dist);
}

myhclass_labels <- function(dendrogram, h) {
	# parcourt le dendrogramme à partir du niveau de coupure 
	# pour trouver les noms des membres des classes
	d<-cut(dendrogram, h);
	sub_d<-length(d$lower);
	class_labels<-list();
	for (i in 1:sub_d) {
		class_labels[[i]]<-myget_member_labels(d$lower[[i]])
	}
	class_labels;
}

myclass_gravity <-function(coa, class_labels, kclusters, nfactors) {
	n_class<-length(class_labels);
	class_gravity<-array(1:(nfactors*n_class), c(n_class,nfactors));
	n<-coa$li[,1:nfactors];
	for (i in 1:n_class) {
		m<-n[as.integer(class_labels[[i]]),];
		class_gravity[i,]<-colSums(m)/length(m);
	}
	class_gravity
}

myget_member_labels <-function(dendrogram) {
	# Extrait les noms des membres d'un dendrogramme par récursion
	l<-c();
	if (! is.null(attr(dendrogram, "leaf"))) {
		l<-c(l, attr(dendrogram, "label"))	
	} else {
		for (i in 1:length(dendrogram)) {
			l<-c(l, myget_member_labels(dendrogram[[i]]))
		}
	}
	l
}

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