miga-base 1.2.17.1 → 1.2.17.2

data/utils/enveomics/enveomics.R/R/growthcurve.R

@@ -1,4 +1,4 @@
-#==============> Define S4 classes
+#==============> S4 classes
 
 #' Enveomics: Growth Curve S4 Class
 #' 
@@ -13,13 +13,15 @@
 #' 
 #' @exportClass
 
-enve.GrowthCurve <- setClass("enve.GrowthCurve",
-                             representation(
-                               design  = "array",
-                               models  = "list",
-                               predict = "list",
-                               call='call')
-                             ,package='enveomics.R');
+enve.GrowthCurve <- setClass(
+  "enve.GrowthCurve",
+  representation(
+    design  = "array",
+    models  = "list",
+    predict = "list",
+    call    = "call"
+  ), package = "enveomics.R"
+)
 
 #' Attribute accessor
 #' 
@@ -27,6 +29,8 @@ enve.GrowthCurve <- setClass("enve.GrowthCurve",
 #' @param name Attribute name
 setMethod("$", "enve.GrowthCurve", function(x, name) attr(x, name))
 
+#==============> S4 methods
+
 #' Enveomics: Plot of Growth Curve
 #' 
 #' Plots an \code{\link{enve.GrowthCurve}} object.
@@ -60,94 +64,99 @@ setMethod("$", "enve.GrowthCurve", function(x, name) attr(x, name))
 #' model?
 #' @param ... Any other graphic parameters.
 #' 
+#' @return No return value.
+#' 
 #' @author Luis M. Rodriguez-R [aut, cre]
 #' 
 #' @method plot enve.GrowthCurve
 #' @export
-
-#==============> Define S4 methods
-plot.enve.GrowthCurve <- function
-(x,
- col,
- pt.alpha=0.9,
- ln.alpha=1.0,
- ln.lwd=1,
- ln.lty=1,
- band.alpha=0.4,
- band.density=NULL,
- band.angle=45,
- xp.alpha=0.5,
- xp.lwd=1,
- xp.lty=1,
- pch=19,
- new=TRUE,
- legend=new,
- add.params=FALSE,
- ...
-){
-  
+plot.enve.GrowthCurve <- function(
+  x,
+  col,
+  pt.alpha     = 0.9,
+  ln.alpha     = 1.0,
+  ln.lwd       = 1,
+  ln.lty       = 1,
+  band.alpha   = 0.4,
+  band.density = NULL,
+  band.angle   = 45,
+  xp.alpha     = 0.5,
+  xp.lwd       = 1,
+  xp.lty       = 1,
+  pch          = 19,
+  new          = TRUE,
+  legend       = new,
+  add.params   = FALSE,
+  ...
+) {
   # Arguments
-  if(missing(col)){
+  if (missing(col)) {
     col <-
-      if(length(x$design)==0) grey(0.2)
-    else rainbow(length(x$design), v=3/5, s=3/5)
+      if (length(x$design) == 0) grey(0.2)
+      else rainbow(length(x$design), v = 3/5, s = 3/5)
   }
-  
-  if(new){
+
+  if (new) {
     # Initiate canvas
-    od.fit.max <- max(sapply(x$predict, function(x) max(x[,"upr"])))
-    od.obs.max <- max(sapply(x$models, function(x) max(x$data[,"od"])))
+    od.fit.max <- max(sapply(x$predict, function(x) max(x[, "upr"])))
+    od.obs.max <- max(sapply(x$models, function(x) max(x$data[, "od"])))
     opts <- list(...)
-    plot.defaults <- list(xlab="Time", ylab="Density",
-                          xlim=range(x$predict[[1]][,"t"]), ylim=c(0, max(od.fit.max, od.obs.max)))
-    for(i in names(plot.defaults)){
+    plot.defaults <- list(
+      xlab = "Time", ylab = "Density", xlim = range(x$predict[[1]][, "t"]),
+      ylim = c(0, max(od.fit.max, od.obs.max))
+    )
+    for (i in names(plot.defaults)) {
       if(is.null(opts[[i]])) opts[[i]] <- plot.defaults[[i]]
     }
     opts[["x"]] <- 1
     opts[["type"]] <- "n"
     do.call(plot, opts)
   }
-  
+
   # Graphic default
-  pch <- rep(pch, length.out=length(x$design))
-  col <- rep(col, length.out=length(x$design))
-  pt.col   <- enve.col2alpha(col, pt.alpha)
-  ln.col   <- enve.col2alpha(col, ln.alpha)
-  band.col <- enve.col2alpha(col, band.alpha)
-  xp.col   <- enve.col2alpha(col, xp.alpha)
-  band.angle   <- rep(band.angle, length.out=length(x$design))
-  if(!all(is.null(band.density))){
-    band.density <- rep(band.density, length.out=length(x$design))
+  pch <- rep(pch, length.out = length(x$design))
+  col <- rep(col, length.out = length(x$design))
+  pt.col     <- enve.col2alpha(col, pt.alpha)
+  ln.col     <- enve.col2alpha(col, ln.alpha)
+  band.col   <- enve.col2alpha(col, band.alpha)
+  xp.col     <- enve.col2alpha(col, xp.alpha)
+  band.angle <- rep(band.angle, length.out = length(x$design))
+  if (!all(is.null(band.density))) {
+    band.density <- rep(band.density, length.out = length(x$design))
   }
   
-  for(i in 1:length(x$design)){
+  for (i in 1:length(x$design)) {
     # Observed data
     d <- x$models[[i]]$data
-    points(d[,"t"], d[,"od"], pch=pch[i], col=pt.col[i])
-    for(j in unique(d[,"replicate"])){
-      sel <- d[,"replicate"]==j
-      lines(d[sel,"t"], d[sel,"od"], col=xp.col[i], lwd=xp.lwd, lty=xp.lty)
+    points(d[, "t"], d[, "od"], pch = pch[i], col = pt.col[i])
+    for (j in unique(d[, "replicate"])) {
+      sel <- d[, "replicate"] == j
+      lines(d[sel, "t"], d[sel, "od"],
+            col = xp.col[i], lwd = xp.lwd, lty = xp.lty)
     }
+
     # Fitted growth curves
-    if(x$models[[i]]$convInfo$isConv){
+    if (x$models[[i]]$convInfo$isConv) {
       d <- x$predict[[i]]
-      lines(d[,"t"], d[,"fit"], col=ln.col[i], lwd=ln.lwd, lty=ln.lty)
-      polygon(c(d[,"t"], rev(d[,"t"])), c(d[,"lwr"], rev(d[,"upr"])),
-              border=NA, col=band.col[i], density=band.density[i],
-              angle=band.angle[i])
+      lines(d[, "t"], d[, "fit"], col = ln.col[i], lwd = ln.lwd, lty = ln.lty)
+      polygon(c(d[, "t"], rev(d[, "t"])), c(d[, "lwr"], rev(d[, "upr"])),
+              border = NA, col = band.col[i], density = band.density[i],
+              angle = band.angle[i])
     }
   }
-  
-  if(!all(is.logical(legend)) || legend){
-    if(all(is.logical(legend))) legend <- "bottomright"
+
+  if (!all(is.logical(legend)) || legend) {
+    if (all(is.logical(legend))) legend <- "bottomright"
     legend.txt <- names(x$design)
-    if(add.params){
-      for(p in names(coef(x$models[[1]]))){
-        legend.txt <- paste(legend.txt, ", ", p, "=",
-                            sapply(x$models, function(x) signif(coef(x)[p],2)) , sep="")
+    if (add.params) {
+      for (p in names(coef(x$models[[1]]))) {
+        legend.txt <- paste(
+          legend.txt, ", ", p, "=",
+          sapply(x$models, function(x) signif(coef(x)[p], 2)) , sep = ""
+        )
       }
     }
-    legend(legend, legend=legend.txt, pch=pch, col=ln.col)
+    legend(legend, legend = legend.txt, pch = pch, col = ln.col)
   }
 }
 
@@ -158,37 +167,39 @@ plot.enve.GrowthCurve <- function
 #' @param object An \code{\link{enve.GrowthCurve}} object.
 #' @param ... No additional parameters are currently supported.
 #' 
+#' @return No return value.
+#' 
 #' @author Luis M. Rodriguez-R [aut, cre]
 #'
 #' @method summary enve.GrowthCurve
 #' @export
 
-summary.enve.GrowthCurve <- function(
-  object,
-  ...
-){
-  
+summary.enve.GrowthCurve <- function(object, ...) {
   x <- object
-  cat('===[ enve.GrowthCurves ]------------------\n')
-  for(i in names(x$design)){
-    cat(i, ':\n', sep='')
-    if(x$models[[i]]$convInfo$isConv){
-      for(j in names(coef(x$models[[i]]))){
-        cat('  - ', j, ' = ', coef(x$models[[i]])[j], '\n', sep='')
+  cat("===[ enve.GrowthCurves ]------------------\n")
+  for (i in names(x$design)) {
+    cat(i, ":\n", sep = "")
+    if (x$models[[i]]$convInfo$isConv) {
+      for (j in names(coef(x$models[[i]]))) {
+        cat("  - ", j, " = ", coef(x$models[[i]])[j], "\n", sep = "")
       }
-    }else{
-      cat('  Model didn\'t converge:\n    ',
-          x$models[[i]]$convInfo$stopMessage, '\n', sep='')
+    } else {
+      cat("  Model didn't converge:\n    ",
+          x$models[[i]]$convInfo$stopMessage, "\n", sep = "")
     }
-    cat('  ', nrow(x$models[[i]]$data), ' observations, ',
-        length(unique(x$models[[i]]$data[,"replicate"])), ' replicates.\n',
-        sep='')
+    cat(
+      "  ", nrow(x$models[[i]]$data), " observations, ",
+      length(unique(x$models[[i]]$data[, "replicate"])), " replicates.\n",
+      sep = ""
+    )
   }
-  cat('------------------------------------------\n')
-  cat('call:',as.character(attr(x,'call')),'\n')
-  cat('------------------------------------------\n')
+  cat("------------------------------------------\n")
+  cat("call:", as.character(attr(x, "call")), "\n")
+  cat("------------------------------------------\n")
 }
 
+#==============> Core functions
+
 #' Enveomics: Growth Curve
 #' 
 #' Calculates growth curves using the logistic growth function.
@@ -225,107 +236,114 @@ summary.enve.GrowthCurve <- function(
 #' 
 #' @examples 
 #' # Load data
-#' data("growth.curves", package="enveomics.R", envir=environment())
+#' data("growth.curves", package = "enveomics.R", envir = environment())
+#' 
 #' # Generate growth curves with different colors
-#' g <- enve.growthcurve(growth.curves[,-1], growth.curves[,1], triplicates=TRUE)
+#' g <- enve.growthcurve(growth.curves[, -1], growth.curves[, 1],
+#'                       triplicates = TRUE)
+#' 
 #' # Generate black-and-white growth curves with different symbols
 #' plot(g, pch=15:17, col="black", band.density=45, band.angle=c(-45,45,0))
 #'
 #' @export
-
-#==============> Core functions
-enve.growthcurve <- structure(function(
+enve.growthcurve <- function(
   x,
-  times=1:nrow(x),
-  triplicates=FALSE,
+  times       = 1:nrow(x),
+  triplicates = FALSE,
   design,
-  new.times=seq(min(times), max(times), length.out=length(times)*10),
-  level=0.95,
-  interval=c("confidence","prediction"),
-  plot=TRUE,
-  FUN=function(t,K,r,P0) K*P0*exp(r*t)/(K+P0*(exp(r*t)-1)),
-  nls.opt=list(),
+  new.times   = seq(min(times), max(times), length.out = length(times) * 10),
+  level       = 0.95,
+  interval    = c("confidence", "prediction"),
+  plot        = TRUE,
+  FUN = function(t, K, r, P0) K * P0 * exp(r * t) / (K + P0 * (exp(r * t) - 1)),
+  nls.opt     = list(),
   ...
-){
-  
+) {
   # Arguments
-  if(missing(design)){
+  if (missing(design)) {
     design <-
       if(triplicates)
-        tapply(colnames(x), colnames(x)[rep(1:(ncol(x)/3)*3-2, each=3)], c,
-               simplify=FALSE)
-    else tapply(colnames(x), colnames(x), c, simplify=FALSE)
+        tapply(
+          colnames(x),
+          colnames(x)[rep(1:(ncol(x) / 3) * 3 - 2, each = 3)],
+          c, simplify = FALSE
+        )
+      else tapply(colnames(x), colnames(x), c, simplify = FALSE)
   }
   mod <- list()
   fit <- list()
   interval <- match.arg(interval)
   enve._growth.fx <- NULL
   enve._growth.fx <<- FUN
-  
-  for(sample in names(design)){
+
+  for (sample in names(design)) {
     od <- c()
-    for(col in design[[sample]]){
-      od <- c(od, x[,col])
+    for (col in design[[sample]]) {
+      od <- c(od, x[, col])
     }
-    data <- data.frame(t=rep(times, length(design[[sample]])), od=od,
-                       replicate=rep(1:length(design[[sample]]), each=length(times)))
-    data <- data[!is.na(data$od),]
+    data <- data.frame(
+      t = rep(times, length(design[[sample]])), od = od,
+      replicate = rep(1:length(design[[sample]]), each = length(times))
+    )
+    data <- data[!is.na(data$od), ]
     opts <- nls.opt
     opts[["data"]] <- data
-    opt.defaults <- list(formula = od ~ enve._growth.fx(t, K, r, P0),
-                         algorithm="port", lower=list(P0=1e-16),
-                         control=nls.control(warnOnly=TRUE),
-                         start=list(
-                           K  = 2*max(data$od),
-                           r  = length(times)/max(data$t),
-                           P0 = min(data$od[data$od>0])
-                         ))
-    for(i in names(opt.defaults)){
-      if(is.null(opts[[i]])){
+    opt.defaults <- list(
+      formula = od ~ enve._growth.fx(t, K, r, P0),
+      algorithm = "port", lower = list(P0 = 1e-16),
+      control = nls.control(warnOnly = TRUE),
+      start = list(
+        K  = 2 * max(data$od),
+        r  = length(times) / max(data$t),
+        P0 = min(data$od[data$od > 0])
+      )
+    )
+    for (i in names(opt.defaults)) {
+      if (is.null(opts[[i]])) {
         opts[[i]] <- opt.defaults[[i]]
       }
     }
     mod[[sample]] <- do.call(nls, opts)
-    fit[[sample]] <- cbind(t=new.times,
-                           predFit(mod[[sample]], level=level, interval=interval,
-                                   newdata=data.frame(t=new.times)))
+    fit[[sample]] <- cbind(
+      t = new.times,
+      predFit(
+        mod[[sample]], level = level, interval = interval,
+        newdata = data.frame(t = new.times)
+      )
+    )
   }
   enve._growth.fx <<- NULL
-  gc <- new("enve.GrowthCurve",
-            design=design, models=mod, predict=fit,
-            call=match.call());
-  if(plot) plot(gc, ...);
+  gc <- new(
+    "enve.GrowthCurve",
+    design = design, models = mod, predict = fit, call = match.call()
+  )
+  if (plot) plot(gc, ...)
   return(gc)
-}, ex=function(){
-  # Load data
-  data("growth.curves", package="enveomics.R", envir=environment())
-  # Generate growth curves with different colors
-  g <- enve.growthcurve(growth.curves[,-1], growth.curves[,1], triplicates=TRUE)
-  # Generate black-and-white growth curves with different symbols
-  plot(g, pch=15:17, col="black", band.density=45, band.angle=c(-45,45,0))
-});
+}
 
-#' Enveomics: Color to Alpha
+#' Enveomics: Color to Alpha (deprecated)
 #' 
 #' Takes a vector of colors and sets the alpha.
+#'
+#' DEPRECATED: Use instead \code{\link{enve.col.alpha}}.
 #' 
 #' @param x A vector of any value base colors.
-#' @param alpha Alpha level to set (in the 0-1 range).
+#' @param alpha Alpha level to set, in the [0, 1] range.
+#' 
+#' @return A vector of colors with alpha set.
 #' 
 #' @author Luis M. Rodriguez-R [aut, cre]
 #' 
 #' @export
-
-enve.col2alpha <- function(
-  x,
-  alpha
-){
+enve.col2alpha <- function(x, alpha) {
   out <- c()
   for(i in x){
-    opt <- as.list(col2rgb(i)[,1]/256)
-    opt[["alpha"]] = alpha
+    opt <- as.list(col2rgb(i)[, 1])
+    opt[["alpha"]] <- alpha * 255
+    opt[["maxColorValue"]] <- 255
     out <- c(out, do.call(rgb, opt))
   }
   names(out) <- names(x)
   return(out)
 }
+