## need igraph installed
## from gRbase v 1.8-1
.GRcombnPrim<-function (x, m, transpose = TRUE)
{
.colmat2list<-function (XX_) .Call("gRbase_colmat2list", PACKAGE = "GRMeta", XX_)
if (length(x) == 1 && is.numeric(x))
x <- seq(x)
if (length(x) < m)
stop("Error in combnPrim: n < m\n")
NCAND <- length(x)
NSEL <- as.integer(m)
NSET <- as.integer(choose(NCAND, NSEL))
ANS <- rep.int(0L, NSET * NSEL)
res <- .C("combnC", NSEL, NCAND, NSET, ANS, PACKAGE = "GRMeta")[[4]]
#if (simplify) {
res<- matrix(x[res], nrow = NSEL, ncol = NSET)
if(transpose) res<-t(res)
res
#}
# else {
# res <- matrix(x[res], nrow = NSEL, ncol = NSET)
# res <- colmat2list(res)
# names(res) <- NULL
# res
# }
}
.GRmergellx<-function(ll,nmin=2){
ledges=do.call("rbind",lapply(ll,.GRcombnPrim,2))
clu=igraph:::clusters(igraph:::graph_from_edgelist(ledges,directed=F))
clu=tapply(1:length(clu$membership),clu$membership,c)
clu[sapply(clu,length)>=nmin]
}
.GRisover<-function(vst,ven,retOne=FALSE,thr=0){
isover=which(outer(ven,vst,"-")> (-thr) & outer(vst,ven,"-")<thr,arr=T)
if(all(isover[,1]==isover[,2])) clu=as.list(1:length(vst)) else{
clu=igraph:::clusters(igraph:::graph_from_edgelist(isover,directed=F))
clu=tapply(1:length(clu$membership),clu$membership,c)
}
clu[sapply(clu,length)>(!retOne)]
}
.GRisover2<-function(vst1,ven1,vst2,ven2,retOne=FALSE,thr1=0,thr2=0){
isover=which(outer(ven1,vst1,"-")> (-thr1) & outer(vst1,ven1,"-")<thr1 & outer(ven2,vst2,"-")> (-thr2) & outer(vst2,ven2,"-")<thr2,arr=T)
if(all(isover[,1]==isover[,2])) clu=as.list(1:length(vst1)) else{
clu=igraph:::clusters(igraph:::graph_from_edgelist(isover,directed=F))
clu=tapply(1:length(clu$membership),clu$membership,c)
}
clu[sapply(clu,length)>(!retOne)]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.