include plot_matrix

DESCRIPTION

@@ -1,15 +1,15 @@
 Package: circumstance
 Type: Package
 Title: pomp parallelized
-Version: 0.0.5.3
-Date: 2023-04-06
+Version: 0.0.6.0
+Date: 2023-04-10
 Maintainer: Aaron A. King <kingaa@umich.edu>
 Description: Helper functions for parallelizing pomp computations.
 Authors@R: c(person(given=c("Aaron","A."),family="King",
 		role=c("aut","cre"),email="kingaa@umich.edu"))
 URL: https://kingaa.github.io/circumstance/
 Depends: R(>= 4.1.0), pomp(>= 4.6.4)
-Imports: methods, foreach
+Imports: methods, foreach, grid, grDevices, graphics, utils
 Suggests: doFuture, doRNG, dplyr, tidyr, ggplot2
 Remotes: kingaa/pomp
 License: GPL-3
@@ -24,3 +24,4 @@ Collate:
     'continue.R'
     'pfilter.R'
     'mif2.R'
+    'plot_matrix.R'

NAMESPACE

@@ -1,12 +1,37 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(plot_matrix,data.frame)
+S3method(plot_matrix,list)
+S3method(print,plotmatrix)
 export(continue)
+export(plot_matrix)
 exportMethods(continue)
 exportMethods(mif2)
 exportMethods(pfilter)
 import(methods)
 importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
+importFrom(grDevices,grey)
+importFrom(graphics,hist)
+importFrom(grid,frameGrob)
+importFrom(grid,gList)
+importFrom(grid,gTree)
+importFrom(grid,gpar)
+importFrom(grid,grid.draw)
+importFrom(grid,grid.layout)
+importFrom(grid,grid.newpage)
+importFrom(grid,packGrob)
+importFrom(grid,placeGrob)
+importFrom(grid,pointsGrob)
+importFrom(grid,popViewport)
+importFrom(grid,pushViewport)
+importFrom(grid,rectGrob)
+importFrom(grid,textGrob)
+importFrom(grid,unit)
+importFrom(grid,viewport)
+importFrom(grid,xaxisGrob)
+importFrom(grid,yaxisGrob)
 importFrom(pomp,mif2)
 importFrom(pomp,pfilter)
 importFrom(utils,globalVariables)
+importFrom(utils,head)

R/plot_matrix.R

@@ -0,0 +1,175 @@
+##' A scatterplot matrix with densities on the diagonal.
+##'
+##' A special scatterplot matrix.
+##'
+##' @name plot_matrix
+##' @rdname plot_matrix
+##'
+##' @param data Data to plot.
+##' @param marg.exp Fraction by which to expand the plot at the margins.
+##' @param labels Names of variables plotted.
+##' @param alpha,pch,size Refer to the plotted points in the scatterplots.
+##' @param \dots optional arguments, passed to \code{\link{hist}}.
+##' @param x \code{plot_matrix} object to display.
+##' @param newpage logical; if \code{TRUE}, \code{grid.newpage()} will be called
+##' before the graphics are drawn.
+##' @param vp viewport to use.  See \code{\link[grid]{viewport}}.
+##' @example examples/plot_matrix.R
+##' @importFrom grid unit grid.newpage
+##' viewport pushViewport popViewport
+##' gList gTree gpar grid.draw grid.layout grid.newpage
+##' packGrob placeGrob pointsGrob rectGrob textGrob frameGrob xaxisGrob yaxisGrob
+##' @importFrom grDevices grey
+##' @importFrom graphics hist
+##' @importFrom utils head
+##'
+NULL
+
+plot_matrix.internal <- function (data, marg.exp=0.02, labels = names(data),
+  alpha = 1, pch = 16, size = unit(0.03,"npc"),
+  ...) {
+
+  nvar <- length(data)
+
+  histos <- lapply(data,hist,plot=FALSE,...,warn.unused=FALSE)
+
+  ranges <- lapply(
+    histos,
+    function (x) {
+      r <- range(x$breaks)
+      d <- marg.exp*diff(r)
+      r+c(-d,d)
+    }
+  )
+
+  splot <- function (a, b, xaxis, yaxis) {
+    gTree(
+      children=gList(
+        rectGrob(
+          gp=gpar(col='black',fill=NA)
+        ),
+        pointsGrob(
+          x=data[[a]],
+          y=data[[b]],
+          pch=pch,
+          size=size,
+          gp=gpar(col="black",alpha=alpha)
+        ),
+        if (xaxis[1]) xaxisGrob(main=xaxis[2]) else NULL,
+        if (xaxis[1]) {
+          if (xaxis[2])
+            textGrob(labels[a],y=unit(-3,"lines"))
+          else
+            textGrob(labels[a],y=unit(1,"npc")+unit(3,"lines"))
+        } else NULL,
+        if (yaxis[1]) yaxisGrob(main=yaxis[2]) else NULL,
+        if (yaxis[1]) {
+          if (yaxis[2])
+            textGrob(labels[b],x=unit(-3,"lines"))
+          else
+            textGrob(labels[b],x=unit(1,"npc")+unit(3,"lines"))
+        } else NULL
+      ),
+      vp=viewport(
+        xscale=ranges[[a]],
+        yscale=ranges[[b]]
+      )
+    )
+  }
+
+  hplot <- function (a, xaxis) {
+    y <- histos[[a]]$density
+    x <- head(histos[[a]]$breaks,-1)
+    w <- diff(histos[[a]]$breaks)
+    gTree(
+      children=gList(
+        rectGrob(
+          gp=gpar(col='black',fill=NA)
+        ),
+        rectGrob(
+          x=x,
+          y=0,
+          width=w,
+          height=y,
+          just=c(0,0),
+          default.units='native',
+          gp=gpar(fill=grey(0.8))
+        ),
+        if (xaxis[1]) xaxisGrob(main=xaxis[2]) else NULL,
+        if (xaxis[1]) {
+          if (xaxis[2])
+            textGrob(labels[a],y=unit(-3,"lines"))
+          else
+            textGrob(labels[a],y=unit(1,"npc")+unit(3,"lines"))
+        } else NULL
+      ),
+      vp=viewport(
+        xscale=ranges[[a]],
+        yscale=c(0,(1+marg.exp)*max(histos[[a]]$density))
+      )
+    )
+  }
+
+  fg <- frameGrob(layout=grid.layout(nrow=length(data),ncol=length(data)))
+  for (i in seq_len(nvar)) {
+    for (j in seq_len(nvar)) {
+      if (i == j) {
+        fg <- placeGrob(
+          fg,
+          hplot(i,
+            xaxis=c(
+              ((j==1)&&(i%%2==0))||((j==nvar)&&(i%%2==1)),
+              j==nvar
+            )
+          ),
+          row=i,col=i
+        )
+      } else {
+        fg <- placeGrob(
+          fg,
+          splot(i,j,
+            xaxis=c(
+              ((j==1)&&(i%%2==0))||((j==nvar)&&(i%%2==1)),
+              j==nvar
+            ),
+            yaxis=c(
+              ((i==1)&&(j%%2==0))||((i==nvar)&&(j%%2==1))||
+                ((i==1)&&(j==nvar)),
+              (i==1)
+            )
+          ),
+          row=j,col=i
+        )
+      }
+    }
+  }
+  gob <- packGrob(
+    frameGrob(),
+    fg,
+    width=unit(1,"npc")-unit(8,"lines"),
+    height=unit(1,"npc")-unit(8,"lines")
+  )
+  class(gob) <- c("plotmatrix",class(gob))
+  gob
+}
+
+##' @rdname plot_matrix
+##' @export
+plot_matrix <- function (data, ...) UseMethod("plot_matrix")
+
+##' @rdname plot_matrix
+##' @export
+plot_matrix.list <- plot_matrix.internal
+
+##' @rdname plot_matrix
+##' @export
+plot_matrix.data.frame <- plot_matrix.internal
+
+##' @rdname plot_matrix
+##' @export
+print.plotmatrix <- function (x, newpage = is.null(vp), vp = NULL, ...) {
+  if (newpage) grid.newpage()
+  if (!is.null(vp)) pushViewport(vp)
+  grid.draw(x)
+  if (!is.null(vp)) popViewport()
+}

TODO.md

@@ -0,0 +1 @@
+- Smoothing tool for 'pfilterd_pomp' and 'pmcmcd_pomp' objects

examples/plot_matrix.R

@@ -0,0 +1,27 @@
+\donttest{ # requires dplyr
+  library(dplyr)
+
+  data.frame(
+    a=rexp(n=1000,rate=1/3),
+    b=rnorm(1000)
+  ) |>
+    mutate(
+      c=a+b^2,
+      d=a-b^3
+    ) -> x
+
+  print(plot_matrix(x,alpha=0.2))
+
+  g <- plot_matrix(
+    x[-2],
+    labels=c(
+      expression(alpha),
+      expression(beta),
+      expression(phi)
+    ),
+    alpha=0.3
+  )
+  print(g)
+
+  print(plot_matrix(as.list(x),alpha=0.2,breaks="scott"))
+}

inst/NEWS

@@ -1,5 +1,9 @@
 _N_e_w_s _f_o_r _p_a_c_k_a_g_e '_c_i_r_c_u_m_s_t_a_n_c_e'
 
+_C_h_a_n_g_e_s _i_n '_c_i_r_c_u_m_s_t_a_n_c_e' _v_e_r_s_i_o_n _0._0._6:
+
+        • New ‘plot_matrix’ method for making scatterplot matrices.
+
 _C_h_a_n_g_e_s _i_n '_c_i_r_c_u_m_s_t_a_n_c_e' _v_e_r_s_i_o_n _0._0._5:
 
         • New ‘mif2’ method for parallel iterated filtering.

inst/NEWS.Rd

@@ -1,5 +1,10 @@
 \name{NEWS}
 \title{News for package `circumstance'}
+\section{Changes in \pkg{circumstance} version 0.0.6}{
+  \itemize{
+    \item New \code{plot_matrix} method for making scatterplot matrices.
+  }
+}
 \section{Changes in \pkg{circumstance} version 0.0.5}{
   \itemize{
     \item New \code{mif2} method for parallel iterated filtering.