0.4.0.9000

oeysan · Sep 14, 2019 · 9452abf · 9452abf
1 parent 90a880e
commit 9452abf
Show file tree

Hide file tree

Showing 6 changed files with 71 additions and 51 deletions.
diff --git a/CRAN-RELEASE b/CRAN-RELEASE
@@ -0,0 +1,2 @@
+This package was submitted to CRAN on 2019-02-04.
+Once it is accepted, delete this file and tag the release (commit 90a880e79f).
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: bfw
-Version: 0.4.0
-Date: 2010-02-04
+Version: 0.4.0.9000
+Date: 2019-09-14
 Title: Bayesian Framework for Computational Modeling
 Authors@R: person( "Øystein Olav","Skaar", email="bayesianfw@gmail.com", role=c("aut","cre"))
 Maintainer: Øystein Olav Skaar <bayesianfw@gmail.com>
@@ -23,6 +23,7 @@ Imports: coda (>= 0.19-1),
 Suggests:
          covr (>= 3.1.0),
          circlize (>= 0.4.4),
+         data.table (>= 1.12.2),
          dplyr (>= 0.7.7),
          ggplot2 (>= 2.2.1),
          knitr (>= 1.20),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# bfw 0.4.0.9000
+
+#### Minor
+
+* Updated `ParsePlot` function to conform with changes in `rvg` package
+* Fixed `circlize` function
+
 # bfw 0.4.0
 
 #### Critical 

diff --git a/R/plot_circlize.R b/R/plot_circlize.R
@@ -6,27 +6,24 @@
 #' @param monochrome logical, indicating whether or not to use monochrome colors, else use \link[bfw]{DistinctColors}, Default: TRUE
 #' @param plot.colors range of color to use, Default: c("#CCCCCC", "#DEDEDE")
 #' @param font.type font type used for visualizations, Default: 'serif'
-#' @seealso 
-#'  \code{\link[grDevices]{dev}},
-#'  \code{\link[grDevices]{recordPlot}}
-#'  \code{\link[graphics]{legend}}
-#'  \code{\link[circlize]{circos.par}},
-#'  \code{\link[circlize]{chordDiagram}},
-#'  \code{\link[circlize]{circos.trackPlotRegion}},
-#'  \code{\link[circlize]{circos.clear}}
+#' @seealso
+#' \code{\link[grDevices]{dev}},
+#' \code{\link[grDevices]{recordPlot}}
+#' \code{\link[graphics]{legend}}
+#' \code{\link[circlize]{circos.par}},
+#' \code{\link[circlize]{chordDiagram}},
+#' \code{\link[circlize]{circos.trackPlotRegion}},
+#' \code{\link[circlize]{circos.clear}}
 #' @rdname PlotCirclize
-#' @export 
-#' @importFrom grDevices dev.new recordPlot dev.off 
+#' @export
+#' @importFrom grDevices dev.new recordPlot dev.off
 #' @importFrom graphics legend
-
 PlotCirclize <- function (data,
                           category.spacing = 1.2,
                           category.inset = c(-0.4, 0),
                           monochrome = TRUE,
                           plot.colors = c("#CCCCCC", "#DEDEDE"),
                           font.type = "serif") {
-
-
 
   # Check if circlize is installed
   if (!requireNamespace("circlize", quietly = TRUE)) {
@@ -47,25 +44,38 @@ PlotCirclize <- function (data,
   # Remove missing
   category.selects <- category.selects[rowSums(is.na(category.selects)) != ncol(category.selects), ]
 
-  # Find connections between categories as a two-column matrix
-  category.selects <- matrix(unlist(apply(category.selects, 1, function(x) {
-    var <- which(!is.na(x))
-    varX <- sprintf("%02d", var[1])
-    matrix(unlist(lapply(var, function(y) {
-      varY <- sprintf("%02d", y)
-      c(varY, varX)
-    }), use.names = FALSE), ncol = 2, byrow = TRUE)
-  }), use.names = FALSE), ncol = 2, byrow = TRUE)
+  # Find connections between categories
+  category.combn <- lapply(1:nrow(category.selects), function (i) {
+
+    x <- which(!is.na(category.selects[i,]))
+    if (length(x)>1) {
+      mat <- t(combn(x,2))
+    } else {
+      mat <- matrix(c(x,x),1,2)
+    }
+
+    as.data.frame(mat)
+
+  })
+
+  # create a two-column matrix of combinations
+  if (!requireNamespace("data.table", quietly = TRUE)) {
+    category.combn <- as.matrix(do.call(rbind,category.combn))
+  } else {
+    category.combn <- as.matrix(data.table::rbindlist(category.combn))
+  }
 
+  # Sort connections
+  category.combn <- category.combn[rev(order(category.combn[,1])),]
 
   # Find unique categories
-  unique.categories <- sort(unique(c(category.selects)))
+  unique.categories <- sort(unique(c(category.combn)))
 
   # Select (monochrome) colors
   if (monochrome) {
     circlize.colors <- grDevices::colorRampPalette(plot.colors)(length(unique.categories))
-  } else { 
-    circlize.colors <- DistinctColors(1:length(unique.categories)) 
+  } else {
+    circlize.colors <- DistinctColors(1:length(unique.categories))
   }
 
   # Add plot
@@ -76,9 +86,9 @@ PlotCirclize <- function (data,
                      units="in")
 
   # Define plot parameters
-  par(mar = c(0, 0, 0, 15), 
-      xpd = TRUE, 
-      pty = "s", 
+  par(mar = c(0, 0, 0, 15),
+      xpd = TRUE,
+      pty = "s",
       family = font.type)
 
   # Create connections between variables
@@ -89,10 +99,10 @@ PlotCirclize <- function (data,
   circlize::circos.par(gap.degree = gap.degree)
 
   circlize::chordDiagram(
-    as.data.frame(category.selects), 
-    order = unique.categories , 
+    as.data.frame(category.combn),
+    order = unique.categories ,
     grid.col = circlize.colors,
-    directional = FALSE, 
+    directional = FALSE,
     annotationTrack = "grid",
     preAllocateTracks = list(list(track.height = 0.02))
   )
@@ -102,33 +112,33 @@ PlotCirclize <- function (data,
     xlim = circlize::get.cell.meta.data("xlim")
     ylim = circlize::get.cell.meta.data("ylim")
     sector.index = circlize::get.cell.meta.data("sector.index")
-    circlize::circos.text(mean(xlim), mean(ylim), sector.index, col = "black", 
+    circlize::circos.text(mean(xlim), mean(ylim), sector.index, col = "black",
                           cex = 1, niceFacing = TRUE,
                           facing = "inside", adj = c(0.5, -1.2))
   }, bg.border = NA)
 
   # Legend text
   legend.items <- list(lapply(seq_along(category.items), function(i) {
-    sprintf("%s (%s)", 
-            category.items[i], 
-            length(category.selects[as.numeric(category.selects[, 1]) == i, 1])
+    sprintf("%s (%s)",
+            category.items[i],
+            max(table(category.selects[,i]),0)
     )
   }))
 
   # Legend title
   legend.title <- list(
     bquote(
-      bold(.(sprintf("%s (%s)", category,  nrow(category.selects))))
+      bold(.(sprintf("%s (%s)", category, length(which(!is.na(unlist(category.selects)))))))
     )
   )
 
   # Create legend
-  graphics::legend("right", 
-                   title = do.call(expression, unlist(legend.title)), 
+  graphics::legend("right",
+                   title = do.call(expression, unlist(legend.title)),
                    legend = unlist(legend.items),
-                   cex = 1, 
-                   y.intersp = category.spacing, 
-                   inset = category.inset, 
+                   cex = 1,
+                   y.intersp = category.spacing,
+                   inset = category.inset,
                    bty = "n"
   )
 

diff --git a/R/plot_parse.R b/R/plot_parse.R
@@ -373,7 +373,7 @@ ParsePlot <- function (plot.data,
           lapply(create.document, function (j) {
 
             # Add new slide
-            document <- officer::add_slide(document, "Blank", "Office Theme")
+            document <- officer::add_slide(document, "Title and Content", "Office Theme")
 
             # If Vector graphics use rvg
             if (vector.graphic) { 
@@ -382,7 +382,7 @@ ParsePlot <- function (plot.data,
               document <- rvg::ph_with_vg(document, 
                                           print(plot.data[[j]]),
                                           fonts = list(font.type),
-                                          type = NULL,
+                                          type = "body",
                                           pointsize = point.size,
                                           offx = (page.width - plot.width) / 2,
                                           offy = (page.height - plot.height) / 2,

diff --git a/man/PlotCirclize.Rd b/man/PlotCirclize.Rd