diff --git a/R/netSI.R b/R/netSI.R index 94048fb..48954f5 100644 --- a/R/netSI.R +++ b/R/netSI.R @@ -1,12 +1,12 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', - method="montecarlo", k=3, h=20, n.cores,save=TRUE, + method="montecarlo", k=3, h=20, n.cores=NULL,save=TRUE, verbose=TRUE, ...){ ## Get the function call parameters ## NB the parameters should be evaluated with eval() Call <- match.call() -# #add a check so that an unexisting parameter cannot be passed + ##add a check so that an unexisting parameter cannot be passed id.Call <- match( names(Call),c("x", "indicator", "d", "adj.method" , "method","k","h","n.cores","save","verbose", "FDR","P","measure","alpha","C","DP","var.thr", @@ -89,11 +89,11 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', set.seed(sseed) ## Pass parameter gamma to netdist functions - if(!is.null(Call$ga)){ - ga <- eval(Call$ga) - } else { - ga <- Call$ga} - + ## if(!is.null(Call$ga)){ + ## ga <- eval(Call$ga) + ## } else { + ## ga <- Call$ga} + ## Pass parameter components to netdist functions if(!is.null(Call$components)){ components <- eval(Call$components) @@ -157,7 +157,7 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', },DAT=x,method=adj.method,...) } else { ## One core computation - ADJcv <- lapply(X=idxs,FUN=function(x,DAT,method,...){ + ADJcv <- lapply(X=idxs,FUN=function(x,DAT,method, ...){ ss <- DAT[x,] tmp <- mat2adj(ss, method=method, ...) return(tmp) @@ -171,7 +171,7 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', netsi <- list() if(indicator==1L | indicator==5L){ if(verbose==TRUE) cat("computing stability indicator S...\n") - netsi[["S"]] <- netsiS(ADJall, ADJcv, d=d, cl=cl, ga=ga, ...) + netsi[["S"]] <- netsiS(ADJall, ADJcv, d=d, cl=cl, ...) } if(indicator==3L | indicator==5L){ if(verbose==TRUE) cat("computing stability indicator Sw...\n") @@ -186,7 +186,7 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', if(indicator==2L | indicator==5L){ if(verbose==TRUE) cat("computing stability indicator SI...\n") - netsi[["SI"]] <- netsiSI(ADJcv, d=d, ga=ga, n.cores=n.cores, ...) + netsi[["SI"]] <- netsiSI(ADJcv, d=d, n.cores=n.cores, ...) } @@ -211,31 +211,31 @@ netSI <- function(x,indicator="all", d='HIM', adj.method='cor', ## Stability indicator S -netsiS <- function(g, H, d, cl, ga, ...){ +netsiS <- function(g, H, d, cl, ...){ DIST <- c("HIM","IM","H") type <- pmatch(d,DIST) type <- DIST[type] if(!is.null(cl)){ - s <- parLapply(cl=cl,X=H,fun=function(x,g,type,ga, ...){ - res <- nettools:::netdist(g,x,d=type, ga=ga, n.cores=1, ...)[[type]] + s <- parLapply(cl=cl,X=H,fun=function(x,g,type, ...){ + res <- nettools:::netdist(g,x,d=type, n.cores=1, ...)[[type]] return(res) - },g=g,type=type, ga=ga, ...) + }, g=g, type=type, ...) }else{ - s <- lapply(X=H,FUN=function(x,g,type, ga, ...){ - res <- netdist(g,x,d=type, ga=ga, n.cores=1, ...)[[type]] + s <- lapply(X=H,FUN=function(x,g,type, ...){ + res <- netdist(g,x,d=type, n.cores=1, ...)[[type]] return(res) - },g=g,type=type, ga=ga, ...) + },g=g,type=type, ...) } return(unlist(s)) } ## Stability indicator SI -netsiSI <- function(H, d, ga, ...){ +netsiSI <- function(H, d, ...){ DIST <- c("HIM","IM","H") type <- pmatch(d,DIST) type <- DIST[type] - s <- netdist(H,d=type,ga=ga, components=FALSE, ...)[[1]] + s <- netdist(H,d=type, ...)[[1]] return(s[upper.tri(s)]) } diff --git a/R/netdist.R b/R/netdist.R index 188b179..8b442dd 100644 --- a/R/netdist.R +++ b/R/netdist.R @@ -25,16 +25,15 @@ netdist.matrix <- function(x, h=NULL, d="HIM", ga=NULL, components=TRUE, ...){ ##add a check so that an unexisting parameter cannot be passed id.Call <- match( names(Call),c("x", "h", "d", "ga","components","n.cores","verbose", "rho"), nomatch=0) if(sum(id.Call[-1]==0)==1){ - warning("The parameter '",names(Call)[which(id.Call==0)[2]],"' will be ignored",call.=FALSE) + warning("For netdist function the parameter '",names(Call)[which(id.Call==0)[2]],"' will be ignored",call.=FALSE) } if(sum(id.Call[-1]==0)>1){ - msg <- "The following parameters will be ignored:\n" + msg <- "For netdist function, the following parameters will be ignored:\n" for(i in which(id.Call==0)[-1]){ msg <- paste(msg,"'",names(Call)[i],"'\n",sep="") } warning(msg,call.=FALSE) } - if(is.na(d)) stop("invalid distance") if(d == -1) @@ -57,8 +56,14 @@ netdist.matrix <- function(x, h=NULL, d="HIM", ga=NULL, components=TRUE, ...){ warning("components parameter will be ignored", call. = FALSE) } } - + ## if(!is.null(Call$ga)){ + ## ga <- eval(Call$ga) + ## } else { + ## ga <- NULL + ## } + ## print(ga) ##check on ga passing through ipsen function + if(is.null(ga)){ if(d==2){ warning("The ga parameter will be automatically defined.", call.=FALSE) diff --git a/man/netdist.Rd b/man/netdist.Rd index 30c4903..18ef6fc 100644 --- a/man/netdist.Rd +++ b/man/netdist.Rd @@ -16,8 +16,8 @@ %- Also NEED an '\alias' for EACH other topic documented here. \title{Distances between network} \description{ - Function that computes the distance between two adjacency matrix given as - matrix, igraph objects or list of matrices. + This function computes the distance between two adjacency matrix given + as matrices or igraph objects. } %- maybe also 'usage' for other objects documented here. @@ -32,11 +32,11 @@ netdist(x,\dots) } \arguments{ - \item{x}{Adjacency matrix, igraph object or list of adjacency matrices} - \item{h}{Adjacency matrix or igraph object. Only when \code{x} is a matrix object. } - \item{d}{\code{HIM} - (default), or character string containing a valid method - between the follwing: \code{"IM"}, \code{"ipsen"}, \code{"Ipsen"}, + \item{x}{Adjacency matrix, igraph object or list of adjacency + matrices/igraph objects} + \item{h}{Adjacency matrix or igraph object. Only when \code{x} is a matrix object.} + \item{d}{\code{HIM} (default), character string containing a valid method. + Accepted values are: \code{"IM"}, \code{"ipsen"}, \code{"Ipsen"}, \code{"IpsenMikhailov"}, or \code{"Ipsen-Mikhailov"}, for Ipsen-Mikhailov distance and \code{"H"}, \code{"hamming"}, or \code{"Hamming"} for Hamming distance.} \item{ga}{\code{NULL} (default), a numeric value for the gamma parameter used