diff --git a/.gitignore b/.gitignore index 7520817..99ea9d8 100644 --- a/.gitignore +++ b/.gitignore @@ -52,3 +52,4 @@ po/*~ # RStudio Connect folder rsconnect/ +.positai diff --git a/DESCRIPTION b/DESCRIPTION index e74ce8b..ed1e044 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,16 @@ Package: magicaxis Type: Package Title: Pretty Scientific Plotting with Minor-Tick and Log Minor-Tick Support -Version: 2.5.3 -Date: 2025-02-24 +Version: 2.6.0 +Date: 2026-05-14 Authors@R: person(given = "Aaron", family = "Robotham", role = c("aut", "cre"), email = "aaron.robotham@uwa.edu.au") Description: Functions to make useful (and pretty) plots for scientific plotting. Additional plotting features are added for base plotting, with particular emphasis on making attractive log axis plots. License: LGPL-3 -Suggests: imager, fst, plotly, abind -Imports: grDevices, graphics, stats, celestial (>= 1.4.1), MASS, plotrix, sm, mapproj, RANN +Suggests: imager, fst, plotly, abind, testthat (>= 3.0.0), knitr, rmarkdown +Imports: grDevices, graphics, stats, celestial (>= 1.4.1), MASS, plotrix, sm, mapproj, RANN, ParmOff +Remotes: asgr/ParmOff +VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 7cd2410..6fd8b1a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,7 @@ import("mapproj") importFrom("grDevices", "hsv", "rainbow", "grey", "rgb", "dev.cur", "extendrange", "colorRampPalette", "hcl.colors", "grey.colors") importFrom("graphics", "arrows", "axis", "box", "contour", "image", "mtext", "par", "plot", "plot.new", "plot.window", "rect", "text", "abline", "layout", - "lines", "points", "polygon", "hist") + "lines", "points", "points.default", "polygon", "hist") importFrom("stats", "approxfun", "density", "median", "pnorm", "quantile", "sd", "rnorm", "ecdf", "qnorm", "mad", "aggregate", "runif") importFrom("celestial", "hms2deg", "dms2deg", "deg2hms", "deg2dms", "radec2xy", "xy2radec", "getpixscale") importFrom("RANN", "nn2") @@ -15,3 +15,4 @@ importFrom("plotrix", "color.legend", "draw.ellipse") importFrom("sm", "sm.density") importFrom("MASS", "kde2d") importFrom("utils", "str") +importFrom("ParmOff", "ParmOff") diff --git a/R/magaxis.R b/R/magaxis.R index 0c37398..ddfc4c3 100644 --- a/R/magaxis.R +++ b/R/magaxis.R @@ -5,15 +5,8 @@ function(side=1:2, majorn=5, minorn='auto', tcl=0.5, ratio=0.5, labels=TRUE, unl usepar=FALSE, grid=FALSE, grid.col='grey', grid.lty=1, grid.lwd=1, axis.lwd=1, ticks.lwd=axis.lwd, axis.col='black', do.tick=TRUE, ...){ dots=list(...) -dotskeepaxis=c('cex.axis', 'col.axis', 'font.axis', 'xaxp', 'yaxp', 'tck', 'las', 'fg', 'xpd', 'xaxt', 'yaxt', 'col.ticks') -dotskeepmtext=c('cex.lab', 'col.lab', 'font.lab') -if(length(dots)>0){ - dotsaxis=dots[names(dots) %in% dotskeepaxis] - dotsmtext=dots[names(dots) %in% dotskeepmtext] -}else{ - dotsaxis={} - dotsmtext={} -} +keepaxis = c('side', 'at', 'tcl', 'labels', 'tick', 'mgp', 'lwd', 'lwd.ticks', 'col', 'cex.axis', 'col.axis', 'font.axis', 'xaxp', 'yaxp', 'tck', 'las', 'fg', 'xpd', 'xaxt', 'yaxt', 'col.ticks') +keepmtext = c('text', 'side', 'line', 'cex.lab', 'col.lab', 'font.lab') if(length(mtline)==1){mtline=rep(mtline,2)} majornlist=majorn minornlist=minorn @@ -156,16 +149,16 @@ for(i in 1:length(side)){ } if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=powbase^major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dots), .use_args=keepaxis) }else{ - do.call("axis", c(list(side=currentside,at=major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dots), .use_args=keepaxis) } if(labels){ if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=powbase^labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dots), .use_args=keepaxis) }else{ - do.call("axis", c(list(side=currentside,at=labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dots), .use_args=keepaxis) } } @@ -173,21 +166,18 @@ for(i in 1:length(side)){ minors = minors[-c(1,length(minors))] minor.ticks = c(outer(minors, major.ticks, `+`)) if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=powbase^minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col), dots),.use_args=keepaxis) }else{ - do.call("axis", c(list(side=currentside,at=minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) + ParmOff(axis, c(list(side=currentside,at=minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dots), .use_args=keepaxis) } } } - if(length(dotsmtext)>0){ - names(dotsmtext)=c('cex', 'col', 'font')[match(names(dotsmtext), dotskeepmtext)] - } if(is.null(xlab)==FALSE){ - do.call("mtext", c(list(text=xlab, side=ifelse(side[1] %in% c(1,3), side[1], side[2]), line=mtline[1]), dotsmtext)) + ParmOff(mtext, c(list(text=xlab, side=ifelse(side[1] %in% c(1,3), side[1], side[2]), line=mtline[1]), dots), .use_args = keepmtext) } if(is.null(ylab)==FALSE){ - do.call("mtext", c(list(text=ylab, side=ifelse(side[2] %in% c(2,4), side[2], side[1]), line=mtline[2]), dotsmtext)) + ParmOff(mtext, c(list(text=ylab, side=ifelse(side[2] %in% c(2,4), side[2], side[1]), line=mtline[2]), dots), .use_args = keepmtext) } if(frame.plot){box()} diff --git a/R/magbin.R b/R/magbin.R index 0df7e6f..8e7237b 100644 --- a/R/magbin.R +++ b/R/magbin.R @@ -304,11 +304,11 @@ plot.magbin = function(x, colramp=hcl.colors(21), colstretch='lin', sizestretch= if(!is.na(x$dustlim)){ x$bins = x$bins[x$bins[,'count']>x$dustlim,] } - colmap = do.call("magmap", c(list(data=x$bins[,colref], stretch=colstretch, range=c(1,length(colramp)), bad=NA), dotsmap)) + colmap = ParmOff(magmap, c(list(data=x$bins[,colref], stretch=colstretch, range=c(1,length(colramp)), bad=NA), dotsmap)) if(sizeref=='none'){ sizemap = rep(1,dim(x$bins)[1]) }else{ - sizemap = do.call("magmap", c(list(data=x$bins[,sizeref], stretch=sizestretch, range=c(0,1), bad=NA)))$map + sizemap = ParmOff(magmap, c(list(data=x$bins[,sizeref], stretch=sizestretch, range=c(0,1), bad=NA)))$map } #colmap = magmap(x$bins[,3], stretch=stretch, bad=NA, range=c(1,length(colramp))) if('xlim' %in% names(dots)){ @@ -351,9 +351,9 @@ plot.magbin = function(x, colramp=hcl.colors(21), colstretch='lin', sizestretch= #4 (bottomright) par(mar=c(0,0,0,0)) - do.call("magplot", c(list(NA, NA, xlim=xlim, ylim=ylim, side=c(1,2,3,4), labels=c(T,T,F,F)), dots)) + ParmOff(magplot, c(list(NA, NA, xlim=xlim, ylim=ylim, side=c(1,2,3,4), labels=c(T,T,F,F)), dots)) }else{ - do.call("magplot", c(list(NA, NA, xlim=xlim, ylim=ylim), dots)) + ParmOff(magplot, c(list(NA, NA, xlim=xlim, ylim=ylim), dots)) } } #magplot(NA, NA, xlim=x$xlim, ylim=x$ylim, ...) @@ -387,7 +387,7 @@ plot.magbin = function(x, colramp=hcl.colors(21), colstretch='lin', sizestretch= points(x$dust$x, x$dust$y, pch=pch.dust, col=colramp[1], cex=cex.dust) }else{ if(colref=='zstat'){ - colmapdust = do.call("magmap", c(list(data=x$dust$z, locut=colmap$datalim[1], + colmapdust = ParmOff(magmap, c(list(data=x$dust$z, locut=colmap$datalim[1], hicut=colmap$datalim[2], type='num', stretch=colstretch, range=c(1,length(colramp)), bad=NA)))$map points(x$dust$x, x$dust$y, pch=pch.dust, col=colramp[colmapdust], cex=cex.dust) @@ -404,7 +404,7 @@ plot.magbin = function(x, colramp=hcl.colors(21), colstretch='lin', sizestretch= title = "norm" } } - do.call("magbar", c(list(range=colmap$datalim, log=colstretch=='log', col=colramp, title=title), dotsbar)) + ParmOff(magbar, c(list(range=colmap$datalim, log=colstretch=='log', col=colramp, title=title), dotsbar)) } } diff --git a/R/magcon.R b/R/magcon.R index 74bb8f9..958681e 100644 --- a/R/magcon.R +++ b/R/magcon.R @@ -42,7 +42,7 @@ function(x,y,h,doim=TRUE,docon=TRUE,dobar=TRUE,ngrid=100,add=FALSE,xlab='',ylab= usrlims=par()$usr rect(usrlims[1],usrlims[3],usrlims[2],usrlims[4],col=imcol[1]) } - magimage(tempcon,col=imcol,axes=FALSE,add=TRUE,xlim=xlim,ylim=ylim,magmap=FALSE) + magimage(tempcon[c('x', 'y', 'z')],col=imcol,axes=FALSE,add=TRUE,xlim=xlim,ylim=ylim,magmap=FALSE) } if(doim & docon){contour(tempcon,levels=conlevels,add=TRUE,drawlabels=F,axes=FALSE,...)} if(doim==FALSE & docon){contour(tempcon,levels=conlevels,add=add,drawlabels=F,axes=FALSE,xlim=xlim,ylim=ylim,...);box()} diff --git a/R/magimage.R b/R/magimage.R index 764ac80..d95af99 100644 --- a/R/magimage.R +++ b/R/magimage.R @@ -137,7 +137,7 @@ magimage = function(x, y, z, zlim, xlim, ylim, col = grey((0:1e3)/1e3), add = FA } } - do.call('image',c(list(x=x, y=y, z=z, zlim=zlim, xlim=xlim, ylim=ylim, col=col, add=add, useRaster=useRaster, axes=FALSE, asp=asp, xlab='', ylab='', main=''), dotsimage)) + ParmOff(image,c(list(x=x, y=y, z=z, zlim=zlim, xlim=xlim, ylim=ylim, col=col, add=add, useRaster=useRaster, axes=FALSE, asp=asp, xlab='', ylab='', main=''), dotsimage)) if(add==FALSE){ if(axes){ diff --git a/R/magimageRGB.R b/R/magimageRGB.R index 1acc28b..acd8d1d 100644 --- a/R/magimageRGB.R +++ b/R/magimageRGB.R @@ -110,7 +110,7 @@ magimageRGB<-function(x, y, R, G, B, saturation=1, zlim, xlim, ylim, add = FALSE z = matrix(1:length(R),dim(R)[1]) col = rgb(R,G,B) - do.call('image',c(list(x=x, y=y, z=z, zlim=zlim, xlim=xlim, ylim=ylim, col=col, add=add, useRaster=useRaster, axes=FALSE, asp=asp, xlab='', ylab='', main=''), dotsimage)) + ParmOff(image,c(list(x=x, y=y, z=z, zlim=zlim, xlim=xlim, ylim=ylim, col=col, add=add, useRaster=useRaster, axes=FALSE, asp=asp, xlab='', ylab='', main=''), dotsimage)) if(add==FALSE){ if(axes){ magaxis(...) diff --git a/R/magplot.R b/R/magplot.R index e83244c..6cb7294 100644 --- a/R/magplot.R +++ b/R/magplot.R @@ -39,7 +39,7 @@ magplot = ...) { if (class(x)[1] == 'histogram') { dots = list(...) - do.call('maghist', c( + ParmOff(maghist, c( list( x = x, xlim = xlim, @@ -121,8 +121,7 @@ magplot = grid.lwd = grid.lwd, axis.lwd = axis.lwd, ticks.lwd = ticks.lwd, - axis.col = axis.col, - ... + axis.col = axis.col ) }, lwd = lwd, @@ -220,8 +219,7 @@ magplot = grid.lwd = grid.lwd, axis.lwd = axis.lwd, ticks.lwd = ticks.lwd, - axis.col = axis.col, - ... + axis.col = axis.col ) }, lwd = lwd, @@ -264,7 +262,7 @@ magplot = zstretch = 'log' } } - colmap = do.call("magmap", c( + colmap = ParmOff(magmap, c( list( data = z, stretch = zstretch, @@ -317,11 +315,11 @@ magplot = xlim = xlim, ylim = ylim ) - do.call("points", c(list( + ParmOff(points, c(list( x = x, y = y, col = zcol[colmap$map] ), dots)) if (dobar) { - do.call("magbar", c( + ParmOff(magbar, c( list( range = colmap$datalim, log = zstretch == 'log', diff --git a/R/magtri.R b/R/magtri.R index ea3346f..434634d 100644 --- a/R/magtri.R +++ b/R/magtri.R @@ -8,6 +8,8 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic } if(Npar<=1){stop('Need 2+ parameters!')} + dots=list(...) + if(thin>1){ chains=chains[seq(1,Nsamp,by=thin),,drop=FALSE] Nsamp=dim(chains)[1] @@ -44,7 +46,7 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic xtemp=chains[usesamps,i] if(sd(xtemp)==0){xtemp=xtemp+rnorm(samples,sd=1e-3)} plot(density(xtemp),axes=FALSE,main='',xlim=xrange) - magaxis(1,grid=grid, grid.col = 'lightgrey',labels=FALSE,do.tick=do.tick) + ParmOff(magaxis, dots, side=1, grid=grid, grid.col='lightgrey', labels=FALSE, do.tick=do.tick, .pass_dots=FALSE) abline(v=meanvec[i],lty=1,col='red') abline(v=meanvec[i]-sdvec[i],lty=3,col='red') abline(v=meanvec[i]+sdvec[i],lty=3,col='red') @@ -55,14 +57,14 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic if(i==1){ plot.window(xlim=xrange,ylim=yrange) if(is.null(lab)){ - magaxis(1,xlab=chaincolnames[i]) + ParmOff(magaxis, dots, side=1, xlab=chaincolnames[i], .pass_dots=FALSE) }else{ - magaxis(1,xlab=lab[[i]]) + ParmOff(magaxis, dots, side=1, xlab=lab[[i]], .pass_dots=FALSE) } if(is.null(lab)){ - magaxis(2,ylab=chaincolnames[j]) + ParmOff(magaxis, dots, side=2, ylab=chaincolnames[j], .pass_dots=FALSE) }else{ - magaxis(2,ylab=lab[[j]]) + ParmOff(magaxis, dots, side=2, ylab=lab[[j]], .pass_dots=FALSE) } } }else{ @@ -73,9 +75,9 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic ytemp=chains[usesamps,j] if(sd(xtemp)==0){xtemp=xtemp+rnorm(samples,sd=1e-3)} if(sd(ytemp)==0){ytemp=ytemp+rnorm(samples,sd=1e-3)} - magaxis(1:2,grid=grid, grid.col = 'lightgrey',labels=FALSE,do.tick=do.tick) - magcon(xtemp,ytemp,dobar=FALSE,doim=FALSE,add=TRUE,lty=c(2,1,3),xlim=xrange,ylim=yrange, h=c(diff(xrange),diff(yrange))/10, ...) - points(meanvec[i],meanvec[j],col='red',pch=4,cex=2) + ParmOff(magaxis, dots, side=1:2, grid=grid, grid.col='lightgrey', labels=FALSE, do.tick=do.tick, .pass_dots=FALSE) + ParmOff(magcon, dots, x=xtemp, y=ytemp, dobar=FALSE, doim=FALSE, add=TRUE, lty=c(2,1,3), xlim=xrange, ylim=yrange, h=c(diff(xrange),diff(yrange))/10, .pass_dots=FALSE) + ParmOff(points, dots, x=meanvec[i], y=meanvec[j], col='red', pch=4, cex=2, .pass_dots=FALSE) box() abline(v=meanvec[i],lty=1,col='red') abline(v=meanvec[i]-sdvec[i],lty=3,col='red') @@ -85,23 +87,23 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic } if(j==1){ if(is.null(lab)){ - magaxis(1,xlab=chaincolnames[i]) + ParmOff(magaxis, dots, side=1, xlab=chaincolnames[i], .pass_dots=FALSE) }else{ - magaxis(1,xlab=lab[[i]]) + ParmOff(magaxis, dots, side=1, xlab=lab[[i]], .pass_dots=FALSE) } } }else{ plot.new() plot.window(xlim=xrange,ylim=yrange) - magaxis(1:2,grid=grid, grid.col = 'lightgrey',labels=FALSE,do.tick=do.tick) - points(chains[usesamps,c(i,j)],pch='.',col='darkgrey') - points(meanvec[i],meanvec[j],col='red',pch=4,cex=2) + dots_carry = ParmOff(magaxis, dots, side=1:2, grid=grid, grid.col='lightgrey', labels=FALSE, do.tick=do.tick, .pass_dots=FALSE, .return='func_args')$args_out$ignore_args + ParmOff(points.default, dots_carry, x=chains[usesamps,i], y=chains[usesamps,j], pch='.', col='darkgrey', .pass_dots=TRUE) + ParmOff(points.default, dots_carry, x=meanvec[i], y=meanvec[j], col='red', pch=4, cex=2, .pass_dots=TRUE) box() if(i==1){ if(is.null(lab)){ - magaxis(2,ylab=chaincolnames[j]) + ParmOff(magaxis, dots, side=2, ylab=chaincolnames[j], .pass_dots=FALSE) }else{ - magaxis(2,ylab=lab[[j]]) + ParmOff(magaxis, dots, side=2, ylab=lab[[j]], .pass_dots=FALSE) } } } diff --git a/man/magaxis.Rd b/man/magaxis.Rd index b183b05..c2b29d8 100644 --- a/man/magaxis.Rd +++ b/man/magaxis.Rd @@ -129,7 +129,6 @@ magaxis(side=c(1,3),unlog=c(TRUE,FALSE)) plot(x,y,axes=FALSE,log='x') magaxis() - } % Add one or more standard keywords, see file 'KEYWORDS' in the diff --git a/man/magmap.Rd b/man/magmap.Rd index 6526a1e..a82a643 100644 --- a/man/magmap.Rd +++ b/man/magmap.Rd @@ -131,7 +131,6 @@ stretch='asinh')$map magplot(datastretch[,1],datastretch[,3],side=1) axis(2,asinhticks,labels=c(-10^(4:0),0,10^(0:4))) abline(h=magmap(0,lo=-1e4,hi=1e4,range=c(0,1),type='num',stretch='asinh')$map) - } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..802f1e8 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(magicaxis) + +test_check("magicaxis") diff --git a/tests/testthat/test-parmoff-routing.R b/tests/testthat/test-parmoff-routing.R new file mode 100644 index 0000000..f92546f --- /dev/null +++ b/tests/testthat/test-parmoff-routing.R @@ -0,0 +1,181 @@ +## Tests for ParmOff-based argument routing +## +## These tests verify that: +## 1. Extra `...` args are silently filtered by ParmOff (no "unused argument" errors). +## 2. The key sub-function routing changes work as expected: +## - magaxis accepts axis-styling args forwarded via ParmOff. +## - magplot + magmap/magbar/points dispatch works. +## - magtri routes dots to magaxis, magcon AND points. +## 3. Return values from the affected functions are unchanged. + +library(magicaxis) + +# ── Helpers ────────────────────────────────────────────────────────────────── + +options(rgl.useNULL = TRUE) + +# Render to a null device so no on-screen window is opened. +with_null_dev <- function(expr) { + pdf(nullfile()) + on.exit(dev.off()) + force(expr) +} + +# ── magaxis ─────────────────────────────────────────────────────────────────── + +test_that("magaxis forwards cex.axis and col.axis via ParmOff", { + with_null_dev({ + plot(1:10, 1:10, axes = FALSE) + expect_no_error(magaxis(side = 1:2, cex.axis = 0.8, col.axis = "blue")) + }) +}) + +test_that("magaxis does not error on unrecognized extra args (ParmOff filters them)", { + with_null_dev({ + plot(1:10, 1:10, axes = FALSE) + # 'bogus_arg' is not a formal of axis/mtext; ParmOff should silently drop it. + expect_no_error(magaxis(side = 1, bogus_arg = 99)) + }) +}) + +test_that("magaxis with xlab/ylab renders without error via ParmOff mtext call", { + with_null_dev({ + plot(1:5, 1:5, axes = FALSE) + expect_no_error(magaxis(side = 1:2, xlab = "X axis", ylab = "Y axis", + cex.lab = 1.2, col.lab = "darkred")) + }) +}) + +# ── magplot ─────────────────────────────────────────────────────────────────── + +test_that("magplot basic scatter returns invisibly without error", { + with_null_dev({ + result <- magplot(1:10, (1:10)^2, xlab = "x", ylab = "y^2") + expect_null(result) + }) +}) + +test_that("magplot with log x axis works via ParmOff axis dispatch", { + with_null_dev({ + expect_no_error(magplot(10^(1:6), 1:6, log = "x", xlab = "log x")) + }) +}) + +test_that("magplot with z column dispatches magmap and magbar without error", { + with_null_dev({ + set.seed(1) + x <- rnorm(50); y <- rnorm(50); z <- x^2 + y^2 + expect_no_error(magplot(x, y, z = z, dobar = TRUE)) + }) +}) + +test_that("magplot histogram dispatch via ParmOff works", { + with_null_dev({ + h <- maghist(rnorm(200), plot = FALSE, verbose = FALSE) + expect_no_error(magplot(h)) + }) +}) + +# ── magmap ──────────────────────────────────────────────────────────────────── + +test_that("magmap returns a list with map and datalim elements", { + result <- magmap(1:100) + expect_true(is.list(result)) + expect_true("map" %in% names(result)) + expect_true("datalim" %in% names(result)) +}) + +test_that("magmap stretch='log' works on positive data", { + result <- magmap(10^(0:4), stretch = "log") + expect_equal(length(result$map), 5) +}) + +# ── magbin ──────────────────────────────────────────────────────────────────── + +test_that("magbin returns a magbin object without error", { + set.seed(42) + xy <- cbind(rnorm(500), rnorm(500)) + result <- magbin(xy, plot = FALSE) + expect_s3_class(result, "magbin") +}) + +test_that("plot.magbin dispatches ParmOff calls without error", { + with_null_dev({ + set.seed(42) + xy <- cbind(rnorm(300), rnorm(300)) + b <- magbin(xy, plot = FALSE) + expect_no_error(plot(b)) + }) +}) + +# ── magimage ────────────────────────────────────────────────────────────────── + +test_that("magimage renders a matrix without error via ParmOff image call", { + with_null_dev({ + z <- matrix(1:100, 10, 10) + expect_no_error(magimage(z)) + }) +}) + +# ── magtri ──────────────────────────────────────────────────────────────────── + +test_that("magtri returns a matrix with mean and sd columns", { + with_null_dev({ + set.seed(7) + chains <- data.frame(a = rnorm(200), b = rnorm(200, mean = 5)) + result <- magtri(chains, samples = 100) + expect_true(is.matrix(result)) + expect_equal(colnames(result), c("mean", "sd")) + expect_equal(rownames(result), c("a", "b")) + }) +}) + +test_that("magtri accepts cex.axis forwarded to magaxis without error", { + with_null_dev({ + set.seed(8) + chains <- data.frame(a = rnorm(200), b = rnorm(200)) + expect_no_error(magtri(chains, samples = 100, cex.axis = 0.7)) + }) +}) + +test_that("magtri accepts lty forwarded to magcon without error", { + with_null_dev({ + set.seed(9) + chains <- data.frame(a = rnorm(200), b = rnorm(200)) + expect_no_error(magtri(chains, samples = 100, lty = c(1, 1, 1))) + }) +}) + +test_that("magtri accepts pch forwarded to points without error", { + with_null_dev({ + set.seed(10) + chains <- data.frame(x = rnorm(200), y = rnorm(200), z = rnorm(200)) + expect_no_error(magtri(chains, samples = 100, pch = 16)) + }) +}) + +test_that("magtri with refvals marks reference values without error", { + with_null_dev({ + set.seed(11) + chains <- data.frame(a = rnorm(200), b = rnorm(200)) + expect_no_error(magtri(chains, samples = 100, refvals = c(0, 0))) + }) +}) + +test_that("magtri with custom lab argument uses supplied labels", { + with_null_dev({ + set.seed(12) + chains <- data.frame(a = rnorm(200), b = rnorm(200)) + result <- magtri(chains, samples = 100, lab = list("Alpha", "Beta")) + expect_equal(nrow(result), 2) + }) +}) + +test_that("magtri with custom majorn", { + with_null_dev({ + set.seed(12) + chains <- data.frame(a = rnorm(200), b = rnorm(200), c = rnorm(200), d = rnorm(200)) + result <- magtri(chains, samples = 100, lab = list("Alpha", "Beta", 'Gamma', 'Delta'), majorn=2) + expect_equal(nrow(result), 4) + }) +}) diff --git a/vignettes/magicaxis.Rmd b/vignettes/magicaxis.Rmd new file mode 100644 index 0000000..04b104b --- /dev/null +++ b/vignettes/magicaxis.Rmd @@ -0,0 +1,276 @@ +--- +title: "magicaxis: Pretty Scientific Plotting" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{magicaxis: Pretty Scientific Plotting} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.width = 6, + fig.height = 6 +) +set.seed(42) +library(magicaxis) +``` + +## Overview + +**magicaxis** provides functions for making pretty, publication-quality +scientific plots with base R graphics. It handles minor tick marks, log-scale +axes, 2-D density contours, image display, hexagonal binning, and triangle +(corner) plots for MCMC chains. + +Since version 2.6.0, all internal argument dispatch uses +[ParmOff](https://github.com/asgr/ParmOff) instead of `do.call`. This lets +extra `...` arguments be forwarded flexibly to each sub-function: unrecognised +arguments are silently dropped, so callers no longer need to know exactly which +parameters each inner function accepts. + +--- + +## magaxis – pretty axis labelling + +`magaxis()` adds nicely formatted tick marks and labels to an existing plot. +It supports log axes, minor ticks, Hershey fonts, and grid lines. + +```{r magaxis-basic} +plot(10^(1:9), 1:9, log = "x", axes = FALSE, xlab = "", ylab = "") +magaxis(side = 1:2, xlab = "x (log scale)", ylab = "y") +``` + +Styling arguments such as `cex.axis` and `col.axis` are forwarded via ParmOff +to the underlying `axis()` call, while `cex.lab` and `col.lab` go to `mtext()`: + +```{r magaxis-styled} +plot(1:10, (1:10)^2, axes = FALSE, xlab = "", ylab = "") +magaxis(side = 1:2, + xlab = "x", ylab = expression(x^2), + cex.axis = 0.8, col.axis = "steelblue", + cex.lab = 1.1, col.lab = "darkred") +``` + +Grid lines can be toggled per axis: + +```{r magaxis-grid} +plot(1:20, rnorm(20), axes = FALSE, xlab = "", ylab = "") +magaxis(side = 1:2, grid = TRUE, grid.col = "grey80", grid.lty = 2, + xlab = "Index", ylab = "Value") +``` + +--- + +## magplot – high-level scatter plots + +`magplot()` wraps `plot()` to produce pretty axes automatically. For a simple +scatter the axis labelling, grid, and limits are handled internally: + +```{r magplot-scatter} +x <- 10^(1:9) +y <- 1:9 +magplot(log10(x), y, unlog = "x", xlab = "x", ylab = "y") +``` + +Log axes on both sides: + +```{r magplot-loglog} +magplot(x, y, log = "xy", xlab = "x", ylab = "y") +``` + +Sigma-clipping the axis limits to focus on where the data actually are: + +```{r magplot-clip} +temp <- cbind(rt(500, df = 1.5), rt(500, df = 1.5)) +magplot(temp, xlim = 2, ylim = 2, xlab = "x", ylab = "y", + main = "2-sigma clipped") +``` + +### z-coloured scatter + +When a `z` vector is supplied, points are coloured by a colour map and an +optional colour bar is added. The `magmap` and `magbar` arguments are filtered +via ParmOff, so unknown args are dropped cleanly: + +```{r magplot-z} +n <- 300 +x <- rnorm(n); y <- rnorm(n); z <- x^2 + y^2 +magplot(x, y, z = z, xlab = "x", ylab = "y", + zcol = hcl.colors(21, "YlOrRd"), dobar = TRUE) +``` + +--- + +## maghist – histogram with statistics + +`maghist()` prints a summary and draws a styled histogram. It integrates +naturally with `magplot()` because it returns a `histogram` object that +`magplot()` detects: + +```{r maghist-basic} +maghist(rnorm(1000), xlab = "Value", verbose = FALSE) +``` + +Log-y histogram: + +```{r maghist-logy} +maghist(rnorm(1e4), log = "y", grid = TRUE, verbose = FALSE, + xlab = "Value", ylab = "Count (log)") +``` + +Pass the returned object back through `magplot()`: + +```{r maghist-replot} +h <- maghist(10^runif(500, 0, 3), log = "x", verbose = FALSE) +magplot(h, log = "y", xlab = "x (log)", ylab = "Count (log)") +``` + +--- + +## magcon – 2-D density contours + +`magcon()` computes a 2-D kernel density estimate and draws contours at chosen +probability levels (default 50%, 68%, 95%) together with an optional image +and colour bar. + +```{r magcon-basic} +x <- rnorm(500); y <- x + rnorm(500, sd = 0.5) +magcon(x, y, h = c(0.2, 0.2), xlab = "x", ylab = "y", barposition = 'topleft', + bartitleshift = 0.5) +``` + +Contours only (no background image): + +```{r magcon-noim} +magcon(x, y, h = c(0.2, 0.2), doim = FALSE, dobar = FALSE, + xlab = "x", ylab = "y") +``` + +--- + +## magbin – 2-D binning + +`magbin()` bins 2-D data into hexagons, squares, or triangles and colours them +by count or a user-supplied statistic: + +```{r magbin-hex} +xy <- cbind(rnorm(2000), rnorm(2000)) +magbin(xy, shape = "hexagon", xlab = "x", ylab = "y") +``` + +Square bins with a z-statistic: + +```{r magbin-square-z} +magbin(xy, shape = "square", + z = xy[, 1]^2 - xy[, 2]^2, + colref = "zstat", sizeref = "count", + xlab = "x", ylab = "y") +``` + +Log-log hexagonal bins: + +```{r magbin-loglog} +xylog <- cbind(10^rnorm(2000), 10^rnorm(2000)) +magbin(xylog, log = "xy", xlab = "x (log)", ylab = "y (log)") +``` + +--- + +## magimage – image display + +`magimage()` displays a matrix as an image with a colour map applied via +`magmap()` and optional axes via `magaxis()`. The internal `image()` call is +dispatched through ParmOff: + +```{r magimage-basic} +z <- outer(seq(-3, 3, len = 50), seq(-3, 3, len = 50), + function(x, y) exp(-(x^2 + y^2))) +magimage(z, xlab = "x", ylab = "y") +``` + +Asinh stretch to reveal faint structure (the default `stretch = "asinh"` is +well suited to images with a wide dynamic range): + +```{r magimage-stretch} +z2 <- outer(seq(-3, 3, len = 50), seq(-3, 3, len = 50), + function(x, y) exp(-x^2) + 0.05 * exp(-y^2 / 0.1)) +magimage(z2, stretch = "asinh", xlab = "x", ylab = "y") +``` + +--- + +## magtri – triangle (corner) plots for MCMC chains + +`magtri()` makes a triangle plot summarising posterior samples. The diagonal +shows marginal densities, the lower triangle shows 2-D density contours +(`magcon`), and the upper triangle shows scatter plots. + +### Basic triangle plot + +```{r magtri-basic} +chains <- data.frame( + alpha = rnorm(500, mean = 1, sd = 0.3), + beta = rnorm(500, mean = -0.5, sd = 0.5), + gamma = rnorm(500, mean = 2, sd = 0.8) +) +magtri(chains, samples = 300) +``` + +### Passing extra arguments via ParmOff + +Extra `...` arguments are now forwarded by ParmOff to `magaxis`, `magcon`, +**and** `points`, so you can style each sub-function from the top-level call. +Unrecognised arguments in one sub-function are silently dropped and not +recycled, so there is no risk of "unused argument" errors: + +```{r magtri-styled} +# cex.axis → magaxis (tick-label size) +# lty → magcon (overrides contour line types) +# col → points (overrides the red mean-marker colour) +magtri(chains, + samples = 300, + cex.axis = 0.7, + lty = c(2, 1, 3), + col = "purple") +``` + +### Reference values + +Supply `refvals` to mark known true (or reference) parameter values with a +blue vertical line: + +```{r magtri-refvals} +magtri(chains, + samples = 300, + refvals = c(1, -0.5, 2)) +``` + +### Few labels per sub-panel + +Supply `majorn` to reduce the number of labelled ticks. + +```{r magtri-majorn} +magtri(chains, + samples = 300, + refvals = c(1, -0.5, 2), + majorn = 2) +``` + +### Custom axis labels + +Use the `lab` argument to supply expression labels for each parameter: + +```{r magtri-labs} +magtri(chains, + samples = 300, + lab = list( + expression(alpha), + expression(beta), + expression(gamma) + )) +```