scored_vlda.r

scored_vclass <- function(df,class,vowels, dims = c("F1","F2")){
	require(MASS)
	df <- df[df[ ,class] %in% vowels, ]
	

	df[ ,class] <- as.character(df[ ,class])
	df[,class] <- as.factor(df[,class])
	
	
	for(i in dims){
		df <- df[!is.na(df[,i]),]
	}
	
	
	form <- paste(class,paste(dims, collapse = "+"),sep = "~")
	
	
	thelda <- lda(as.formula(form), data = df,na.action = na.exclude)
	
	df$LDA <- predict(thelda,method = "predictive")$x[,1]
	df$ldclass <- predict(thelda,method = "predictive")$class
	df <- df[order(df$LDA),]
	df$LDAd <- df$LDA + c(diff(df$LDA)/2,0)
	
	vorder <- names(sort(tapply(df$LDA, df[,class], mean, na.rm = T)))
	nv <- table(df[,class])
	
	measures <- unlist(lapply(df$LDAd,function(x){
		(2*((1-sum(df[df$LDA <= x,class]==vorder[2])/nv[vorder[2]])*(1-sum(df[df$LDA > x,class]==vorder[1])/nv[vorder[1]])))/
	((1-sum(df[df$LDA <= x,class]==vorder[2])/nv[vorder[2]])+(1-sum(df[df$LDA > x,class]==vorder[1])/nv[vorder[1]]))
	}))
	
	f.best <- mean(df[measures==max(measures, na.rm = T),]$LDAd,na.rm = T)
	f <- as.vector((2*((1-sum(df[df$LDA <= f.best,class]==vorder[2])/nv[vorder[2]])*(1-sum(df[df$LDA > f.best,class]==vorder[1])/nv[vorder[1]])))/
	((1-sum(df[df$LDA <= f.best,class]==vorder[2])/nv[vorder[2]])+(1-sum(df[df$LDA > f.best,class]==vorder[1])/nv[vorder[1]])))
	
	acc <- sum(df$ldclass == df[,class])/nrow(df)
	
	dists <- c("D1","D2")
	for(i in 1:2){
		cv <- cov(df[df[,class]==vowels[i],dims],,use = "complete")
		m <- mean(df[df[,class]==vowels[i],dims],na.rm = T)
		
		df[,dists[i]] <- mahalanobis(df[,dims],m,cv)
	}
	
	df$MClass <- vowels[1]
	if(sum(df$D2 < df$D1) > 0){
		df[df$D2 < df$D1,]$MClass <- vowels[2]
	}
	
	m.acc <- sum(df[,class]==df$MClass)/nrow(df)
	
	base <- max(nv)/nrow(df)
		
	toreturn <- c(f,acc,m.acc,base)
	names(toreturn)<-c("f.recall","lda.acc","m.acc","baseline")
	return(toreturn)
}