1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#' @rdname funByBlocks
#' @export
"funByBlocks.default" <-
function(x = M, clu, M = x, ignore.diag = "default", sortNames = TRUE, FUN = "mean", ...)
{
M<-as.array(M)
dM<-dim(M)
nn<-ifelse(length(dM)==2,1,dM[3])
if(is.list(clu)){
nmode<-length(clu)
if(nmode>2){
clu<-unlist(clu)
clu<-list(clu,clu)
}
} else {
clu<-list(clu,clu)
nmode<-1
}
clu<-lapply(clu,factor)
if(ignore.diag =="default"){
if(length(dM)==3){
ignore.diag <-all(apply(M,3,function(x)identical(ss(diag(x)),0)))&(nmode==1)
} else ignore.diag <-identical(ss(diag(M)),0)&(nmode==1)
}
if(sortNames) {
k <- lapply(clu,function(x)sort(unique(x)))
}else {
k <- lapply(clu,function(x)unique(x))
}
IM.V <- array(NA, dim=c(nn,length(k[[1]]),length(k[[2]])))
dimnames(IM.V)<-c(list(1:nn),k)
for(iNet in 1:nn){
if(length(dM)==3) iM <- M[,,iNet] else iM<-M
for (i in k[[1]]) {
for (j in k[[2]]) {
B<-iM[clu[[1]] == i, clu[[2]] == j, drop = FALSE]
if (nmode==1 && i == j && ignore.diag) diag(B) <- NA
#removed "dim(B)[1] > 1 &&" from condition above - produces NA's in IM in the diagonal blocks in case of dimension 1x1
lpar<-list(x = B,...)
FUNchar<-FUN
if(!is.character(FUNchar)) FUNchar<-deparse(substitute(FUN))
if(FUNchar %in% c("mean","sum","min","max")){
if(!("na.rm"%in%names(lpar))) lpar<-c(lpar, list(na.rm=TRUE))
}
IM.V[iNet,i, j] <- do.call(FUN, lpar)#, na.rm = TRUE
}
}
}
if(nn==1) return(IM.V[1,,]) else return(IM.V)
}
|
