#Input: A reference named vector ref
# A named vector vec for which MoJo is to be compared relative to ref
#precondition: Both vectors are normalized and of equal length
compute.MoJo <-function(grp, ref){
require(igraph)
if (length(grp) != length(ref))
stop("Incompatible Length of Vectors")
k.grp <- max(grp)
k.ref <- max(ref)
v = matrix(0, nrow = k.grp, ncol=k.ref)
for (i in 1:k.grp)
for (j in 1:k.ref)
v[i,j] <- length(intersect(names(grp[which(grp==i)]), names(ref[which(ref==j)])))
max.v <- apply(v, 1, function(xs){max(xs)})
nmoves <- length(grp) - sum(max.v)
max.k <- apply(v, 1, function(xs){which(xs==max(xs))})
edges <- c()
for (i in 1:length(max.k))
# i is the src.element
for (j in 1:length(max.k[[i]]))
edges <- rbind(edges, c(i, max.k[[i]][j] + k.grp))
gr <- graph.data.frame(edges, directed=TRUE, vertices=NULL)
V(gr)$type = c(rep(FALSE, length(max.k)), rep(TRUE, vcount(gr) - length(max.k)))
mmg <- maximum.bipartite.matching(gr)$matching
l.join = 0
for (i in 1:k.grp)
if (!is.na(mmg[i]))
l.join <- l.join+1
njoins = k.grp - l.join
return(nmoves + njoins)
}
build.decomposition <- function(dir, pattern) {
decomposition <- decompose.folder(dir, pattern, 1)
return(decomposition$group)
}
decompose.folder <- function(dir, pattern, index) {
result = list(
group = NULL,
idx = NULL
)
all <- list.files(dir, full.names = TRUE, recursive = FALSE)
files <- grep(pattern, all,value = TRUE)
if (length(files) > 0)
result$group <- group.files(grep(pattern, all, value = TRUE), index)
dirs <- all[file.info(all)$isdir]
result$idx = index + 1
i = 1
print(length(dirs))
while(i <= length(dirs)) {
decomposition <- decompose.folder(dirs[i], pattern, result$idx)
result$idx <- decomposition$idx
result$group <- c(result$group, decomposition$group)
i <- i+1
}
return(result)
}
group.files <- function(files, index) {
group <- rep(index, length(files))
names(group) <- files
print(group)
return(group)
}
find.intersection <- function(v, g) {
return(v[intersect(names(v),names(g))])
}
extract.authoritative.partition <- function(prname) {
setwd("~/workspace")
require(igraph)
require(Rcpp)
#Load the priori decomposition
decomposition <- read.csv(paste("benchmark", prname ,"decomposition.csv", sep="/"), sep=",", header = TRUE)
priori.decomp <- decomposition$x
names(priori.decomp) <- decomposition$X
priori.decomp <- normalizeVector(priori.decomp)
print(max(priori.decomp))
}
compute.MoJoSim <- function(clusters, classes) {
N <- length(clusters)
1 - (compute.MoJo(clusters, classes)/N)
}
compute.cluster.purity <- function(clusters, classes) {
sum(apply(table(classes, clusters), 2, max)) / length(clusters)
}
compute.NMI <- function(clusters, classes) {
require(clue)
cl_agreement(as.cl_partition(clusters), as.cl_partition(classes), method="NMI")
}
# Rand Index
compute.RI <- function(clusters, classes) {
require(clue)
cl_agreement(as.cl_partition(clusters), as.cl_partition(classes), method="Rand")
}
# # Rand Index
compute.AdjRI <- function(clusters, classes) {
require(clue)
cl_agreement(as.cl_partition(clusters), as.cl_partition(classes), method="cRand")
}
compute.f1 <- function(actual, predict) {
precision <- compute.precision(actual, predict)
recall <- compute.recall(actual, predict)
f1 <- (2*precision*recall)/(precision+recall)
mean(f1)
}
compute.recall <- function(actual, predict) {
confusion <- table(actual, predict)
confusion <- cbind(confusion,0)
relativeDocs <- apply(confusion[,],1, FUN = sum)
recall <- apply(confusion[,],2,function(x) if(relativeDocs[which.max(x)]) max(x)/relativeDocs[which.max(x)] else 0)
mean(recall[1:length(recall)-1])
}
compute.precision <- function(actual, predict) {
confusion <- table(actual, predict)
confusion <- cbind(confusion,0)
precision <- apply(confusion[,],2,function(x) if(sum(x)>0)max(x)/sum(x) else 0)
mean(precision[1:length(precision)-1])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.