Corrected bug on passing parameter from netSI throguh apply functions

Check the test2.R file for testing
Solving issue #30 and #31

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)])
 }
 

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)

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