Fix magmap rank bug, magbin typo, plot.magbin speed; add tests and vignette sections

R/magband.R

@@ -75,18 +75,6 @@
   return = temp
 }
 
-".Last.magroj"<-
-  local({
-    val <- list(
-      projection = "", 
-      parameters = NULL, 
-      orientation = NULL,
-      centre = NULL,
-      longlim = NULL,
-      latlim = NULL
-    )
-    function(new) if(!missing(new)) val <<- new else val
-  })
 
 magband=function(crosseq = 0, peaklat = 0, width=10, res=1000, ...){
   longlo=.Last.magproj()$longlim[1]

R/magbin.R

@@ -223,7 +223,7 @@
   tempambig = output$nn.idx[distorder]
   remdupe = duplicated(tempambig, incomparables=NA)
   output$nn.idx[distorder][remdupe] = NA
-  output$output$nn.dists[distorder][remdupe] = NA
+  output$nn.dists[distorder][remdupe] = NA
 
   # if(exactcount){
   #   if(shape=='hex' | shape=='hexagon'){
@@ -356,30 +356,21 @@ plot.magbin = function(x, colramp=hcl.colors(21), colstretch='lin', sizestretch=
       ParmOff(magplot, c(list(NA, NA, xlim=xlim, ylim=ylim), dots))
     }
   }
-  #magplot(NA, NA, xlim=x$xlim, ylim=x$ylim, ...)
-  for(i in 1:dim(x$bins)[1]){
-    if(!is.na(colmap$map[i])){
-      if(is.na(x$dustlim)){
-        if(x$shape=='hex' | x$shape=='hexagon'){
-          .drawhex(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, direction=x$direction)
-        }
-        if(x$shape=='sq' | x$shape=='square'){
-          .drawsquare(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA)
-        }
-        if(x$shape=='tri' | x$shape=='triangle' | x$shape=='trihex'){
-          .drawtriangle(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, type=x$bins[i,'type'], direction=x$direction)
-        }
-      }else if(x$bins[i,'count'] > x$dustlim){
-        if(x$shape=='hex' | x$shape=='hexagon'){
-          .drawhex(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, direction=x$direction)
-        }
-        if(x$shape=='sq' | x$shape=='square'){
-          .drawsquare(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA)
-        }
-        if(x$shape=='tri' | x$shape=='triangle' | x$shape=='trihex'){
-          .drawtriangle(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, type=x$bins[i,'type'], direction=x$direction)
-        }
-      }
+  # Determine the drawing function once outside the loop (shape is constant).
+  # After the dustlim filter above, all remaining bins already satisfy count > dustlim,
+  # so we only need to skip bins where the colour map produced NA.
+  draw_bins <- which(!is.na(colmap$map))
+  if(x$shape == 'hex' | x$shape == 'hexagon'){
+    for(i in draw_bins){
+      .drawhex(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, direction=x$direction)
+    }
+  }else if(x$shape == 'sq' | x$shape == 'square'){
+    for(i in draw_bins){
+      .drawsquare(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA)
+    }
+  }else if(x$shape == 'tri' | x$shape == 'triangle' | x$shape == 'trihex'){
+    for(i in draw_bins){
+      .drawtriangle(x$bins[i,'x'], x$bins[i,'y'], unitcell=x$step*sizemap[i], col=colramp[colmap$map[i]], border=NA, type=x$bins[i,'type'], direction=x$direction)
     }
   }
   if(!is.null(x$dust)){

R/magcon.R

@@ -1,5 +1,7 @@
-magcon <-
-function(x,y,h,doim=TRUE,docon=TRUE,dobar=TRUE,ngrid=100,add=FALSE,xlab='',ylab='',imcol=c(NA,rev(rainbow(1000,start=0,end=2/3))),conlevels=c(0.5,pnorm(1)-pnorm(-1),0.95), barposition='topright', barorient='v',bartitle='Contained %',bartitleshift=0,xlim=NULL,ylim=NULL,weights=NULL,...){
+magcon = function(x,y,h,doim=TRUE,docon=TRUE,dobar=TRUE,ngrid=100,add=FALSE,xlab='',ylab='',
+         imcol=c(NA,hcl.colors(100)), conlevels=c(0.5,pnorm(1)-pnorm(-1),0.95), 
+         barposition='topright', barorient='v',bartitle='Contained %',bartitleshift=0,
+         xlim=NULL,ylim=NULL,weights=NULL,...){
   if(missing(y)){
     if(!is.null(dim(x))){
       if(dim(x)[2]>=2){y=x[,2];x=x[,1]}
@@ -26,14 +28,14 @@ function(x,y,h,doim=TRUE,docon=TRUE,dobar=TRUE,ngrid=100,add=FALSE,xlab='',ylab=
   tempcon=sm.density(cbind(x,y),h=h,weights=weights,display='none',ngrid=ngrid,xlim=xlim+c(-diff(xlim),diff(xlim)),ylim=ylim+c(-diff(ylim),diff(ylim)),verbose=FALSE)
   tempcon$x=tempcon$eval.points[,1]
   tempcon$y=tempcon$eval.points[,2]
-  tempcon$z=tempcon$estimate
+  tempcon$z=tempcon$estimate / sum(tempcon$estimate, na.rm=TRUE)
 
   #}
   temp=sort(tempcon$z)
   tempsum=cumsum(temp)
-  convfunc=approxfun(tempsum,temp)
-  levelmap=approxfun(convfunc(seq(0,1,len=1000)*max(tempsum)),seq(0,1,len=1000))
-  tempcon$z=matrix(levelmap(tempcon$z),nrow=ngrid)
+  convfunc=approxfun(temp, tempsum)
+  #levelmap=approxfun(convfunc(seq(0,1,len=1000)),seq(0,1,len=1000))
+  tempcon$z=matrix(convfunc(tempcon$z),nrow=ngrid)
   tempcon$z[is.na(tempcon$z)]=min(tempcon$z,na.rm=TRUE)
   if(doim){
     if(add==FALSE){

R/magmap.R

@@ -50,7 +50,7 @@ magmap = function( data,
     } else if (type == 'rank') {
       locut = 1
       hicut = length(data[good])
-      data[good][order(data[good])] = locut:hicut
+      data[good] <- rank(data[good], ties.method = 'average')
     } else{
       stop(type, ' is not a valid type option!')
     }

R/magtri.R

@@ -1,4 +1,4 @@
-magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tick=FALSE, refvals=NULL, lab=NULL, ...){
+magtri = function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tick=FALSE, refvals=NULL, lab=NULL, draw.sig=FALSE, ...){
   chains=as.data.frame(chains)
   chaincolnames=colnames(chains)
   Nsamp=dim(chains)[1]
@@ -71,17 +71,22 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic
         if(i>j){
           plot.new()
           plot.window(xlim=xrange,ylim=yrange)
-          xtemp=chains[usesamps,i]
-          ytemp=chains[usesamps,j]
+          xtemp = chains[usesamps,i]
+          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)}
           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)
+          ParmOff(magcon, dots, x=xtemp, y=ytemp, dobar=FALSE, doim=FALSE, add=TRUE, lty=c(2,1,3), xlim=xrange, ylim=yrange, h=c(sdvec[i], sdvec[j])/5, .pass_dots=TRUE, .clash='last')
+          ParmOff(points.default, dots, x=meanvec[i], y=meanvec[j], col='red', pch=4, cex=2, .pass_dots=TRUE, .clash = 'last')
           box()
-          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')
+          if(draw.sig){
+            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')
+            abline(h=meanvec[j],lty=1,col='darkgreen')
+            abline(h=meanvec[j]-sdvec[j],lty=3,col='darkgreen')
+            abline(h=meanvec[j]+sdvec[j],lty=3,col='darkgreen')
+          }
           if(!is.null(refvals)){
             abline(v=refvals[i],lty=1, col='blue')
           }
@@ -99,6 +104,14 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic
           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(draw.sig){
+            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')
+            abline(h=meanvec[j],lty=1,col='darkgreen')
+            abline(h=meanvec[j]-sdvec[j],lty=3,col='darkgreen')
+            abline(h=meanvec[j]+sdvec[j],lty=3,col='darkgreen')
+          }
           if(i==1){
             if(is.null(lab)){
               ParmOff(magaxis, dots, side=2, ylab=chaincolnames[j], .pass_dots=FALSE)
@@ -114,3 +127,5 @@ magtri=function(chains, samples=1000, thin=1, samptype='end', grid=FALSE, do.tic
   rownames(output)=chaincolnames
   return(invisible(output))
 }
+
+magcorner = magtri

man/magclip.Rd

@@ -5,7 +5,7 @@
 Magical sigma clipping
 }
 \description{
-This function does intelligent autoamtic sigma-clipping of data. This is optionally used by \code{\link{magplot}} and \code{\link{maghist}}.
+This function does intelligent automatic sigma-clipping of data. This is optionally used by \code{\link{magplot}} and \code{\link{maghist}}.
 }
 \usage{
 magclip(x, sigma = 'auto', clipiters = 5, sigmasel = 1, estimate = 'both', extra = TRUE)
@@ -19,7 +19,7 @@ Numeric; the values to be clipped. This can reasonably be a vector, a matrix or
 The level of sigma clipping to be done. If set to default of 'auto' it will dynamically choose a sigma level to cut at based on the length of x (or the clipped version once iterations have started), i.e.: sigma=qnorm(1-2/length(x)). This have the effect of removing unlikely values based on the chance of them occurring, i.e. there is roughly a 50\% chance of a 3.5 / 4.6 sigma Normal fluctuation occurring when you have 10,000 / 10,000,000 values, hence choosing this value dynamically is usually the best option.
 }
   \item{clipiters}{
-The maximum number of sigma clipping iterations to attempt. It will break out sooner than this if the iterations have converged. The default of 5 is usually plenty (up to the contamination being towards the 50\% level). The number of actual iterations is returns as \option{clipiters}.
+The maximum number of sigma clipping iterations to attempt. It will break out sooner than this if the iterations have converged. The default of 5 is usually plenty (up to the contamination being towards the 50\% level). The number of actual iterations is returned as \option{clipiters}.
 }
   \item{sigmasel}{
 The quantile to use when trying to estimate the true standard-deviation of the Normal distribution. if contamination is low then the default of 1 is about optimal in terms of S/N, but you might need to make the value lower when contamination is very high.
@@ -28,17 +28,17 @@ The quantile to use when trying to estimate the true standard-deviation of the N
 Character; determines which side/s of the distribution are used to estimate Normal properties. The default is to use both sides (both) giving better S/N, but if you know that your contamination only comes from positive flux sources (e.g., astronomical data when trying to select sky pixels) then you should only use the lower side to determine Normal statistics (lo). Similarly if the contamination is on the low side then you should use the higher side to determine Normal statistics (hi).
 }
   \item{extra}{
-Logical; if TRUE then \option{clip} and \option{range} are computed and returns, else these are set to NA to reduce computation and memory.  
+Logical; if TRUE then \option{clip} and \option{range} are computed and returned, else these are set to NA to reduce computation and memory.  
 }
 }
 \details{
-If you know more sepcific details about your data then you should probably carry out a thorough likelihood analysis, but the ad-hoc clipping done in \code{magclip} works pretty well in practice.
+If you know more specific details about your data then you should probably carry out a thorough likelihood analysis, but the ad-hoc clipping done in \code{magclip} works pretty well in practice.
 }
 \value{
 A list containing three items:
 
-\item{x}{Numeric vector; the cliped \option{x} values.}
-\item{clip}{Locial; logic of which values were clipped with the same type and shape attributes as the input \option{x} (i.e. if the original \option{x} was a matrix then \option{clip} would also be a matrix that matches element to element).}
+\item{x}{Numeric vector; the clipped \option{x} values.}
+\item{clip}{Logical; logic of which values were clipped with the same type and shape attributes as the input \option{x} (i.e. if the original \option{x} was a matrix then \option{clip} would also be a matrix that matches element to element).}
 \item{range}{The data range of clipped \option{x} values returned.}
 \item{clipiters}{The number of iterations made, which might be less than the input \option{clipiters} since it might converge faster.}
 }

man/magcon.Rd

@@ -9,7 +9,7 @@ This function generates pretty images and contours that reflect the 2D quantile
 }
 \usage{
 magcon(x, y, h, doim = TRUE, docon = TRUE, dobar = TRUE, ngrid = 100, add = FALSE,
-  xlab = '', ylab = '', imcol = c(NA,rev(rainbow(1000, start = 0, end = 2/3))),
+  xlab = '', ylab = '', imcol = c(NA, hcl.colors(100)),
   conlevels = c(0.5, pnorm(1) - pnorm(-1), 0.95), barposition = "topright",
   barorient = "v",bartitle = "Contained \%", bartitleshift = 0, xlim = NULL, ylim = NULL,
   weights = NULL,...)

man/magmap.Rd

@@ -5,7 +5,7 @@
 Value remapper
 }
 \description{
-This function allows the use to remap a vector of values onto a different system. For instance you might have values stretching from -10 to 100 which you want mapped from 0 to 2/3 so you can then sue the output as an input for point colour or size. It allows clipping of values, rejection of bad values, and log stretching.
+This function allows the use to remap a vector of values onto a different system. For instance you might have values stretching from -10 to 100 which you want mapped from 0 to 2/3 so you can then use the output as an input for point colour or size. It allows clipping of values, rejection of bad values, and log stretching.
 }
 \usage{
 magmap(data, locut = 0, hicut = 1, flip = FALSE, range = c(0, 2/3), type = "quan",

man/magrun.Rd

@@ -71,10 +71,10 @@ The standard deviations in the x bins. This is a two column data.frame if 'diff'
   \item{ysd}{
 The standard deviations in the y bins. This is a two column data.frame if 'diff' is set to FALSE, giving the y-sd and y+sd values, or a single vector if 'diff' is set to TRUE. If Nscale is set to TRUE then this is also divided by sqrt the contributing objects in each bin.
 }
-  \item{bincen}{
+  \item{bincens}{
 The bin centres used in the chosen binning direction.
 }
-  \item{binlim}{
+  \item{binlims}{
 The bin limits used in the chosen binning direction.
 }
   \item{Nbins}{

man/magtri.Rd

@@ -1,15 +1,18 @@
 \name{magtri}
 \alias{magtri}
+\alias{magcorner}
 %- Also NEED an '\alias' for EACH other topic documented here.
 \title{
-High level triangle plotting code for MCMC chains
+High level triangle (corner) plotting code for MCMC chains
 }
 \description{
-A very high level (minimal options) MCMC chain triangle (AKA corner) plot function. The default is deliberately spartan in terms of options, but the result should be a clear set of covariance plots that should give quick insight into the stationary sampling quality of a set of MCMC posterior chains.
+A very high level (minimal options) MCMC chain triangle (AKA corner) plot function. The default is deliberately spartan in terms of options, but the result should be a clear set of covariance plots that should give quick insight into the stationary sampling quality of a set of MCMC posterior chains. \code{magcorner} is just an alias to \code{magtri}, since these days such plots are more commonly called 'corner' plots, especially in Python-world.
 }
 \usage{
-magtri(chains, samples = 1000, thin = 1, samptype = 'end', grid = FALSE, do.tick = FALSE,
-refvals = NULL, lab = NULL, ...)
+magtri(chains, samples = 1000, thin = 1, samptype = 'end', grid = FALSE,
+  do.tick = FALSE, refvals = NULL, lab = NULL, draw.sig = FALSE, ...)
+magcorner(chains, samples = 1000, thin = 1, samptype = 'end', grid = FALSE,
+  do.tick = FALSE, refvals = NULL, lab = NULL, draw.sig = FALSE, ...)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -36,19 +39,22 @@ Numeric vector; this gives reference values to overdraw. If provided it must be
 }
   \item{lab}{
 Character vector; optional over-ride for column names when plotting the grid of scatter plots.  
+}
+  \item{draw.sig}{
+Logical; should vertical and horizontal sigma regions be overlaid on the scatter and contour panels.  
 }
   \item{\dots}{
 Extra arguments are passed to \option{\link{magcon}} for plotting.  
 }
 }
 \details{
-    This interface is deliberately very high level with few options. It is really designed to allow quick exploratory views of posterior samples from MCMC chains, and publication grade plots should be designed by the user. That said, in many situations the plots generated are of pleasant, clear and publishable quality.
+This interface is deliberately very high level with few options. It is really designed to allow quick exploratory views of posterior samples from MCMC chains, and publication grade plots should be designed by the user. That said, in many situations the plots generated are of pleasant, clear and publishable quality.
 
-    Other types of data can be plotted using this function of course, but the default setup is tuned towards being useful for MCMC posterior chain samples.
+Other types of data can be plotted using this function of course, but the default setup is tuned towards being useful for MCMC posterior chain samples.
 
-    The contour levels shown are the defaults for magcon, i.e. they contain 50\% (lty=2), 68\% (lty=1) and 95\% (lty=3) of the posterior chains.
+The contour levels shown are the defaults for magcon, i.e. they contain 50\% (lty=2), 68\% (lty=1) and 95\% (lty=3) of the posterior chains.
 
-    The red cross shows the mean for the sampled posterior chain. The red vertical dashed line traces this over the contour plots. The red dotted line shows the +/- SD range of the sampled posterior chain.
+The red cross shows the mean for the sampled posterior chain. The red vertical dashed line traces this over the contour plots. The red dotted line shows the +/- SD range of the sampled posterior chain.
 }
 \value{
   Outputs a two column matrix containing the means and standard deviations fo the parameters. Generally run for the side effect of producing nice projected plots.