diff --git a/DESCRIPTION b/DESCRIPTION index 8b235f0..3230f22 100644 --- a/DESCRIPTION +++ b/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 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' diff --git a/NAMESPACE b/NAMESPACE index 0e2d730..4f39b8a 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/plot_matrix.R b/R/plot_matrix.R new file mode 100644 index 0000000..78a8604 --- /dev/null +++ b/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() +} diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..80ca73c --- /dev/null +++ b/TODO.md @@ -0,0 +1 @@ +- Smoothing tool for 'pfilterd_pomp' and 'pmcmcd_pomp' objects diff --git a/examples/plot_matrix.R b/examples/plot_matrix.R new file mode 100644 index 0000000..bf500f1 --- /dev/null +++ b/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")) +} diff --git a/inst/NEWS b/inst/NEWS index 1d29910..c10503e 100644 --- a/inst/NEWS +++ b/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. diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 25efbc7..5338f36 100644 --- a/inst/NEWS.Rd +++ b/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. diff --git a/man/plot_matrix.Rd b/man/plot_matrix.Rd new file mode 100644 index 0000000..d133e80 --- /dev/null +++ b/man/plot_matrix.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_matrix.R +\name{plot_matrix} +\alias{plot_matrix} +\alias{plot_matrix.list} +\alias{plot_matrix.data.frame} +\alias{print.plotmatrix} +\title{A scatterplot matrix with densities on the diagonal.} +\usage{ +plot_matrix(data, ...) + +\method{plot_matrix}{list}( + data, + marg.exp = 0.02, + labels = names(data), + alpha = 1, + pch = 16, + size = unit(0.03, "npc"), + ... +) + +\method{plot_matrix}{data.frame}( + data, + marg.exp = 0.02, + labels = names(data), + alpha = 1, + pch = 16, + size = unit(0.03, "npc"), + ... +) + +\method{print}{plotmatrix}(x, newpage = is.null(vp), vp = NULL, ...) +} +\arguments{ +\item{data}{Data to plot.} + +\item{\dots}{optional arguments, passed to \code{\link{hist}}.} + +\item{marg.exp}{Fraction by which to expand the plot at the margins.} + +\item{labels}{Names of variables plotted.} + +\item{alpha, pch, size}{Refer to the plotted points in the scatterplots.} + +\item{x}{\code{plot_matrix} object to display.} + +\item{newpage}{logical; if \code{TRUE}, \code{grid.newpage()} will be called +before the graphics are drawn.} + +\item{vp}{viewport to use. See \code{\link[grid]{viewport}}.} +} +\description{ +A special scatterplot matrix. +} +\examples{ +\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")) +} +} diff --git a/tests/plot_matrix-1.png b/tests/plot_matrix-1.png new file mode 100644 index 0000000..ddff326 Binary files /dev/null and b/tests/plot_matrix-1.png differ diff --git a/tests/plot_matrix-2.png b/tests/plot_matrix-2.png new file mode 100644 index 0000000..0213796 Binary files /dev/null and b/tests/plot_matrix-2.png differ diff --git a/tests/plot_matrix-3.png b/tests/plot_matrix-3.png new file mode 100644 index 0000000..9306da5 Binary files /dev/null and b/tests/plot_matrix-3.png differ diff --git a/tests/plot_matrix-4.png b/tests/plot_matrix-4.png new file mode 100644 index 0000000..d5f3061 Binary files /dev/null and b/tests/plot_matrix-4.png differ diff --git a/tests/plot_matrix-5.png b/tests/plot_matrix-5.png new file mode 100644 index 0000000..c8309bc Binary files /dev/null and b/tests/plot_matrix-5.png differ diff --git a/tests/plot_matrix.R b/tests/plot_matrix.R new file mode 100644 index 0000000..d8a869d --- /dev/null +++ b/tests/plot_matrix.R @@ -0,0 +1,34 @@ +library(dplyr) +library(grid) +library(circumstance) + +png(filename="plot_matrix-%01d.png",res=100) + +x <- data.frame(a=rexp(n=1000,rate=1/3),b=rnorm(1000)) +mutate(x,c=a+b^2,d=a-b^3) -> x + +plot_matrix(x,alpha=0.2) + +plot_matrix( + x[-2], + labels=c( + expression(alpha), + expression(beta), + expression(phi) + ), + alpha=0.3 +) + +(g <- plot_matrix(x[1])) + +g <- plot_matrix(as.list(x),alpha=0.2,breaks='scott') +print(g) + +try(plot_matrix(numeric(10))) + +print(g,vp=plotViewport(c(1,1,10,10)),newpage=T) +print(g,vp=viewport(x=0.8,y=0.8,width=0.4,height=0.4)) + +dev.off() + +try(plot_matrix(LETTERS)) diff --git a/tests/plot_matrix.Rout.save b/tests/plot_matrix.Rout.save new file mode 100644 index 0000000..b3ca7b0 --- /dev/null +++ b/tests/plot_matrix.Rout.save @@ -0,0 +1,85 @@ + +R version 4.2.3 (2023-03-15) -- "Shortstop Beagle" +Copyright (C) 2023 The R Foundation for Statistical Computing +Platform: x86_64-pc-linux-gnu (64-bit) + +R is free software and comes with ABSOLUTELY NO WARRANTY. +You are welcome to redistribute it under certain conditions. +Type 'license()' or 'licence()' for distribution details. + +R is a collaborative project with many contributors. +Type 'contributors()' for more information and +'citation()' on how to cite R or R packages in publications. + +Type 'demo()' for some demos, 'help()' for on-line help, or +'help.start()' for an HTML browser interface to help. +Type 'q()' to quit R. + +> library(dplyr) + +Attaching package: ‘dplyr’ + +The following objects are masked from ‘package:stats’: + + filter, lag + +The following objects are masked from ‘package:base’: + + intersect, setdiff, setequal, union + +> library(grid) +> library(circumstance) +Loading required package: pomp + +Welcome to pomp! + +As of version 4.6, no user-visible pomp function has a name that +includes a dot ('.'). Function names have been changed to replace the +dot with an underscore ('_'). For more information, see the pomp blog: +https://kingaa.github.io/pomp/blog.html. + + +Attaching package: ‘circumstance’ + +The following objects are masked from ‘package:pomp’: + + continue, mif2, pfilter + +> +> png(filename="plot_matrix-%01d.png",res=100) +> +> x <- data.frame(a=rexp(n=1000,rate=1/3),b=rnorm(1000)) +> mutate(x,c=a+b^2,d=a-b^3) -> x +> +> plot_matrix(x,alpha=0.2) +> +> plot_matrix( ++ x[-2], ++ labels=c( ++ expression(alpha), ++ expression(beta), ++ expression(phi) ++ ), ++ alpha=0.3 ++ ) +> +> (g <- plot_matrix(x[1])) +> +> g <- plot_matrix(as.list(x),alpha=0.2,breaks='scott') +> print(g) +> +> try(plot_matrix(numeric(10))) +Error in UseMethod("plot_matrix") : + no applicable method for 'plot_matrix' applied to an object of class "c('double', 'numeric')" +> +> print(g,vp=plotViewport(c(1,1,10,10)),newpage=T) +> print(g,vp=viewport(x=0.8,y=0.8,width=0.4,height=0.4)) +> +> dev.off() +null device + 1 +> +> try(plot_matrix(LETTERS)) +Error in UseMethod("plot_matrix") : + no applicable method for 'plot_matrix' applied to an object of class "character" +>