fs.agreement.part <-
function(r.idx,
c.idx,
dt,
dist=NULL,
classlabel,
k=2,
method.agreement=c("euclidean","manhattan","Rand","cRand","NMI",
"KP","angle","diag","Jaccard","FM",
"gdbr", "gdbrcpp"),
method.dist=c("pearson","kendall","spearman","standardizedEuclid",
"euclidean","pearson.u","kendall.u","spearman.u")
)
{
method <- match.arg(method.agreement)
# method.dist <- match.arg(method.dist)
# subset.dt <- dt[r.idx,c.idx]
classlabel <- classlabel[c.idx]
## distance
dist.profile <-dt[c.idx,c.idx]
# if(method.dist %in% c("pearson","kendall","spearman"))
# dist.profile <- as.dist(0.5*(1-cor(subset.dt,method=method.dist,use="complete.obs")))
# else if (method.dist %in% c("pearson.u","kendall.u","spearman.u")){
# .method.dist <- sub(".u","",method.dist)
# dist.profile <- as.dist(1-abs(cor(subset.dt,method=.method.dist,use="complete.obs")))
# }
# else if (method.dist == "standardizedEuclid") stop("Not implemented yet!")
# else dist.profile <- dist(t(subset.dt),method=method.dist)
## partition using pam
if(method %in% c("gdbr")) {
ret <- gdbr(as.numeric(as.factor(classlabel)), dist.profile)
} else if (method %in% c("gdbrcpp")) {
#cat("dist.profile: ", typeof(as.matrix(dist.profile)), as.matrix(dist.profile), dist.profile, "\n");
#cat("y: ", typeof(as.numeric(as.factor(classlabel))), as.numeric(as.factor(classlabel)), "\n");
ret <- gdbrcpp(dist.profile, as.numeric(as.factor(classlabel)))$Fstat
} else {
pam.cl <- pam(dist.profile,k,diss=T,cluster.only=T)
ret <- cl_agreement(as.cl_hard_partition(pam.cl),
as.cl_hard_partition(classlabel),
method = method.agreement)
}
ret
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.