Nothing
"sedist" <-
function(
M, #matrix (of a network)
method="default", # the a method used to compute distances - any of the methods alloed by functions dist, cor or cov {all package::stats} or just "cor" or "cov" (given as character)
fun="default", #which function should be used to comput distacnes (given as character),
fun.on.rows="default", # for non-standard function - does it compute measure on rows (such as cor, cov,...) of the data matrix.
# stats.dist.cor.cov=TRUE, #call "stats::dist", "stats::cor" or "stats::cov", not "dist", "cor" or "cov", if nonstandard functions are used, they should exemp the same arguments as those in package stats
handle.interaction="switch", #how should the interaction between the vertices analysed be handled:
# "switch" (the default) - assumes that when comparing units i and j, M[i,i] should be compared with M[j,j] and M[i,j] with M[j,i]
# "switch1" - the same as above, only that each pair occurs only once
# "switch2" - an alias for switch
# "ignore" (diagonal) - Diagonal is ignored
# "none" - the matrix is used "as is"
use = "pairwise.complete.obs", #for use with methods "cor" and "cov", for other methods (the default option should be used if handle.interaction=="ignore"), "pairwise.complete.obs" are always used, if stats.dist.cor.cov=TRUE
#p=2 ,#The power of the Minkowski distance in functin dist if stats.dist.cor.cov=TRUE
... #other argumets passed to fun
)
{
method<-match.arg(method, choices=c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski","pearson", "kendall", "spearman","dist","cor", "cov", "default"))
handle.interaction<-match.arg(handle.interaction, choices=c("switch", "switch1", "switch2", "ignore", "none"))
if(handle.interaction=="switch2")handle.interaction<-"switch"
if(any(method=="default", fun=="default")){
if(all(method=="default", fun=="default")){
fun<-"dist"
method<-"euclidean"
} else if(fun=="default"){
if(method %in% c("pearson", "kendall", "spearman")) fun<-"cor"
if(method %in% c("cor", "cov")){
fun<-method
method<-"pearson"
}
if(method %in% c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")) fun<-"dist"
} else {
if(fun %in% c("cor","cov")) method<-"pearson"
if(fun=="dist") method<-"euclidean"
}
}
if(handle.interaction=="ignore"&& fun %in% c("cor","cov") && use != "pairwise.complete.obs")warning("The option use='pairwise.complete.obs' should be used with handle.interaction=='ignore' && fun %in% c('cor','cov')")
# if(fun %in% c("dist", "cor" or "cov") && stats.dist.cor.cov) fun<-paste("stats::",fun,sep="")
if(fun.on.rows=="default") if(fun %in% c("cor","cov")){
fun.on.rows<-TRUE
} else fun.on.rows<-FALSE
n<-dim(M)[1]
if(n!=dim(M)[2]) stop("This function is suited for one-mode networks only")
if(fun %in% c("cor", "cov")) usearg<-list(use=use) else usearg<-NULL #usearg
if(handle.interaction %in% c("switch","switch1")){
if(fun=="cor"){
cor1<-function(...)cor(...)[1,2]
fun<-"cor1"
}
if(fun=="cov"){
cor1<-function(...)cov(...)[1,2]
fun<-"cov1"
}
X<-cbind(M,t(M))
res<-matrix(NA,ncol=n,nrow=n)
for(i in 2:n)for(j in seq(length=(i-1))){
jind<-seq(length=2*n)
jind[i]<-j
jind[j]<-i
jind[n+i]<-ifelse(handle.interaction=="switch",n+j,NA)
jind[n+j]<-ifelse(handle.interaction=="switch",n+i,NA)
Xij<-rbind(X[i,],X[j,jind])
if(fun.on.rows)Xij<-t(Xij)
res[i,j]<-do.call(fun,args=c(list(x=Xij, method=method,...),usearg))
}
if(handle.interaction=="switch1" & fun=="dist" & !(method%in%c("maximum","binary"))) res<-res*sqrt((n-1)/n)
res<-as.dist(res)
}else{
if(handle.interaction=="ignore") diag(M)<-NA
X<-cbind(M,t(M))
if(fun.on.rows)X<-t(X)
res<-do.call(fun,args=c(list(x=X, method=method,...),usearg))
}
if(class(res)=="dist")attr(res,"Labels")<-rownames(M)
if(is.matrix(res))dimnames(res)<-dimnames(M)
return(res)
}
"sedistX" <- function(
X, #a matrix composed of network and network transposed
method="default", # the a method used to compute distances - any of the methods alloed by functions dist, cor or cov {all package::stats} or just "cor" or "cov" (given as character)
fun="default", #which function should be used to comput distacnes (given as character),
fun.on.rows="default", # for non-standard function - does it compute measure on rows (such as cor, cov,...) of the data matrix.
# stats.dist.cor.cov=TRUE, #call "stats::dist", "stats::cor" or "stats::cov", not "dist", "cor" or "cov", if nonstandard functions are used, they should exemp the same arguments as those in package stats
handle.interaction="switch", #how should the interaction between the vertices analysed be handled:
# "switch" (the default) - assumes that when comparing units i and j, M[i,i] should be compared with M[j,j] and M[i,j] with M[j,i]
# "switch1" - the same as above, only that each pair occurs only once
# "switch2" - an alias for switch
# "ignore" (diagonal) - Diagonal is ignored
# "none" - the matrix is used "as is"
use = "pairwise.complete.obs", #for use with methods "cor" and "cov", for other methods (the default option should be used if handle.interaction=="ignore"), "pairwise.complete.obs" are always used, if stats.dist.cor.cov=TRUE
#p=2 ,#The power of the Minkowski distance in functin dist if stats.dist.cor.cov=TRUE
... #other argumets passed to fun
){
method<-match.arg(method, choices=c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski","pearson", "kendall", "spearman","dist","cor", "cov", "default"))
handle.interaction<-match.arg(handle.interaction, choices=c("switch", "switch1", "switch2", "ignore", "none"))
if(handle.interaction=="switch2")handle.interaction<-"switch"
if(any(method=="default", fun=="default")){
if(all(method=="default", fun=="default")){
fun<-"dist"
method<-"euclidean"
} else if(fun=="default"){
if(method %in% c("pearson", "kendall", "spearman")) fun<-"cor"
if(method %in% c("cor", "cov")){
fun<-method
method<-"pearson"
}
if(method %in% c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")) fun<-"dist"
} else {
if(fun %in% c("cor","cov")) method<-"pearson"
if(fun=="dist") method<-"euclidean"
}
}
if(handle.interaction=="ignore"&& fun %in% c("cor","cov") && use != "pairwise.complete.obs")warning("The option use='pairwise.complete.obs' should be used with handle.interaction=='ignore' && fun %in% c('cor','cov')")
# if(fun %in% c("dist", "cor" or "cov") && stats.dist.cor.cov) fun<-paste("stats::",fun,sep="")
if(fun.on.rows=="default") if(fun %in% c("cor","cov")){
fun.on.rows<-TRUE
} else fun.on.rows<-FALSE
n<-dim(X)[1]
if(dim(X)[2]%%n!=0) stop("The columns must be a multiple of the rows")
k<-dim(X)[2]/n
if(fun %in% c("cor", "cov")) usearg<-list(use=use) else usearg<-NULL #usearg
if(handle.interaction %in% c("switch","switch1")){
if(fun=="cor"){
cor1<-function(...)cor(...)[1,2]
fun<-"cor1"
}
if(fun=="cov"){
cor1<-function(...)cov(...)[1,2]
fun<-"cov1"
}
res<-matrix(NA,ncol=n,nrow=n)
for(i in 2:n)for(j in seq(length=(i-1))){
jind<-seq(length=k*n)
for(l in seq(0,k-1,by = 2)){
jind[l*n+i]<-j
jind[l*n+j]<-i
if((l+1)<k){
if(handle.interaction=="switch"){
jind[(l+1)*n+i]<-(l+1)*n+j
jind[(l+1)*n+j]<-(l+1)*n+i
}else{
jind[(l+1)*n+i]<-NA
jind[(l+1)*n+j]<-NA
}
}
}
Xij<-rbind(X[i,],X[j,jind])
if(fun.on.rows)Xij<-t(Xij)
res[i,j]<-do.call(fun,args=c(list(x=Xij, method=method,...),usearg))
}
if(handle.interaction=="switch1" & fun=="dist" & !(method%in%c("maximum","binary"))) res<-res*sqrt((n-1)/n)
res<-as.dist(res)
}else{
for(i in 1:n){
for(l in 0:(k-1)){
X[i,l*n+i]<-NA
}
}
if(fun.on.rows)X<-t(X)
res<-do.call(fun,args=c(list(x=X, method=method,...),usearg))
if(fun.on.rows)X<-t(X)
}
if(class(res)=="dist")attr(res,"Labels")<-rownames(X)
if(is.matrix(res))colnames(res)<-rownames(res)<-rownames(X)
return(res)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.