Add wrapper function for SRCGrob

NAMESPACE

@@ -10,9 +10,8 @@ importFrom("stats", "median", "setNames", "aggregate", "reshape")
 importFrom("grDevices", "col2rgb")
 
 export(SRCGrob)
-
+export(create.phylogenetic.tree)
 export(create.ccf.heatmap)
 export(create.cluster.heatmap)
 export(create.ccf.summary.heatmap)
-
 export(create.clone.genome.distribution.plot)

NEWS.md

@@ -9,6 +9,7 @@
 * Node-by-node control of node size
 * Aesthetic changes for heatmap and clone-genome distribution plot
 * Add parameters to specify polygon shape and width.
+* Wrapper function for `SRCgrob` to automatically save plots to file
 
 ## Update
 * Fixed angle calculation bug where child angles do not follow

R/create.phylogenetic.tree.R

@@ -0,0 +1,37 @@
+create.phylogenetic.tree <- function(
+    tree,
+    filename = NULL,
+    width = 5,
+    height = 5,
+    units = 'in',
+    res = 500,
+    bg = 'white',
+    ...
+    ) {
+
+    if ('node.id' %in% colnames(tree)) {
+        rownames(tree) <- tree$node.id;
+        }
+
+    plt <- SRCGrob(
+        tree,
+        ...
+        );
+
+    supported.extensions <- c('png', 'pdf', 'tiff', 'svg');
+    if (!is.null(filename)) {
+        save.plot(
+            plt,
+            filename,
+            width = width,
+            height = height,
+            units = units,
+            res = res,
+            bg = bg
+            );
+    } else {
+        grid.newpage();
+        grid.draw(plt);
+        }
+    return(plt);
+    }

R/utility.R

@@ -93,8 +93,8 @@
 get.encoded.distance <- function(points) {
     if (!is.data.frame(points)) {
         stop(paste(
-            'Input data \"points\" must be a data.frame',
-            paste0('(received \"", class(points), "\").')
+            'Input data \'points\' must be a data.frame',
+            paste0('(received \'', class(points), '\').')
             ));
         }
     validate.data.frame.columns(points, expected.columns = c('x', 'y'));
@@ -118,3 +118,46 @@
 
     return(encoded.distances);
     }
+
+check.file.extension <- function(
+    filename,
+    supported.ext,
+    default.ext
+    ) {
+
+    ext <- tools::file_ext(filename);
+    if (!(ext %in% supported.ext)) {
+        message(paste(
+            'File extension', ext, 'is not in the list of supported extensions. Switching to default extension', default.ext
+            ));
+        filename <- gsub(paste0('.', ext), paste0('.', default.ext), filename);
+        ext <- default.ext;
+        }
+    return(list(name = filename, ext = ext));
+    }
+
+save.plot <- function(
+    grob,
+    filename,
+    units,
+    res,
+    bg,
+    ...
+    ) {
+
+    supported.extensions <- c('png', 'pdf', 'tiff', 'svg');
+    f <- check.file.extension(filename, supported.extensions, 'tiff');
+    if (f$ext == 'png') {
+        png(file = f$name, units = units, res = res, bg = bg, ...);
+    } else if (f$ext == 'tiff') {
+        tiff(file = f$name, units = units, res = res, bg = bg, ...);
+    } else if (f$ext == 'pdf') {
+        pdf(file = f$name, ...);
+    } else if (f$ext == 'svg') {
+        svg(file = f$name, bg = bg, ...);
+        }
+
+    grid.newpage();
+    grid.draw(grob);
+    dev.off();
+    };

man/create.ccf.heatmap.Rd

@@ -1,6 +1,6 @@
 \name{create.ccf.heatmap}
 \alias{create.ccf.heatmap}
-\title{Subclone Tree Plot}
+\title{CCF Distribution Heatmap}
 \description{
 Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples. The function is a wrapper around \code{BoutrosLab.plotting.general::create.heatmap()} with some changes in the default parameters. All parameter description are the same as in \code{BoutrosLab.plotting.general::create.heatmap()} except for \code{ccf.thres}.
 }

man/create.ccf.summary.heatmap.Rd

@@ -1,6 +1,6 @@
 \name{create.ccf.summary.heatmap}
 \alias{create.ccf.summary.heatmap}
-\title{Subclone Tree Plot}
+\title{CCF Summary Heatmap}
 \description{
 Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap. Subplot parameters controls the appearance of the heatmap and barplots. See \code{BoutrosLab.plotting.general::create.barplot()} or \code{BoutrosLab.plotting.general::create.heatmap()}  for parameter description. Legend parameters are passed to \code{BoutrosLab.plotting.general::legend.grob()}.
 }

man/create.cluster.heatmap.Rd

@@ -1,6 +1,6 @@
 \name{create.cluster.heatmap}
 \alias{create.cluster.heatmap}
-\title{Subclone Tree Plot}
+\title{Cluster Heatmap}
 \description{
 Creates a heatmap of cancer cell fraction (CCF) distribution across tumour samples with clone IDs as a covariate beneath the heatmap.
 }

man/create.phylogenetic.tree.Rd

@@ -0,0 +1,60 @@
+\name{create.phylogenetic.tree}
+\alias{create.phylogenetic.tree}
+\title{Phylogenetic Tree Plot}
+\description{
+    Create a phylogenetic tree plot using `SRCGrob`. The `width`, `heigth`, `units`, `res`, and `bg` arguments are passed to the `grDevices` function to save the plot to file.
+    }
+\usage{
+create.phylogenetic.tree(
+    tree,
+    filename = NULL,
+    width = 5,
+    height = 5,
+    units = 'in',
+    res = 500,
+    bg = 'white',
+    ...
+    )
+}
+\arguments{
+    \item{tree}{Tree structure data.frame}
+    \item{filename}{Filename for plot output, or if \code{NULL} displays the tree using \code{grid.draw}. Defaults to \code{NULL}.}
+    \item{width}{Width of the plot. Defaults to 5.}
+    \item{height}{Height of the plot. Defaults to 5.}
+    \item{units}{Units of the plot. Defaults to \dQuote{in}.}
+    \item{res}{Resolution of the plot. Defaults to 500.}
+    \item{bg}{Background colour of the plot. Defaults to \dQuote{white}.}
+    \item{...}{Pass through argument. See SRCGrob() for further details.}
+}
+\value{A `grob` of class "SRCGrob".}
+\author{Helena Winata}
+\seealso{
+    \code{\link{SRCGrob}},
+    \code{\link[grDevices::pdf]{pdf}},
+    \code{\link[grDevices::png]{png}},
+    \code{\link[grDevices::tiff]{tiff}},
+    \code{\link[grDevices::svg]{svg}}
+    }
+
+\examples{
+# Simple Tree Plot
+simple.tree <- data.frame(
+    parent = c(NA, 1, 1)
+    );
+create.phylogenetic.tree(simple.tree);
+
+# Non-numeric node.id
+phy.dt <- data.frame(
+    node.id = c('MRCA', 'C01', 'C02', 'C03', 5:7),
+    parent = c(NA, 'MRCA', 'MRCA', 'MRCA', 'C02', 'C03', 'C03')
+    );
+create.phylogenetic.tree(phy.dt);
+
+# Numeric disordered node.id with labels
+phy.dt <- data.table(
+    node.id = c(1, 2, 5, 6, 4, 9, 10),
+    parent = c(NA, 1, 1, 1, 5, 6, 6),
+    label = c('MRCA', 'C01', 'C02', 'C03', 5:7)
+    );
+create.phylogenetic.tree(phy.dt);
+}

tests/testthat/test-check.file.extension.R

@@ -0,0 +1,33 @@
+test_that('check.file.extension works correctly', {
+    supported.ext <- c('png', 'tiff')
+    default.ext <- 'tiff'
+
+    result <- check.file.extension(
+        'test.png',
+        supported.ext,
+        default.ext
+        );
+
+    expect_equal(result$name, 'test.png')
+    expect_equal(result$ext, 'png')
+
+    result <- check.file.extension(
+        'test.tiff',
+        supported.ext,
+        default.ext
+        );
+    expect_equal(result$name, 'test.tiff')
+    expect_equal(result$ext, 'tiff')
+
+
+    expect_message(
+        result <- check.file.extension(
+            'test.txt',
+            supported.ext,
+            default.ext
+            ),
+        'File extension txt is not in the list of supported extensions. Switching to default extension tiff'
+    )
+    expect_equal(result$name, 'test.tiff')
+    expect_equal(result$ext, 'tiff')
+    });