diff --git a/DESCRIPTION b/DESCRIPTION index d3a6827..0e5db32 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -60,7 +60,9 @@ Imports: utils, grDevices, graphics, - grid + grid, + tibble, + tidyr biocViews: FunctionalGenomics, Visualization, diff --git a/NAMESPACE b/NAMESPACE index d791c9a..ba6b79b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -233,10 +233,12 @@ importFrom(graphics,segments) importFrom(graphics,text) importFrom(grid,addGrob) importFrom(grid,gTree) +importFrom(grid,gpar) importFrom(grid,grid.draw) importFrom(grid,grid.ls) importFrom(grid,grid.newpage) importFrom(grid,rasterGrob) +importFrom(grid,rectGrob) importFrom(grid,unit) importFrom(grid,viewport) importFrom(magrittr,`%<>%`) @@ -264,6 +266,9 @@ importFrom(strawr,readHicBpResolutions) importFrom(strawr,readHicChroms) importFrom(strawr,readHicNormTypes) importFrom(strawr,straw) +importFrom(tibble,as_tibble) +importFrom(tibble,rownames_to_column) +importFrom(tidyr,pivot_longer) importFrom(utils,capture.output) importFrom(utils,tail) importMethodsFrom(IRanges,countOverlaps) diff --git a/R/methods-plotMatrix.R b/R/methods-plotMatrix.R index 7036b8e..b9eb5fd 100644 --- a/R/methods-plotMatrix.R +++ b/R/methods-plotMatrix.R @@ -140,9 +140,11 @@ #' @importFrom RColorBrewer brewer.pal #' @importFrom plotgardener mapColors #' @importFrom grid viewport unit grid.newpage gTree grid.ls rasterGrob -#' addGrob grid.draw +#' addGrob grid.draw rectGrob gpar #' @importFrom rlang inform #' @importFrom grDevices colorRampPalette +#' @importFrom tibble as_tibble rownames_to_column +#' @importFrom tidyr pivot_longer #' @noRd .plotMatrix <- function(data, params, x, y, width, height, just, default.units, draw, palette, zrange, @@ -207,15 +209,20 @@ m <- matrix(data=colv, nrow=nrow(matrixPlot$data), ncol=ncol(matrixPlot$data)) + + ## Convert matrix to tibble where column names = col number and add rownum + colnames(m) <- seq(1, ncol(m)) + m_tibble <- as_tibble(m) + m_tibble <- rownames_to_column(m_tibble, var = "rownum") + + ## Convert to 3-column df with rownum, colnum, and color columns + m_long <- pivot_longer(m_tibble, + !rownum, + names_to = "colnum", + values_to = "color") ## Viewports --------------------------- - ## Get viewport name - currentViewports <- plotgardener:::current_viewports() - nVp <- length(grep("MatrixPlot", currentViewports)) - vp_name <- paste0("MatrixPlot", nVp + 1) - - ## If placing information is provided but plot == TRUE, ## set up it's own viewport separate from pageCreate @@ -227,15 +234,21 @@ height=unit(1, "snpc"), width=unit(1, "snpc"), clip="on", + xscale = c(0, ncol(matrixPlot$data)), + yscale = c(nrow(matrixPlot$data), 0), just="center", - name=vp_name) + name="MatrixPlot1") if (matrixPlot$draw){ - vp$name <- "MatrixPlot1" grid.newpage() } } else { + + ## Get viewport name + currentViewports <- plotgardener:::current_viewports() + nVp <- length(grep("MatrixPlot", currentViewports)) + vp_name <- paste0("MatrixPlot", nVp + 1) ## Check that plotgardener page exists plotgardener:::check_page( @@ -252,6 +265,8 @@ height=page_coords$height, width=page_coords$width, clip="on", + xscale = c(0, ncol(matrixPlot$data)), + yscale = c(nrow(matrixPlot$data), 0), just=matrixPlot$just, name=vp_name) } @@ -271,13 +286,20 @@ name <- paste0("MatrixPlot", nObjs + 1) ## Make grobs - mpRaster <- rasterGrob(image=m, interpolate=FALSE, name=name) + mpSquares <- rectGrob(x = m_long$colnum, + y = m_long$rownum, + just = c("right", "top"), + width = 1, + height = 1, + gp = gpar(col = NA, fill = m_long$color), + default.units = "native", + name = name) ## Assign grobs to gTree assign(x="MatrixPlotGrobs", value=addGrob(gTree=get(x="MatrixPlotGrobs", envir=plotgardener:::pgEnv), - child=mpRaster), + child=mpSquares), envir=plotgardener:::pgEnv) ## Add grobs to object @@ -289,7 +311,7 @@ } ## Return object -------------------------- - inform(paste0("MatrixPlot[", mpRaster$name, "]")) + inform(paste0("MatrixPlot[", mpSquares$name, "]")) invisible(matrixPlot) }