miga-base 1.2.17.1 → 1.2.17.3

data/utils/enveomics/enveomics.R/R/barplot.R

@@ -35,150 +35,169 @@
 #' Any value above 100 indicates that no values are to be reported.
 #' @param order Controls how the rows should be ordered. 
 #' \itemize{
-#'    \item{If \code{NULL} 
-#'    (default), \code{sort.by} is applied per row and the results are 
-#'    sorted decreasingly.}
-#'    \item{If \code{NA}, no sorting is performed, i.e., the original
-#'    order is respected.}
-#'    \item{If a vector is provided, it is assumed to be the 
-#'    custom order to be used (either by numeric index or by row names).}
-#'    }
+#'   \item{
+#'     If \code{NULL} (default), \code{sort.by} is applied per row and the
+#'     results are sorted decreasingly.
+#'   }
+#'   \item{
+#'     If \code{NA}, no sorting is performed, i.e., the original order is
+#'     respected.
+#'   }
+#'   \item{
+#'     If a vector is provided, it is assumed to be the custom order to be used
+#'     (either by numeric index or by row names).
+#'   }
+#' }
 #' @param col Colors to use. If provided, overrides the variables \code{top}
 #' and \code{colors.per.group}, but \code{other.col} is still used if the 
-#' vector is insufficient for all the rows. An additional palette is available with
-#' \code{col='coto'} (contributed by Luis (Coto) Orellana).
+#' vector is insufficient for all the rows. An additional palette is available
+#' with \code{col='coto'} (contributed by Luis (Coto) Orellana).
 #' @param ... Any additional parameters to be passed to barplot.
 #' 
+#' @return No return value
+#' 
 #' @author Luis M. Rodriguez-R [aut, cre]
 #' 
 #' @examples
 #' # Load data
-#' data("phyla.counts", package="enveomics.R", envir=environment())
+#' data("phyla.counts", package = "enveomics.R", envir = environment())
 #' # Create a barplot sorted by variance with organic trends
 #' enve.barplot(
-#'     phyla.counts, # Counts of phyla in four sites
-#'     sizes=c(250,100,75,200), # Total sizes of the datasets of each site
-#'     bars.width=2, # Decrease from default, so the names are fully displayed
-#'     organic.trend=TRUE, # Nice curvy background
-#'     sort.by=var # Sort by variance across sites
-#'     )
-#'
+#'   phyla.counts, # Counts of phyla in four sites
+#'   sizes = c(250,100,75,200), # Total sizes of the datasets of each site
+#'   bars.width = 2, # Decrease from default, so the names are fully displayed
+#'   organic.trend = TRUE, # Nice curvy background
+#'   sort.by = var # Sort by variance across sites
+#' )
+#' 
 #' @export
 
 enve.barplot <- function(
   x,
   sizes,
-  top=25,
-  colors.per.group=9,
-  bars.width=4,
-  legend.ncol=1,
-  other.col='#000000',
-  add.trend=FALSE,
-  organic.trend=FALSE,
-  sort.by=median,
-  min.report=101,
-  order=NULL,
+  top = 25,
+  colors.per.group = 9,
+  bars.width = 4,
+  legend.ncol = 1,
+  other.col = "#000000",
+  add.trend = FALSE,
+  organic.trend = FALSE,
+  sort.by = median,
+  min.report = 101,
+  order = NULL,
   col,
   ...
 ){
-  
   # Read input
-  if(is.character(x)){
-    c <- read.table(x, sep='\t', header=TRUE, row.names=1, quote='',
-                    comment.char='')
-  }else{
+  if (is.character(x)) {
+    c <- read.table(x, sep = "\t", header = TRUE, row.names = 1, quote = "",
+                    comment.char = "")
+  } else {
     c <- as.data.frame(x)
   }
-  if(missing(sizes)) sizes = colSums(c)
+  if (missing(sizes)) sizes <- colSums(c)
   p <- c
-  for (i in 1:ncol(c)) p[, i] <- c[, i]*100/sizes[i]
-  if(top > nrow(p)) top = nrow(p)
-  
+  for (i in 1:ncol(c)) p[, i] <- c[, i] * 100 / sizes[i]
+  if(top > nrow(p)) top <- nrow(p)
+
   # Sort
-  if(is.null(order[1])){
+  if (is.null(order[1])) {
     p <- p[order(apply(p, 1, sort.by)), ]
-  }else if(is.na(order[1])){
+  } else if (is.na(order[1])) {
     
-  }else{
+  } else {
     p <- p[order, ]
   }
-  if(organic.trend) add.trend=TRUE
-  
+  if(organic.trend) add.trend <- TRUE
+
   # Colors
-  if(is.null(top)) top <- nrow(p)
-  if(missing(col)){
-    color.col <- rainbow(min(colors.per.group, top), s=1, v=4/5)
-    if(top > colors.per.group) color.col <- c(color.col,
-                                              rainbow(min(colors.per.group*2, top)-colors.per.group, s=3/4, v=3/5))
-    if(top > colors.per.group*2) color.col <- c(color.col,
-                                                rainbow(top-colors.per.group*2, s=1, v=1.25/4))
-  }else if(length(col)==1 & col[1]=="coto"){
-    color.col <- c("#5BC0EB","#FDE74C","#9BC53D","#E55934","#FA7921","#EF476F",
-                   "#FFD166","#06D6A0","#118AB2","#073B4C","#264653","#2A9D8F",
-                   "#E9C46A","#F4A261","#E76F51")
-    color.col <- head(color.col, n=nrow(p))
+  if (is.null(top)) top <- nrow(p)
+  if (missing(col)) {
+    color.col <- rainbow(min(colors.per.group, top), s = 1, v = 4/5)
+    if(top > colors.per.group)
+      color.col <- c(color.col,
+                     rainbow(min(colors.per.group * 2, top) - colors.per.group,
+                             s = 3/4, v = 3/5))
+    if(top > colors.per.group * 2)
+      color.col <- c(color.col,
+                     rainbow(top-colors.per.group * 2, s = 1, v = 1.25 / 4))
+  } else if (length(col) == 1 & col[1] == "coto") {
+    color.col <- c("#5BC0EB", "#FDE74C", "#9BC53D", "#E55934", "#FA7921",
+                   "#EF476F", "#FFD166", "#06D6A0", "#118AB2", "#073B4C",
+                   "#264653", "#2A9D8F", "#E9C46A", "#F4A261", "#E76F51")
+    color.col <- head(color.col, n = nrow(p))
     top <- length(color.col)
-  }else{
+  } else {
     color.col <- col
-    color.col <- tail(color.col, n=nrow(p))
+    color.col <- tail(color.col, n = nrow(p))
     top <- length(color.col)
   }
   
   # Plot
-  layout(matrix(1:2, nrow=1), widths=c(bars.width,1))
-  mar <- par('mar')
-  par(mar=c(5,4,4,0)+0.1)
-  mp <- barplot(as.matrix(p),
-                col=rev(c(color.col, rep(other.col, nrow(p)-length(color.col)))),
-                border=NA,space=ifelse(add.trend,ifelse(organic.trend,0.75,0.5),0.2), ...)
-  if(add.trend || min.report < max(p)){
+  layout(matrix(1:2, nrow = 1), widths = c(bars.width, 1))
+  mar <- par(mar = c(5, 4, 4, 0) + 0.1) 
+  on.exit(par(mar)) 
+  mp <- barplot(
+    as.matrix(p),
+    col = rev(c(color.col, rep(other.col, nrow(p) - length(color.col)))),
+    space = ifelse(add.trend,ifelse(organic.trend, 0.75, 0.5), 0.2),
+    border = NA, ...
+  )
+  if (add.trend || min.report < max(p)) {
     color.alpha <- enve.col.alpha(c(color.col, other.col), 1/4)
-    if(top < nrow(p)){
+    if (top < nrow(p)) {
       cf <- colSums(p[1:(nrow(p)-top), ])
-    }else{
+    } else {
       cf <- rep(0, ncol(p))
     }
-    for(i in (nrow(p)-top+1):nrow(p)){
+    for (i in (nrow(p) - top + 1):nrow(p)) {
       f <- as.numeric(p[i, ])
       cf <- as.numeric(cf + f)
-      if(nrow(p)-i < top){
-        if(organic.trend){
+      if (nrow(p) - i < top){
+        if (organic.trend) {
           spc <- 0.5
-          x <- c(mp[1]-spc)
-          y1 <- c(cf[1]-f[1])
+          x <- c(mp[1] - spc)
+          y1 <- c(cf[1] - f[1])
           y2 <- c(cf[1])
-          for(j in 2:ncol(p)){
-            x <- c(x, seq(mp[j-1]+spc, mp[j]-spc, length.out=22))
-            y1 <- c(y1, cf[j-1]-f[j-1],
-                    (tanh(seq(-2.5,2.5,length.out=20))/2+.5)*
-                      ((cf[j]-f[j])-(cf[j-1]-f[j-1]))+(cf[j-1]-f[j-1]), cf[j]-f[j])
-            y2 <- c(y2, cf[j-1],
-                    (tanh(seq(-2.5,2.5,length.out=20))/2+.5)*
-                      (cf[j]-cf[j-1])+(cf[j-1]), cf[j])
+          for (j in 2:ncol(p)) {
+            x <- c(x, seq(mp[j - 1] + spc, mp[j] - spc, length.out = 22))
+            y1 <- c(
+              y1, cf[j - 1] - f[j - 1],
+              (tanh(seq(-2.5, 2.5, length.out = 20)) / 2 + 0.5) *
+                ((cf[j] - f[j]) - (cf[j - 1] - f[j - 1])) +
+                (cf[j - 1] - f[j - 1]),
+              cf[j] - f[j]
+            )
+            y2 <- c(
+              y2, cf[j-1],
+              (tanh(seq(-2.5, 2.5, length.out = 20)) / 2 + 0.5) *
+                (cf[j] - cf[j - 1]) + (cf[j - 1]), cf[j]
+            )
           }
-          x <- c(x, mp[length(mp)]+spc)
-          y1 <- c(y1, cf[length(cf)]-f[length(f)])
+          x <- c(x, mp[length(mp)] + spc)
+          y1 <- c(y1, cf[length(cf)] - f[length(f)])
           y2 <- c(y2, cf[length(cf)])
-          polygon(c(x, rev(x)), c(y1, rev(y2)), col=color.alpha[nrow(p)-i+1],
-                  border=NA)
-        }else if(add.trend){
-          x <- rep(mp, each=2)+c(-0.5,0.5)
-          if(add.trend) polygon(c(x, rev(x)),
-                                c(rep(cf-f, each=2), rev(rep(cf, each=2))),
-                                col=color.alpha[nrow(p)-i+1], border=NA)
+          polygon(c(x, rev(x)), c(y1, rev(y2)),
+                  col = color.alpha[nrow(p) - i + 1], border = NA)
+        } else if (add.trend) {
+          x <- rep(mp, each = 2) + c(-0.5, 0.5)
+          if(add.trend)
+            polygon(c(x, rev(x)),
+                    c(rep(cf - f, each = 2), rev(rep(cf, each = 2))),
+                    col = color.alpha[nrow(p) - i + 1], border = NA)
         }
-        text(mp, cf-f/2, ifelse(f>min.report, signif(f, 3), ''), col='white')
+        text(mp, cf - f / 2, ifelse(f > min.report, signif(f, 3), ""),
+             col = "white")
       }
     }
   }
-  
+
   # Legend
-  par(mar=rep(0,4)+0.1)
-  plot(1, t='n', bty='n', xlab='', ylab='', xaxt='n', yaxt='n')
-  nam <- rownames(p[nrow(p):(nrow(p)-top+1), ])
-  if(top < nrow(p)) nam <- c(nam,
-                             paste('Other (',nrow(p)-length(color.col),')', sep=''))
-  legend('center', col=c(color.col, other.col), legend=nam, pch=15, bty='n',
-         pt.cex=2, ncol=legend.ncol)
-  par(mar=mar)
+  par(mar = rep(0, 4) + 0.1) # par(mar) already being watched by on.exit
+  plot(1, t = "n", bty = "n", xlab = "", ylab = "", xaxt = "n", yaxt = "n")
+  nam <- rownames(p[nrow(p):(nrow(p) - top + 1), ])
+  if(top < nrow(p))
+    nam <- c(nam, paste("Other (", nrow(p) - length(color.col), ")", sep = ""))
+  legend("center", col = c(color.col, other.col), legend = nam, pch = 15,
+         bty = "n", pt.cex = 2, ncol = legend.ncol)
 }

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

@@ -40,96 +40,102 @@ enve.cliopts <- function(
   rd_file,
   positional_arguments,
   usage,
-  mandatory=c(),
-  vectorize=c(),
-  ignore=c(),
-  number=c(),
-  defaults=list(),
-  o_desc=list(),
-  p_desc=""
+  mandatory = c(),
+  vectorize = c(),
+  ignore    = c(),
+  number    = c(),
+  defaults  = list(),
+  o_desc    = list(),
+  p_desc    = ""
 ){
-  
-  #= Load stuff
-  if(!suppressPackageStartupMessages(
-    requireNamespace("optparse", quietly=TRUE)))
+  # 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)){
+  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){
+    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
+            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='')
+            o_desc[[name]] <- paste(gsub("\n", "\n\t\t", desc), collapse = "")
           }
         }
       }
     }
   }
-  
-  #= Set options
+
+  # 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]]
+  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
+  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='')
+    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='')
+    } 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="")
+      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]])){
+    if (!is.name(f[[i]])) {
       optopt$default <- f[[i]]
       optopt$metavar <- class(f[[i]])
     }
-    if(i %in% number) optopt$metavar <- "NUMERIC"
+    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)
+    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)
+  # 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 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)
+  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

@@ -20,27 +20,40 @@
 #' @return Returns a \strong{dist} object.
 #' 
 #' @author Luis M. Rodriguez-R [aut, cre]
+#'
+#' @examples
+#' # A sparse matrix representation of similarities as data frame.
+#' # The column "extra_data" is meaningless, only included to illustrate
+#' # the use of the obj*.index parameters
+#' sim <- data.frame(
+#'   extra_data = c(0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.5),
+#'   query      = c("A", "A", "A", "B", "C", "C", "D"),
+#'   subject    = c("A", "B", "C", "B", "C", "B", "A"),
+#'   similarity = c(100,  90,  60, 100, 100,  70,  10)
+#' )
+#' dist <- enve.df2dist(sim, "query", "subject", "similarity", max.sim = 100)
+#' print(dist)
 #' 
 #' @export
-
 enve.df2dist <- function(
   x,
   obj1.index = 1,
   obj2.index = 2,
   dist.index = 3,
-  default.d = NA,
-  max.sim = 0
-){
+  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))
+  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
-  m[cbind(a,b)] <- d
+  m[cbind(a, b)] <- d
   m <- pmin(m, t(m), na.rm = TRUE)
   return(as.dist(m))
 }
@@ -55,7 +68,8 @@ enve.df2dist <- function(
 #' \enumerate{
 #'    \item ID of the object 1, 
 #'    \item ID of the object 2, and 
-#'    \item distance between the two objects.}
+#'    \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.
@@ -67,41 +81,65 @@ enve.df2dist <- function(
 #'
 #' @author Luis M. Rodriguez-R [aut, cre]
 #' 
+#' @examples
+#' # A sparse matrix representation of distances as data frame.
+#' # Note that some pairs are repeated.
+#' dist.df <- data.frame(
+#'   query    = c("A", "A", "A", "B", "C", "C", "B", "B", "B"),
+#'   subject  = c("A", "B", "C", "B", "C", "B", "A", "C", "C"),
+#'   distance = c(  0, 0.1, 0.4,   0,   0, 0.4, 0.2, 0.2, 0.1)
+#' )
+#' dist <- enve.df2dist.group(dist.df)
+#' print(dist)
+#' 
+#' # Use the mean of all repeated occurrences instead of the median.
+#' dist <- enve.df2dist.group(dist.df, summary = mean)
+#' 
+#' # Simply use the first occurrence for any given pair.
+#' dist <- enve.df2dist.group(dist.df, summary = function(x) head(x, n = 1))
+#' 
 #' @export
-
 enve.df2dist.group <- function(
   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));
+  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;
+  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));
+  return(as.dist(m))
 }
 
 #' Enveomics: Data Frame to Dist (List)
 #' 
 #' Transform a dataframe (or coercible object, like a table)
-#' into a \strong{dist} object.
+#' into a \strong{list} of \strong{dist} objects, one per group.
 #' 
 #' @param x A dataframe (or coercible object) with at least three columns:
 #' \enumerate{
@@ -114,41 +152,41 @@ enve.df2dist.group <- function(
 #' @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}}.
+#' @param ... Any other parameters supported by \code{\link{enve.df2dist}}.
 #' 
 #' @return Returns a \strong{list} of \strong{dist} objects.
 #'
 #' @author Luis M. Rodriguez-R [aut, cre]
-#' 
+#'
 #' @export
 
 enve.df2dist.list <- function(
   x,
   groups,
-  obj1.index=1,
-  obj2.index=2,
-  dist.index=3,
-  empty.rm=TRUE,
+  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;
+) {
+  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);
+  return(l)
 }
+