### specplot.R: Use the rpanel package to interactively plot spectra. ### $Id: specplot.R,v 1.2 2007/07/30 09:14:39 bhm Exp $ ### Copyright © 2007 Bjørn-Helge Mevik ### This program is free software; you can redistribute it and/or modify ### it under the terms of the GNU General Public License version 2 as ### published by the Free Software Foundation. ### ### This program is distributed in the hope that it will be useful, ### but WITHOUT ANY WARRANTY; without even the implied warranty of ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ### GNU General Public License for more details. ### A copy of the GPL text is available here: ### http://www.gnu.org/licenses/gpl-2.0.txt ### Contact info: ### Bjørn-Helge Mevik ### bhx6@mevik.net ### Rødtvetvien 20 ### N-0955 Oslo ### Norway specplot <- function() { ## Make sure the package is loaded if (!require(rpanel)) stop("Could not load required package 'rpanel'") ## Start a new device, if needed: if(dev.cur() == 1) get(getOption("device"))() ## Save the device number: device <- dev.cur() ## Build a call to matplot() plotcall <- match.call() plotcall[[1]] <- as.name("matplot") if (missing(type)) plotcall$type <- "l" plotcall$reverse <- plotcall$plot.add <- NULL ## Protect plot.add from extra evaluations: plot.add <- substitute(plot.add) ## Set up range if (missing(y) || is.null(y)) ## No good: rx <- xy.coords(x)$x x <- 1:NROW(x) rx <- range(x) p <- length(x) minwidth <- 2 * diff(rx) / (p - 1) if (missing(reverse)) reverse <- x[1] > x[p] ## The callback function: replot <- function(panel) { ## Add a modified xlim argument to the matplot call: halfwidth <- max(panel$width, minwidth) / 2 # rpanel isn't perfect! if (reverse) xlim <- 2*mean(rx) - panel$center + c(halfwidth, -halfwidth) else xlim <- panel$center + c(-halfwidth, halfwidth) plotcall$xlim <- xlim ## Save the current device: dev.save <- dev.cur() ## Switch to the original device: dev.set(device) ## Do the plot eval(plotcall) ## Do any addons: eval(plot.add) ## Switch back to the current device: dev.set(dev.save) ## Return the panel panel } panel <- rp.control("specplot", center = mean(rx), width = diff(rx)) rp.slider(panel, center, min(x), max(x), replot) rp.slider(panel, width, minwidth, diff(rx), replot) } ## Create and add a list of formals: fm <- formals(matplot) # Use matplot's formals as a start fm$type <- "l" # Change default fm$xlim <- NULL # Remove argument fm <- c(fm, list(reverse = FALSE, plot.add = NULL)) # Add arguments formals(specplot) <- fm