# TODO: Add comment
# 
# Author: E.Korsching 10.9.2009
###############################################################################


category.compactness <- function(x, y, non.cat.id=(-1)){
	#x: basic info on the present category object - expect a category.basics data.frame format
	#y: test case of a category object - expect a vector with position dependend categories
	#non.cat.id: ID which does not belong to an existing category, default is -1
	
	#ini
	nrx <- nrow(x)
	len.y <- length(y)
	if(sum(x[,2])!=len.y){ cat("\n Error: Length of reference and test vector is differing") }
	if(match(x=non.cat.id, table=x[,1], nomatch=0)!=0){ cat("\n Error: Parameter 'non.cat.id' has to be different") }
	
	#sequence analysis, longest stretch of a category  (population stat can also be done - see comment below)
	raw.stat <- matrix(0,length(y),nrx) # store raw counts, rows: 1:1x, 2:2x etc., cols: cat 1, cat 2, etc., matrix holds counts
	#raw.stat2 <- matrix(0,length(y),nrx) # store raw counts, rows: 1:1x, 2:2x etc., cols: cat 1, cat 2, etc., matrix holds counts
	for(i in 1:nrx){
		z <- y
		z[z!=x[i,1]] <- non.cat.id # focus on a single category, set the other to 'non.cat.id'
		c1 <- 0 # counter: level
		#c0 <- 0 # counter: non.cat.id
		f1old <- z[1] # take first position as ini value
		for(j in 1:len.y){
			f1 <- z[j] # present position
			
			if(f1==f1old & f1==x[i,1]){ #no switch, sequence of 1
				c1 <- c1+1
				if(j==len.y){ raw.stat[c1,i] <- c1 } #save c1, save in row c1 the value of c1 to get the max position at the end with max()
				 #for a population statistics: raw.stat[c1,i] <- raw.stat[c1,i]+1  has to be done
			}
			if(f1==f1old & f1==non.cat.id){ #no switch, sequence of 0
				#c0 <- c0+1
				#if(j==len.y){ raw.stat2[c0,i] <- c0 } #no save c0
			}
			if(f1!=f1old & f1==x[i,1]){ #switch non.cat.id->level
				#raw.stat2[c0,i] <- c0 #save c0
				#c0 <- 0 #reset counter c0
				c1 <- c1+1 #start counter c1
				if(j==len.y){ raw.stat[c1,i] <- c1 } #save c1
			}
			if(f1!=f1old & f1==non.cat.id){ #switch level->non.cat.id
				raw.stat[c1,i] <- c1 #save c1
				c1 <- 0 #reset counter c1
				#c0 <- c0+1 #start counter c0
				#if(j==len.y){ raw.stat2[c0,i] <- c0 } #save c0
			}
			
			f1old <- f1
		}
	}
	
	#score
	# tab: length, level1, level2, level3, etc.
	#		1		0		1		...
	#		2		1		1		...
	#		3		0		1		...
	#		...		...		...		...
	
	#max score per level counts
	#normalization per level on max possible sequence length
	#sum of all level scores
	#normalization of that sum -equates- to number of levels [-in relation to- x -equates- 1]
	
	#level specific score values
	score.raw <- vector(mode="numeric", length=nrx)
	
	# nrx = number of levels 
	for(i in 1:nrx){
		score.raw[i] <- max(raw.stat[,i]) / x[i,2] #observed/max possible value
	}
	
	#overall score
	score.a <- sum(score.raw) / nrx #sum(score.raw) * 1 / nrx
	
	return(c(score.a,score.raw))
}