miga-base 0.4.3.0 → 0.5.0.0

data/utils/enveomics/enveomics.R/R/cliopts.R

@@ -1,119 +1,135 @@
-enve.cliopts <- function(
-      ### Generates nicely formatted command-line interfaces for
-      ### functions (_closures_ only).
-      fx,
-      ### Function for which the interface should be generated.
-      rd_file,
-      ### (Optional) .Rd file with the standard documentation of the function.
-      positional_arguments,
-      ### (Optional) Number of _positional_ arguments passed to parse_args
-      ### (package:optparse).
-      usage,
-      ### (Optional) Usage passed to OptionParser (package:optparse).
-      mandatory=c(),
-      ### Mandatory arguments.
-      vectorize=c(),
-      ### Arguments of the function to vectorize (comma-delimited). If numeric,
-      ### use also `number`.
-      ignore=c(),
-      ### Arguments of the function to ignore.
-      number=c(),
-      ### Force these arguments as numerics. Useful for numeric
-      ### vectors (see `vectorize`) or arguments with no defaults.
-      defaults=list(),
-      ### Defaults to use instead of the ones provided by the formals.
-      o_desc=list(),
-      ### Descriptions of the options. Help from `rd` is ignored for arguments
-      ### present in this list.
-      p_desc=""
-      ### Description of the function. Help from `rd` is ignored for the
-      ### function description unless this value is an empty string.
-      ){
-   
-   #= Load stuff
-   if(!suppressPackageStartupMessages(
-      requireNamespace("optparse", quietly=TRUE)))
-	 stop("Package 'optparse' is required.")
-   requireNamespace("tools", quietly=TRUE)
-   if(missing(positional_arguments)) positional_arguments <- FALSE
-   if(missing(usage)) usage <- "usage: %prog [options]"
-   
-   #= Get help (if any)
-   if(!missing(rd_file)){
-      rd <- tools::parse_Rd(rd_file)
-      for(i in 1:length(rd)){
-         tag <- attr(rd[[i]],'Rd_tag')
-	 if(tag=="\\description" && p_desc==""){
-	    p_desc <- paste("\n\t",as.character(rd[[i]]),sep='')
-	 }else if(tag=="\\arguments"){
-	    for(j in 1:length(rd[[i]])){
-	       if(length(rd[[i]][[j]])==2){
-		  name <- as.character(rd[[i]][[j]][[1]])
-		  if(length(o_desc[[name]])==1) next
-		  desc <- as.character(rd[[i]][[j]][[2]])
-		  o_desc[[name]] <- paste(gsub("\n","\n\t\t",desc), collapse='')
-	       }
-	    }
-	 }
-      }
-   }
-
-   #= Set options
-   o_i <- 0
-   opts <- list()
-   f <- formals(fx)
-   if(length(defaults)>0){
-      for(i in 1:length(defaults)) f[[names(defaults)[i]]] <- defaults[[i]]
-   }
-   for(i in names(f)){
-      if(i=="..." || i %in% ignore) next
-      o_i <- o_i + 1
-      flag <- gsub("\\.","-",i)
+#' Enveomics: Cliopts
+#' 
+#' Generates nicely formatted command-line interfaces for functions 
+#' (\strong{closures} only).
+#'
+#' @param fx Function for which the interface should be generated.
+#' @param rd_file (Optional) .Rd file with the standard documentation of 
+#' the function.
+#' @param positional_arguments (Optional) Number of \strong{positional} 
+#' arguments passed to \code{\link[optparse]{parse_args}} 
+#' (package: \pkg{optparse}).
+#' @param usage (Optional) Usage passed to \code{\link[optparse]{OptionParser}} 
+#' (package: \pkg{optparse}).
+#' @param mandatory Mandatory arguments.
+#' @param vectorize Arguments of the function to vectorize (comma-delimited).
+#' If numeric, use also \code{number}.
+#' @param ignore Arguments of the function to ignore.
+#' @param number Force these arguments as numerics. Useful for numeric
+#' vectors (see \code{vectorize}) or arguments with no defaults.
+#' @param defaults Defaults to use instead of the ones provided by the 
+#' formals.
+#' @param o_desc Descriptions of the options. Help from \code{rd} is ignored
+#' for arguments present in this list.
+#' @param p_desc Description Description of the function. Help from \code{rd} 
+#' is ignored for the function description unless this value is an empty string.
+#' 
+#' @return Returns a list with keys: 
+#' \itemize{
+#'    \item{\code{options}, a named list with the values for the function's 
+#'    arguments} 
+#'    \item{\code{args}, a vector with zero or more strings containing the
+#'    positional arguments}}
+#'
+#' @author Luis M. Rodriguez-R [aut, cre]
+#'
+#' @export
 
-      optopt <- list(help="")
-      if(length(o_desc[[i]])==1) optopt$help <- o_desc[[i]]
-      if(!is.null(f[[i]]) && !suppressWarnings(is.na(f[[i]])) && is.logical(f[[i]])){
-	 optopt$opt_str <- paste(ifelse(f[[i]], "--no-", "--"), flag, sep='')
-	 optopt$action  <- ifelse(f[[i]], "store_false", "store_true")
-      }else{
-	 optopt$opt_str <- paste("--", flag, sep='')
-	 optopt$action  <- "store"
-	 optopt$help <- paste(optopt$help, "\n\t\t[",
-	    ifelse(i %in% mandatory, "** MANDATORY", "default %default"),
-	    ifelse(i %in% vectorize, ", separate values by commas", ""),
-	    "].", sep="")
-      }
-      if(!is.name(f[[i]])){
-	 optopt$default <- f[[i]]
-	 optopt$metavar <- class(f[[i]])
+enve.cliopts <- function(
+  fx,
+  rd_file,
+  positional_arguments,
+  usage,
+  mandatory=c(),
+  vectorize=c(),
+  ignore=c(),
+  number=c(),
+  defaults=list(),
+  o_desc=list(),
+  p_desc=""
+){
+  
+  #= Load stuff
+  if(!suppressPackageStartupMessages(
+    requireNamespace("optparse", quietly=TRUE)))
+    stop("Package 'optparse' is required.")
+  requireNamespace("tools", quietly=TRUE)
+  if(missing(positional_arguments)) positional_arguments <- FALSE
+  if(missing(usage)) usage <- "usage: %prog [options]"
+  
+  #= Get help (if any)
+  if(!missing(rd_file)){
+    rd <- tools::parse_Rd(rd_file)
+    for(i in 1:length(rd)){
+      tag <- attr(rd[[i]],'Rd_tag')
+      if(tag=="\\description" && p_desc==""){
+        p_desc <- paste("\n\t",as.character(rd[[i]]),sep='')
+      }else if(tag=="\\arguments"){
+        for(j in 1:length(rd[[i]])){
+          if(length(rd[[i]][[j]])==2){
+            name <- as.character(rd[[i]][[j]][[1]])
+            if(length(o_desc[[name]])==1) next
+            desc <- as.character(rd[[i]][[j]][[2]])
+            o_desc[[name]] <- paste(gsub("\n","\n\t\t",desc), collapse='')
+          }
+        }
       }
-      if(i %in% number) optopt$metavar <- "NUMERIC"
-      optopt$dest <- i
-      
-      opts[[o_i]] <- do.call(optparse::make_option, optopt)
-   }
-   opt <- optparse::parse_args(
-      optparse::OptionParser(option_list=opts, description=p_desc, usage=usage),
-      positional_arguments=positional_arguments)
-
-   #= Post-hoc checks
-   if(length(opt[['options']])==0) opt <- list(options=opt, args=c())
-   for(i in mandatory){
-      if(length(opt$options[[i]])==0) stop('Missing mandatory argument: ',i)
-   }
-   for(i in vectorize){
-      if(length(opt$options[[i]])==1)
-	 opt$options[[i]] <- strsplit(opt$options[[i]],",")[[1]]
-   }
-   for(i in number){
-      if(length(opt$options[[i]])>0)
-	 opt$options[[i]] <- as.numeric(opt$options[[i]])
-   }
-   opt$options$help <- NULL
-   
-   return(opt)
-   ### Returns a `list` with keys: `options`, a named list with the values for
-   ### the function's arguments; and `args`, a vector with zero or more strings
-   ### containing the positional arguments.
+    }
+  }
+  
+  #= Set options
+  o_i <- 0
+  opts <- list()
+  f <- formals(fx)
+  if(length(defaults)>0){
+    for(i in 1:length(defaults)) f[[names(defaults)[i]]] <- defaults[[i]]
+  }
+  for(i in names(f)){
+    if(i=="..." || i %in% ignore) next
+    o_i <- o_i + 1
+    flag <- gsub("\\.","-",i)
+    
+    optopt <- list(help="")
+    if(length(o_desc[[i]])==1) optopt$help <- o_desc[[i]]
+    if(!is.null(f[[i]]) && !suppressWarnings(is.na(f[[i]])) && is.logical(f[[i]])){
+      optopt$opt_str <- paste(ifelse(f[[i]], "--no-", "--"), flag, sep='')
+      optopt$action  <- ifelse(f[[i]], "store_false", "store_true")
+    }else{
+      optopt$opt_str <- paste("--", flag, sep='')
+      optopt$action  <- "store"
+      optopt$help <- paste(optopt$help, "\n\t\t[",
+                           ifelse(i %in% mandatory, "** MANDATORY", "default %default"),
+                           ifelse(i %in% vectorize, ", separate values by commas", ""),
+                           "].", sep="")
+    }
+    if(!is.name(f[[i]])){
+      optopt$default <- f[[i]]
+      optopt$metavar <- class(f[[i]])
+    }
+    if(i %in% number) optopt$metavar <- "NUMERIC"
+    optopt$dest <- i
+    
+    opts[[o_i]] <- do.call(optparse::make_option, optopt)
+  }
+  opt <- optparse::parse_args(
+    optparse::OptionParser(option_list=opts, description=p_desc, usage=usage),
+    positional_arguments=positional_arguments)
+  
+  #= Post-hoc checks
+  if(length(opt[['options']])==0) opt <- list(options=opt, args=c())
+  for(i in mandatory){
+    if(length(opt$options[[i]])==0) stop('Missing mandatory argument: ',i)
+  }
+  for(i in vectorize){
+    if(length(opt$options[[i]])==1)
+      opt$options[[i]] <- strsplit(opt$options[[i]],",")[[1]]
+  }
+  for(i in number){
+    if(length(opt$options[[i]])>0)
+      opt$options[[i]] <- as.numeric(opt$options[[i]])
+  }
+  opt$options$help <- NULL
+  
+  return(opt)
 }
 

data/utils/enveomics/enveomics.R/R/df2dist.R

@@ -1,117 +1,155 @@
+#' Enveomics: Data Frame to Dist
+#' 
+#' Transform a dataframe (or coercible object, like a table) into a
+#' \strong{dist} object.
+#' 
+#' @param x A dataframe (or coercible object) with at least three columns:
+#' \enumerate{
+#'    \item ID of the object 1, 
+#'    \item ID of the object 2, and 
+#'    \item distance between the two objects.}
+#' @param obj1.index Index of the column containing the ID of the object 1.
+#' @param obj2.index Index of the column containing the ID of the object 2.
+#' @param dist.index Index of the column containing the distance.
+#' @param default.d Default value (for missing values).
+#' @param max.sim If not zero, assumes that the values are similarity
+#' (not distance) and this is the maximum similarity (corresponding to 
+#' distance 0). Applies transformation: 
+#' \eqn{distance = (max.sim - values)/max.sim.}
+#' 
+#' @return Returns a \strong{dist} object.
+#' 
+#' @author Luis M. Rodriguez-R [aut, cre]
+#' 
+#' @export
 
 enve.df2dist <- function(
-	### Transform a dataframe (or coercible object, like a table) into a `dist` object.
-	x,
-	### A table (or coercible object) with at least three columns: (1) ID of the object 1,
-	### (2) ID of the object 2, and (3) distance between the two objects.
-	obj1.index=1,
-	### Index of the column containing the ID of the object 1.
-	obj2.index=2,
-	### Index of the column containing the ID of the object 2.
-	dist.index=3,
-	### Index of the column containing the distance.
-	default.d=NA,
-	### Default value (for missing values)
-	max.sim=0
-	### If not-zero, assumes that the values are similarity (not distance)
-	### and this is the maximum similarity (corresponding to distance 0).
-	### Applies transformation: distance = (max.sim - values)/max.sim.
-	){
-   x <- as.data.frame(x);
-   a <- as.character(x[, obj1.index]);
-   b <- as.character(x[, obj2.index]);
-   d <- as.double(x[, dist.index]);
-   if(max.sim!=0) d <- (max.sim - d)/max.sim
-   ids <- unique(c(a,b));
-   m <- matrix(default.d, nrow=length(ids), ncol=length(ids), dimnames=list(ids, ids));
-   diag(m) <- 0.0
-   for(i in 1:nrow(x)){
-      m[a[i], b[i]] <- d[i];
-   }
-   m <- pmin(m, t(m), na.rm=TRUE)
-   return(as.dist(m));
-   ### Returns a `dist` object.
+  x,
+  obj1.index=1,
+  obj2.index=2,
+  dist.index=3,
+  default.d=NA,
+  max.sim=0
+){
+  x <- as.data.frame(x);
+  a <- as.character(x[, obj1.index]);
+  b <- as.character(x[, obj2.index]);
+  d <- as.double(x[, dist.index]);
+  if(max.sim!=0) d <- (max.sim - d)/max.sim
+  ids <- unique(c(a,b));
+  m <- matrix(default.d, nrow=length(ids), ncol=length(ids), dimnames=list(ids, ids));
+  diag(m) <- 0.0
+  for(i in 1:nrow(x)){
+    m[a[i], b[i]] <- d[i];
+  }
+  m <- pmin(m, t(m), na.rm=TRUE)
+  return(as.dist(m));
 }
 
-
+#' Enveomics: Data Frame to Dist (Group)
+#' 
+#' Transform a dataframe (or coercible object, like a table) into a 
+#' \strong{dist} object, where there are 1 or more distances between each pair 
+#' of objects.
+#' 
+#' @param x A dataframe (or coercible object) with at least three columns:
+#' \enumerate{
+#'    \item ID of the object 1, 
+#'    \item ID of the object 2, and 
+#'    \item distance between the two objects.}
+#' @param obj1.index Index of the column containing the ID of the object 1.
+#' @param obj2.index Index of the column containing the ID of the object 2.
+#' @param dist.index Index of the column containing the distance.
+#' @param summary Function summarizing the different distances between the 
+#' two objects.
+#' @param empty.rm Remove rows with empty or \code{NA} groups.
+#' 
+#' @return Returns a \strong{dist} object.
+#'
+#' @author Luis M. Rodriguez-R [aut, cre]
+#' 
+#' @export
 
 enve.df2dist.group <- function(
-	### Transform a dataframe (or coercible object, like a table) into a `dist` object, where
-	### there are 1 or more distances between each pair of objects.
-	x,
-	### A dataframe (or coercible object) with at least three columns: (1) ID of the object 1,
-	### (2) ID of the object 2, and (3) distance between the two objects.
-	obj1.index=1,
-	### Index of the column containing the ID of the object 1.
-	obj2.index=2,
-	### Index of the column containing the ID of the object 2.
-	dist.index=3,
-	### Index of the column containing the distance.
-	summary=median,
-	### Function summarizing the different distances between the two objects.
-	empty.rm=TRUE
-	### Remove rows with empty or NA groups
-	){
-   x <- as.data.frame(x);
-   if(empty.rm) x <- x[ !(is.na(x[,obj1.index]) | is.na(x[,obj2.index]) | x[,obj1.index]=='' | x[,obj2.index]==''), ]
-   a <- as.character(x[, obj1.index]);
-   b <- as.character(x[, obj2.index]);
-   d <- as.double(x[, dist.index]);
-   ids <- unique(c(a,b));
-   if(length(ids)<2) return(NA);
-   m <- matrix(NA, nrow=length(ids), ncol=length(ids), dimnames=list(ids, ids));
-   diag(m) <- 0
-   for(i in 2:length(ids)){
-      id.i <- ids[i];
-      for(j in 1:(i-1)){
-	 id.j <- ids[j];
-	 d.ij <- summary(c( d[ a==id.i & b==id.j], d[ b==id.i & a==id.j] ));
-	 m[id.i, id.j] <- d.ij;
-	 m[id.j, id.i] <- d.ij;
-      }
-   }
-   return(as.dist(m));
-   ### Returns a `dist` object.
+  x,
+  obj1.index=1,
+  obj2.index=2,
+  dist.index=3,
+  summary=median,
+  empty.rm=TRUE
+){
+  x <- as.data.frame(x);
+  if(empty.rm) x <- x[ !(is.na(x[,obj1.index]) | is.na(x[,obj2.index]) | x[,obj1.index]=='' | x[,obj2.index]==''), ]
+  a <- as.character(x[, obj1.index]);
+  b <- as.character(x[, obj2.index]);
+  d <- as.double(x[, dist.index]);
+  ids <- unique(c(a,b));
+  if(length(ids)<2) return(NA);
+  m <- matrix(NA, nrow=length(ids), ncol=length(ids), dimnames=list(ids, ids));
+  diag(m) <- 0
+  for(i in 2:length(ids)){
+    id.i <- ids[i];
+    for(j in 1:(i-1)){
+      id.j <- ids[j];
+      d.ij <- summary(c( d[ a==id.i & b==id.j], d[ b==id.i & a==id.j] ));
+      m[id.i, id.j] <- d.ij;
+      m[id.j, id.i] <- d.ij;
+    }
+  }
+  return(as.dist(m));
 }
 
+#' Enveomics: Data Frame to Dist (List)
+#' 
+#' Transform a dataframe (or coercible object, like a table)
+#' into a \strong{dist} object.
+#' 
+#' @param x A dataframe (or coercible object) with at least three columns:
+#' \enumerate{
+#'    \item ID of the object 1, 
+#'    \item ID of the object 2, and 
+#'    \item distance between the two objects.}
+#' @param groups Named array where the IDs correspond to the object IDs,
+#' and the values correspond to the group.
+#' @param obj1.index Index of the column containing the ID of the object 1.
+#' @param obj2.index Index of the column containing the ID of the object 2.
+#' @param dist.index Index of the column containing the distance.
+#' @param empty.rm Remove incomplete matrices.
+#' @param ... Any other parameters supported by
+#' \code{\link{enve.df2dist.group}}.
+#' 
+#' @return Returns a \strong{list} of \strong{dist} objects.
+#'
+#' @author Luis M. Rodriguez-R [aut, cre]
+#' 
+#' @export
+
 enve.df2dist.list <- function(
-	### Transform a dataframe (or coercible object, like a table) into a `dist` object.
-	x,
-	### A dataframe (or coercible object) with at least three columns: (1) ID of the object 1,
-	### (2) ID of the object 2, and (3) distance between the two objects.
-	groups,
-	### Named array where the IDs correspond to the object IDs, and the values correspond to
-	### the group.
-	obj1.index=1,
-	### Index of the column containing the ID of the object 1.
-	obj2.index=2,
-	### Index of the column containing the ID of the object 2.
-	dist.index=3,
-	### Index of the column containing the distance.
-	empty.rm=TRUE,
-	### Remove incomplete matrices
-	...
-	### Any other parameters supported by `enve.df2dist.group`.
-	){
-   x <- as.data.frame(x);
-   a <- as.character(x[, obj1.index]);
-   b <- as.character(x[, obj2.index]);
-   d <- as.numeric(x[, dist.index]);
-   ids.all <- unique(c(a,b));
-   l <- list();
-   same_group <- groups[a]==groups[b];
-   same_group <- ifelse(is.na(same_group), FALSE, TRUE);
-   for(group in unique(groups)){
-      ids <- ids.all[ groups[ids.all]==group ];
-      if(length(ids)>1 & group!=""){
-	 x.sub <- x[ same_group & (groups[a]==group) & (groups[b]==group), ]
-	 if(nrow(x.sub)>0){
-	    d.g <- enve.df2dist(x.sub, obj1.index, obj2.index, dist.index, ...);
-	    if(!empty.rm | !any(is.na(d.g))) l[[ group ]] <- d.g;
-	 }
+  x,
+  groups,
+  obj1.index=1,
+  obj2.index=2,
+  dist.index=3,
+  empty.rm=TRUE,
+  ...
+){
+  x <- as.data.frame(x);
+  a <- as.character(x[, obj1.index]);
+  b <- as.character(x[, obj2.index]);
+  d <- as.numeric(x[, dist.index]);
+  ids.all <- unique(c(a,b));
+  l <- list();
+  same_group <- groups[a]==groups[b];
+  same_group <- ifelse(is.na(same_group), FALSE, TRUE);
+  for(group in unique(groups)){
+    ids <- ids.all[ groups[ids.all]==group ];
+    if(length(ids)>1 & group!=""){
+      x.sub <- x[ same_group & (groups[a]==group) & (groups[b]==group), ]
+      if(nrow(x.sub)>0){
+        d.g <- enve.df2dist(x.sub, obj1.index, obj2.index, dist.index, ...);
+        if(!empty.rm | !any(is.na(d.g))) l[[ group ]] <- d.g;
       }
-   }
-   return(l);
-   ### Returns a `list` of `dist` object.
+    }
+  }
+  return(l);
 }
-