diff DrawFunctions.R @ 7:122df1bf0a8c draft default tip

planemo upload for repository https://github.com/workflow4metabolomics/nmr_preprocessing commit 3d328007dd7716848ec2eeb6c2a472f27eeb2995

--- a/DrawFunctions.R	Wed May 13 03:52:09 2020 -0400
+++ b/DrawFunctions.R	Fri Jul 11 08:33:38 2025 +0000
@@ -1,268 +1,280 @@
-require(ggplot2)
-require(gridExtra)
-require(reshape2)
+library(ggplot2) # nice plots
+library(gridExtra) # nice plots
+library(reshape2) # data manipulation
 
-
-Draw <- function(Signal_data, type.draw = c("signal", "pca"), output = c("default", 
-                                                                         "window", "png", "pdf"), dirpath = ".", filename = "%003d", height = 480, 
+Draw <- function(Signal_data, type.draw = c("signal", "pca"), output = c(
+                     "default",
+                     "window", "png", "pdf"
+                 ), dirpath = ".", filename = "%003d", height = 480,
                  width = 640, pdf.onefile = TRUE, ...) {
-  
-  # Data initialisation and checks ----------------------------------------------
-  type.draw <- match.arg(type.draw)
-  output <- match.arg(output)
-  fullpath <- paste(file.path(dirpath, filename), output, sep = ".")
-  createFile <- TRUE
-  createWindow <- FALSE
-  
-  # Drawing --------------------------------------------------------------------
-  # output
-  switch(output, default = {
-    createFile <- FALSE
-  }, window = {
-    createWindow <- TRUE
-    createFile <- FALSE
-  }, png = {
-    grDevices::png(fullpath, width, height)
-  }, pdf = {
-    grDevices::pdf(fullpath, width = width/72, height = height/72, 
-                   onefile = pdf.onefile)
-  }, {
-    stop("Unknown output type.")
-  })
-  
-  # Drawing type (signal/spectrum or PCA)
-  funs <- list(signal = DrawSignal, pca = DrawPCA)
-  if (type.draw %in% names(funs)) {
-    fun <- funs[[type.draw]]
-  } else {
-    stop(paste("Unknown type:", type.draw))
-  }
-  
-  # Plot finalisation ----------------------------------------------
-  if (is.vector(Signal_data)) {
-    Signal_data <- vec2mat(Signal_data)
-  }
-  fun(Signal_data, createWindow = createWindow, ...)
-  if (createFile) {
-    grDevices::dev.off()
-  }
+    # Data initialisation and checks ----------------------------------------------
+    type.draw <- match.arg(type.draw)
+    output <- match.arg(output)
+    fullpath <- paste(file.path(dirpath, filename), output, sep = ".")
+    createFile <- TRUE
+    createWindow <- FALSE
+
+    # Drawing --------------------------------------------------------------------
+    # output
+    switch(output,
+        default = {
+            createFile <- FALSE
+        },
+        window = {
+            createWindow <- TRUE
+            createFile <- FALSE
+        },
+        png = {
+            grDevices::png(fullpath, width, height)
+        },
+        pdf = {
+            grDevices::pdf(fullpath,
+                width = width / 72, height = height / 72,
+                onefile = pdf.onefile
+            )
+        },
+        {
+            stop("Unknown output type.")
+        }
+    )
+
+    # Drawing type (signal/spectrum or PCA)
+    funs <- list(signal = DrawSignal, pca = DrawPCA)
+    if (type.draw %in% names(funs)) {
+        fun <- funs[[type.draw]]
+    } else {
+        stop(paste("Unknown type:", type.draw))
+    }
+
+    # Plot finalisation ----------------------------------------------
+    if (is.vector(Signal_data)) {
+        Signal_data <- vec2mat(Signal_data)
+    }
+    fun(Signal_data, createWindow = createWindow, ...)
+    if (createFile) {
+        grDevices::dev.off()
+    }
 }
 
 
 
 #####   DrawSignal
 
-DrawSignal <- function(Signal_data, subtype = c("stacked", "together", 
-                                                "separate", "diffmean", "diffmedian", "diffwith"), 
-                       ReImModArg = c(TRUE, FALSE, FALSE, FALSE), vertical = T, 
-                       xlab = "rowname", RowNames = NULL, row = 1, num.stacked = 4, 
+DrawSignal <- function(Signal_data, subtype = c(
+                           "stacked", "together",
+                           "separate", "diffmean", "diffmedian", "diffwith"
+                       ),
+                       ReImModArg = c(TRUE, FALSE, FALSE, FALSE), vertical = T,
+                       xlab = "rowname", RowNames = NULL, row = 1, num.stacked = 4,
                        main = NULL, createWindow) {
-  # nticks
-  
-  # Data initialisation and checks ----------------------------------------------
-  
-  subtype <- match.arg(subtype)
-  vec <- is.vector(Signal_data)
-  if (vec) {
-    Signal_data <- vec2mat(Signal_data)
-  }
-  
-  n <- nrow(Signal_data)
-  m <- ncol(Signal_data)
-  
-  if (n < num.stacked){
-    num.stacked <- n
-  }
-  
-  scale <- colnames(Signal_data)
-  
-  num.plot <- sum(ReImModArg)
-  
-  Var <- rowname <- value <- NULL  # only for R CMD check
-  
-  # Drawing array
-  if (num.plot <= 0) {
-    stop("Nothing selected in ReImModArg.")
-  } else if (num.plot <= 2) {
-    if (vertical)  {
-      nrow <- num.plot
-      ncol <- 1
-    } else  {
-      nrow <- 1
-      ncol <- num.plot
+    # nticks
+
+    # Data initialisation and checks ----------------------------------------------
+
+    subtype <- match.arg(subtype)
+    vec <- is.vector(Signal_data)
+    if (vec) {
+        Signal_data <- vec2mat(Signal_data)
+    }
+
+    n <- nrow(Signal_data)
+    m <- ncol(Signal_data)
+
+    if (n < num.stacked) {
+        num.stacked <- n
     }
-  } else {
-    nrow <- 2
-    ncol <- 2
-  }
-  
-  # RowNames 
-  if (is.null(RowNames))  {
-    RowNames <- rownames(Signal_data)
-    if (is.null(RowNames))  {
-      RowNames <- 1:n
+
+    scale <- colnames(Signal_data)
+
+    num.plot <- sum(ReImModArg)
+
+    Var <- rowname <- value <- NULL # only for R CMD check
+
+    # Drawing array
+    if (num.plot <= 0) {
+        stop("Nothing selected in ReImModArg.")
+    } else if (num.plot <= 2) {
+        if (vertical) {
+            nrow <- num.plot
+            ncol <- 1
+        } else {
+            nrow <- 1
+            ncol <- num.plot
+        }
+    } else {
+        nrow <- 2
+        ncol <- 2
+    }
+
+    # RowNames
+    if (is.null(RowNames)) {
+        RowNames <- rownames(Signal_data)
+        if (is.null(RowNames)) {
+            RowNames <- 1:n
+        }
+    } else {
+        if (!is.vector(RowNames)) {
+            stop("RowNames is not a vector")
+        }
+        if (length(RowNames) != n) {
+            stop(paste("RowNames has length", length(RowNames), "and there are", n, "FIDs."))
+        }
+    }
+
+    if (n == 1) {
+        RowNames <- deparse(substitute(Signal_data))
+    }
+
+    elements <- list()
+    if (ReImModArg[1]) {
+        elements[["Re"]] <- Re(Signal_data)
+        rownames(elements[["Re"]]) <- RowNames
+    }
+    if (ReImModArg[2]) {
+        elements[["Im"]] <- Im(Signal_data)
+        rownames(elements[["Im"]]) <- RowNames
+    }
+    if (ReImModArg[3]) {
+        elements[["Mod"]] <- Mod(Signal_data)
+        rownames(elements[["Mod"]]) <- RowNames
+    }
+    if (ReImModArg[4]) {
+        elements[["Arg"]] <- Arg(Signal_data)
+        rownames(elements[["Arg"]]) <- RowNames
     }
-  } else {
-    if (!is.vector(RowNames)) {
-      stop("RowNames is not a vector")
-    }
-    if (length(RowNames) != n)  {
-      stop(paste("RowNames has length", length(RowNames), "and there are", n, "FIDs."))
-    }
-  }
-  
-  if (n == 1) {
-    RowNames <- deparse(substitute(Signal_data))
-  }
-  
-  elements <- list()
-  if (ReImModArg[1]) {
-    elements[["Re"]] <- Re(Signal_data)
-    rownames(elements[["Re"]]) <- RowNames
-  }
-  if (ReImModArg[2]) {
-    elements[["Im"]] <- Im(Signal_data)
-    rownames(elements[["Im"]]) <- RowNames
-  }
-  if (ReImModArg[3]) {
-    elements[["Mod"]] <- Mod(Signal_data)
-    rownames(elements[["Mod"]]) <- RowNames
-  }
-  if (ReImModArg[4]) {
-    elements[["Arg"]] <- Arg(Signal_data)
-    rownames(elements[["Arg"]]) <- RowNames
-  }
-  
-  
-  
-  
-  # Drawing --------------------------------------------------------------------
-  
-  y = x = NULL # only for R CMD check
-  
-  
-  # SEPARATE or STACKED ===============
-  if (subtype == "separate" | subtype == "stacked")  {
-    
-    i <- 1
-    while (i <= n)  {
-      if (createWindow)  {
-        grDevices::dev.new(noRStudioGD = TRUE)
-      }
-      if (subtype == "separate")  {
-        # The other uses gridExtra to do that
+
+
+
+
+    # Drawing --------------------------------------------------------------------
+
+    y <- x <- NULL # only for R CMD check
+
+
+    # SEPARATE or STACKED ===============
+    if (subtype == "separate" | subtype == "stacked") {
+        i <- 1
+        while (i <= n) {
+            if (createWindow) {
+                grDevices::dev.new(noRStudioGD = TRUE)
+            }
+            if (subtype == "separate") {
+                # The other uses gridExtra to do that
+                graphics::par(mfrow = c(nrow, ncol))
+            }
+            plots <- list()
+            if (subtype == "separate") {
+                last <- i
+            } else {
+                last <- min(i + num.stacked - 1, n)
+            }
+            for (name in names(elements)) {
+                if (subtype == "separate") {
+                    if (n == 1) {
+                        df <- data.frame(x = as.numeric(scale), y = elements[[name]])
+                    } else {
+                        df <- data.frame(x = as.numeric(scale), y = elements[[name]][i, ])
+                    }
+
+                    plots[[name]] <- ggplot2::ggplot(data = df, ggplot2::aes(x = x, y = y)) +
+                        ggplot2::geom_line(size = 1) +
+                        ggplot2::theme(legend.position = "none") +
+                        ggplot2::labs(x = xlab, y = name) +
+                        ggplot2::ggtitle(RowNames[i]) +
+                        ggplot2::theme_bw()
+
+                    if ((df[1, "x"] - df[(dim(df)[1]), "x"]) > 0) {
+                        plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
+                    }
+                } else {
+                    if (n == 1) {
+                        melted <- data.frame(
+                            rowname = rep(name, m),
+                            Var = as.numeric(scale), value = elements[[name]][i, ]
+                        )
+                    } else if (last == i) {
+                        melted <- data.frame(
+                            rowname = rep(rownames(elements[[name]])[i], m),
+                            Var = as.numeric(scale), value = elements[[name]][i, ]
+                        )
+                    } else {
+                        melted <- reshape2::melt(elements[[name]][i:last, ], varnames = c("rowname", "Var"))
+                    }
+
+
+                    plots[[name]] <- ggplot2::ggplot(data = melted, ggplot2::aes(x = Var, y = value)) +
+                        ggplot2::geom_line(size = 0.3) +
+                        ggplot2::facet_grid(rowname ~ ., scales = "free_y") +
+                        ggplot2::theme(legend.position = "none") +
+                        ggplot2::labs(x = xlab, y = name) +
+                        ggplot2::ggtitle(label = main) +
+                        ggplot2::theme_bw()
+
+                    if ((melted[1, "Var"] - melted[(dim(melted)[1]), "Var"]) > 0) {
+                        plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
+                    }
+                }
+            }
+
+            if (subtype == "stacked") {
+                do.call(gridExtra::grid.arrange, c(plots, list(nrow = nrow, ncol = ncol)))
+            }
+
+            i <- last + 1
+        }
+    } else if (subtype %in% c("together", "diffmean", "diffmedian", "diffwith")) {
+        # TOGHETER or DIFFMEAN or DIFFMEDIAN or DIFFWITH ===============
+
+        rainbow_colors <- grDevices::rainbow(n)
+
+        if (createWindow) {
+            grDevices::dev.new(noRStudioGD = TRUE)
+        }
         graphics::par(mfrow = c(nrow, ncol))
-      }
-      plots <- list()
-      if (subtype == "separate")  {
-        last <- i
-      } else  {
-        last <- min(i + num.stacked - 1, n)
-      }
-      for (name in names(elements))  {
-        if (subtype == "separate")   {
-          if (n == 1) {
-            df <- data.frame(x = as.numeric(scale), y = elements[[name]])
-          } else {df <- data.frame(x = as.numeric(scale), y = elements[[name]][i, ])
-          }
-          
-          plots[[name]] <- ggplot2::ggplot(data = df, ggplot2::aes(x = x, y = y)) + 
-            ggplot2::geom_line(size = 1) + 
-            ggplot2::theme(legend.position = "none") + 
-            ggplot2::labs(x = xlab, y = name) +
-            ggplot2::ggtitle(RowNames[i]) +
-            ggplot2::theme_bw()
-          
-          if ((df[1, "x"] - df[(dim(df)[1]), "x"]) > 0) {
-            plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
-          }
-          
-        } else   {
-          
-          if (n == 1 ) {
-            melted <- data.frame(rowname = rep(name, m), 
-                                 Var = as.numeric(scale), value = elements[[name]][i,])
-          } else if (last==i){ 
-            melted <- data.frame(rowname = rep(rownames(elements[[name]])[i], m), 
-                                 Var = as.numeric(scale), value = elements[[name]][i,])
-          } else {melted <- reshape2::melt(elements[[name]][i:last, ], 
-                                           varnames = c("rowname", "Var"))
-          }
-          
-          
-          plots[[name]] <- ggplot2::ggplot(data = melted, ggplot2::aes(x = Var, y = value)) + 
-            ggplot2::geom_line(size = 0.3) + 
-            ggplot2::facet_grid(rowname ~ ., scales = "free_y") + 
-            ggplot2::theme(legend.position = "none") + 
-            ggplot2::labs(x = xlab, y = name) +
-            ggplot2::ggtitle(label = main) +
-            ggplot2::theme_bw()
-          
-          if ((melted[1, "Var"] - melted[(dim(melted)[1]), "Var"]) > 0) {
-            plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
-          }
+
+        plots <- list()
+
+        # Loop for Re, Im, Mod and Arg
+        for (name in names(elements)) {
+            # Get this part of the signal
+            element <- elements[[name]]
+
+            # Express the signal according to a reference if asked by `subtype'
+            if (subtype == "diffmean") {
+                element <- sweep(element, MARGIN = 2, colMeans(element), `-`)
+            } else if (subtype == "diffmedian") {
+                element <- sweep(element, MARGIN = 2, matrixStats::colMedians(element), `-`)
+            } else if (subtype == "diffwith") {
+                element <- sweep(element, MARGIN = 2, element[row, ], `-`)
+                if (row == 1 & n > 1) {
+                    # Since we use plot on the first row and lines on the following, the y
+                    # scale is calculated at the first row so if the first row is all 0, it
+                    # causes problems
+                    tmp <- element[1, ]
+                    element[1, ] <- element[2, ]
+                    element[2, ] <- tmp
+                }
+            }
+            melted <- reshape2::melt(elements[[name]][i:last, ], varnames = c("rowname", "Var"))
+
+            plots[[name]] <- ggplot2::ggplot(melted, ggplot2::aes(
+                x = Var,
+                y = value, group = rowname, colour = rowname
+            )) +
+                ggplot2::geom_line() +
+                ggplot2::labs(x = xlab, y = name) +
+                ggplot2::scale_colour_discrete(name = NULL) +
+                ggplot2::ggtitle(main)
+
+            if ((melted[1, "Var"] - melted[(dim(melted)[1]), "Var"]) >
+                0) {
+                plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
+            }
+
+            do.call(gridExtra::grid.arrange, c(plots, list(
+                nrow = nrow,
+                ncol = ncol
+            )))
         }
-      }
-      
-      if (subtype == "stacked")  {
-        do.call(gridExtra::grid.arrange, c(plots, list(nrow = nrow, ncol = ncol)))
-      } 
-      
-      i <- last + 1
     }
-  } else if (subtype %in% c("together", "diffmean", "diffmedian", "diffwith")) {
-    
-    # TOGHETER or DIFFMEAN or DIFFMEDIAN or DIFFWITH ===============
-    
-    rainbow_colors <- grDevices::rainbow(n)
-    
-    if (createWindow) {
-      grDevices::dev.new(noRStudioGD = TRUE)
-    }
-    graphics::par(mfrow = c(nrow, ncol))
-    
-    plots <- list()
-    
-    # Loop for Re, Im, Mod and Arg
-    for (name in names(elements)) {
-      # Get this part of the signal
-      element <- elements[[name]]
-      
-      # Express the signal according to a reference if asked by `subtype'
-      if (subtype == "diffmean")  {
-        element <- sweep(element, MARGIN = 2, colMeans(element),  `-`)
-      } else if (subtype == "diffmedian") {
-        element <- sweep(element, MARGIN = 2, matrixStats::colMedians(element), `-`)
-      } else if (subtype == "diffwith")  {
-        element <- sweep(element, MARGIN = 2, element[row, ], `-`)
-        if (row == 1 & n > 1)  {
-          # Since we use plot on the first row and lines on the following, the y
-          # scale is calculated at the first row so if the first row is all 0, it
-          # causes problems
-          tmp <- element[1, ]
-          element[1, ] <- element[2, ]
-          element[2, ] <- tmp
-        }
-      }
-      
-      
-      melted <- reshape2::melt(elements[[name]], varnames = c("rowname", "Var"))
-      
-      
-      plots[[name]] <- ggplot2::ggplot(melted, ggplot2::aes(x = Var, 
-                                                            y = value, group = rowname, colour = rowname)) + ggplot2::geom_line() + 
-        ggplot2::labs(x = xlab, y = name) + ggplot2::scale_colour_discrete(name = NULL) + 
-        ggplot2::ggtitle(main)
-      
-      if ((melted[1, "Var"] - melted[(dim(melted)[1]), "Var"]) > 
-          0)  {
-        plots[[name]] <- plots[[name]] + ggplot2::scale_x_reverse()
-      }
-      
-      do.call(gridExtra::grid.arrange, c(plots, list(nrow = nrow, 
-                                                     ncol = ncol)))
-    }
-  }
-  
-  
 }