From 1ee2892bc331a70bdb31bf9875e7995bf9088f0f Mon Sep 17 00:00:00 2001 From: Nicole Kramer Date: Mon, 24 Jul 2023 14:24:01 -0400 Subject: [PATCH 1/2] plotMatrix edge cases with grid imports Inner viewport creation for appropriate pixel scaling with non-square matrices and/or disproportionate placement dimensions. --- NAMESPACE | 2 ++ R/methods-plotMatrix.R | 78 ++++++++++++++++++++++++++++++------------ 2 files changed, 58 insertions(+), 22 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index af676d0..b897e9e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -242,6 +242,8 @@ importFrom(graphics,rect) importFrom(graphics,segments) importFrom(graphics,text) importFrom(grid,addGrob) +importFrom(grid,convertHeight) +importFrom(grid,convertWidth) importFrom(grid,gTree) importFrom(grid,gpar) importFrom(grid,grid.draw) diff --git a/R/methods-plotMatrix.R b/R/methods-plotMatrix.R index 5bf14e4..3337363 100644 --- a/R/methods-plotMatrix.R +++ b/R/methods-plotMatrix.R @@ -140,7 +140,7 @@ #' @importFrom RColorBrewer brewer.pal #' @importFrom plotgardener mapColors #' @importFrom grid viewport unit grid.newpage gTree grid.ls rectGrob -#' addGrob grid.draw gpar +#' addGrob grid.draw gpar convertWidth convertHeight #' @importFrom rlang inform #' @importFrom grDevices colorRampPalette #' @noRd @@ -216,17 +216,29 @@ ## Not translating into page_coordinates if (is.null(matrixPlot$x) & is.null(matrixPlot$y)){ - + # Outer viewport vp <- viewport(x=unit(0.5, "npc"), y=unit(0.5, "npc"), height=unit(1, "snpc"), width=unit(1, "snpc"), clip="on", - xscale=c(0, dims[2]), - yscale=c(dims[1], 0), just="center", - name="MatrixPlot1") - + name="MatrixPlot1_outside") + ## Define inner viewport with appropriate matrix dimensions + # Get minimum scaling based on nrow and ncol + minScale <- min(1/(dims/10)) + # Multiply nrow and ncol ratios by minScale + vpDims <- (dims/10)*minScale + + mat_vp <- viewport(x=unit(0.5, "npc"), + y=unit(0.5,"npc"), + height=unit(vpDims[1], "npc"), + width=unit(vpDims[2], "npc"), + xscale=c(0, dims[2]), + yscale=c(dims[1], 0), + just="center", + name="MatrixPlot1") + if (matrixPlot$draw){ grid.newpage() } @@ -246,17 +258,46 @@ ## Convert coordinates into same units as page page_coords <- plotgardener:::convert_page(matrixPlot) - - ## Make viewport + ## Outer viewport vp <- viewport(x=page_coords$x, y=page_coords$y, height=page_coords$height, width=page_coords$width, clip="on", - xscale=c(0, dims[2]), - yscale=c(dims[1], 0), just=matrixPlot$just, - name=vp_name) + name=paste0(vp_name, "_outside")) + + ## Define inner viewport with appropriate matrix dimensions + # Convert nrow and ncol snpc scaling to page coordinates + mat_height <- convertHeight(unit(dims[1]/10, "snpc"), + unitTo=get("page_units", + envir=plotgardener:::pgEnv), + valueOnly=TRUE) + mat_width <- convertWidth(unit(dims[2]/10, "snpc"), + unitTo=get("page_units", + envir=plotgardener:::pgEnv), + valueOnly=TRUE) + + # Get minimum scaling to outer viewport based on nrow and ncol + minScale <- min(as.numeric(page_coords$height)/mat_height, + as.numeric(page_coords$width)/mat_width) + + # Multiply mat_height and mat_width by minScale + vpDims <- c(mat_height, mat_width)*minScale + + mat_vp <- viewport(x=unit(0.5, "npc"), + y=unit(0.5,"npc"), + height=unit(vpDims[1], + get("page_units", + envir=plotgardener:::pgEnv)), + width=unit(vpDims[2], + get("page_units", + envir=plotgardener:::pgEnv)), + xscale=c(0, dims[2]), + yscale=c(dims[1], 0), + just="center", + name="MatrixPlot1") + } ## Handle graphical objects ---------------- @@ -272,24 +313,17 @@ ## Assign name to grob name <- paste0("MatrixPlot", nObjs + 1) - - ## Find the length of each square - maxDim <- which.max(dims) - if (maxDim == 1L) { - len <- vp$height/dims[maxDim] - } else { - len <- vp$width/dims[maxDim] - } - ## Make grobs + ## Make grobs within mat_vp mpSquares <- rectGrob( x=m_long$colnum, y=m_long$rownum, just=c("right", "top"), - width=len, - height=len, + width=1, + height=1, gp=gpar(col=NA, fill=m_long$color), default.units="native", + vp=mat_vp, name=name ) From f7a7d782d4514aaf3b6ceabea3a7a399c1d6de85 Mon Sep 17 00:00:00 2001 From: Nicole Kramer Date: Fri, 11 Aug 2023 15:27:21 -0400 Subject: [PATCH 2/2] Minor updates to inner matrix viewport scaling. Removed unnecessary scaling by 10. --- R/methods-plotMatrix.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/methods-plotMatrix.R b/R/methods-plotMatrix.R index 3337363..c964969 100644 --- a/R/methods-plotMatrix.R +++ b/R/methods-plotMatrix.R @@ -213,7 +213,6 @@ ## If placing information is provided but plot == TRUE, ## set up it's own viewport separate from pageCreate - ## Not translating into page_coordinates if (is.null(matrixPlot$x) & is.null(matrixPlot$y)){ # Outer viewport @@ -226,9 +225,9 @@ name="MatrixPlot1_outside") ## Define inner viewport with appropriate matrix dimensions # Get minimum scaling based on nrow and ncol - minScale <- min(1/(dims/10)) + minScale <- min(1/dims) # Multiply nrow and ncol ratios by minScale - vpDims <- (dims/10)*minScale + vpDims <- dims*minScale mat_vp <- viewport(x=unit(0.5, "npc"), y=unit(0.5,"npc"), @@ -269,11 +268,11 @@ ## Define inner viewport with appropriate matrix dimensions # Convert nrow and ncol snpc scaling to page coordinates - mat_height <- convertHeight(unit(dims[1]/10, "snpc"), + mat_height <- convertHeight(unit(dims[1], "snpc"), unitTo=get("page_units", envir=plotgardener:::pgEnv), valueOnly=TRUE) - mat_width <- convertWidth(unit(dims[2]/10, "snpc"), + mat_width <- convertWidth(unit(dims[2], "snpc"), unitTo=get("page_units", envir=plotgardener:::pgEnv), valueOnly=TRUE)