playwith.API {playwith} | R Documentation |
The playwith
Application Programming Interface.
A playwith
tool is a function ("constructor") that creates
a graphical-user-interface widget (a gtkToolItem
).
That widget may also have functions attached to it, which are run in
response to user interaction, or every time the plot is drawn.
Constructors should use the
convenience function quickTool
where possible.
If the constructor function returns NA
, that tool is skipped.
So one should check whether the tool can work with the current plot,
and skip it otherwise.
Following is a table of the API functions that can be used by tools.
See the links to specific help pages for details.
In case these are inadequate, you may work with the playState
object
itself.
playDevCur() playDevList() playDevSet(playState) playDevOff(playState = playDevCur()) playNewPlot(playState) playReplot(playState) callArg(playState, arg, name = NULL) callArg(playState, arg, name = NULL) <- value playDo(playState, expr, space = "plot", clip.off = FALSE) xyCoords(playState, space = "plot") xyData(playState, space = "plot") playSelectData(playState, prompt) playPointInput(playState, prompt) playLineInput(playState, prompt) playRectInput(playState, prompt, scales = c("x", "y")) rawXLim(playState, space = "plot") rawYLim(playState, space = "plot") rawXLim(playState) <- value rawYLim(playState) <- value spaceCoordsToDataCoords(playState, xy) dataCoordsToSpaceCoords(playState, xy) whichSpace(playState, x.device, y.device) deviceCoordsToSpace(playState, x.device, y.device, space = "plot") playPrompt(playState, text = NULL) playFreezeGUI(playState) playThawGUI(playState) blockRedraws(expr, playState = playDevCur())
Felix Andrews felix@nfrac.org
if (interactive()) { ## 1. A toggle button to draw "Hello world" text. ## constructor function helloTool <- function(playState) { quickTool(playState, label = "Greeting", icon = "gtk-yes", tooltip = "Draw 'Hello world' text", f = hello_handler, post.plot.action = hello_postplot_action, isToggle = TRUE) } ## this is called when the button is clicked hello_handler <- function(widget, playState) { ## need to re-draw plot to remove label if (!widget["active"]) { playReplot(playState) return() } hello_postplot_action(widget, playState) } ## this is called after the plot is drawn (or re-drawn) hello_postplot_action <- function(widget, playState) { ## do nothing if the toggle button is off if (!widget["active"]) return() ## draw text centered on the page grid.text("Hello world", gp=gpar(cex=2)) } ## add new button to a plot window (the bottom toolbar) playwith(plot(1:10), bottom=list(helloTool)) ## 2. Select subset of data and show marginal histograms. ## It stores state info in the local environment. ## constructor function subsetTool <- function(playState) { ## set up a list to store state playState$subsetTool <- list() quickTool(playState, label = "Data subset", icon = "gtk-justify-fill", tooltip = "Select a subset of data points for stats", f = subset_handler, post.plot.action = subset_postplot_action) } ## this is called when the button is clicked subset_handler <- function(widget, playState) { foo <- playSelectData(playState) if (is.null(foo)) return() nSubsets <- length(playState$subsetTool) playState$subsetTool[[nSubsets+1]] <- foo drawSubsetBox(playState, foo) } ## draw one subset box with marginal histograms drawSubsetBox <- function(playState, foo) { xy <- xyCoords(playState, space=foo$space) playDo(playState, with(foo, { xc <- mean(coords$x) yc <- mean(coords$y) wd <- abs(diff(coords$x)) ht <- abs(diff(coords$y)) pushViewport(viewport(default.units="native", x=xc, y=yc, width=wd, height=ht, xscale=range(coords$x), yscale=range(coords$y), gp=gpar(alpha=0.3), clip="off")) grid.rect(gp=gpar(fill="yellow")) ## draw sample size text grid.text(paste("n=", length(x), sep=""), x=unit(0.98, "npc"), y=unit(0.98, "npc"), just=c("right", "top"), gp=gpar(cex=1.5)) ## histogram of x values, outside x-axis h <- hist(x, plot=FALSE) hval <- unit(4 * h$counts / length(x), "cm") grid.rect(x=h$breaks[-1], y=unit(0, "npc"), height=hval, width=diff(h$breaks), just=c("right", "top"), default.units="native", gp=gpar(fill="purple")) ## histogram of y values, outside y-axis h <- hist(y, plot=FALSE) hval <- unit(4 * h$counts / length(x), "cm") grid.rect(y=h$breaks[-1], x=unit(0, "npc"), height=diff(h$breaks), width=hval, just=c("right", "top"), default.units="native", gp=gpar(fill="purple")) popViewport() }), space=foo$space) } ## this is called after the plot is drawn (or re-drawn) subset_postplot_action <- function(widget, playState) { for (foo in playState$subsetTool) drawSubsetBox(playState, foo) } ## add new button to a plot window (the bottom toolbar) playwith(xyplot(temperature ~ radiation, environmental), bottom=list(subsetTool)) ## 3. A button to interactively add or remove data points. ## constructor function, with handler in-line addTool <- function(playState) { quickTool(playState, label = "Add points", icon = "gtk-add", tooltip = "Add data points by clicking", f = function(widget, playState) repeat { foo <- playSelectData(playState, prompt=paste( "Click to add a point.", "Shift-click to delete.", "Right-click to stop.")) if (is.null(foo)) return() xy <- xyData(playState) if (foo$modifiers & GdkModifierType["shift-mask"]) { ## shift-click: delete data points xy$x[foo$which] <- NA xy$y[foo$which] <- NA } else { ## add data point at click location xy$x <- c(xy$x, foo$coords$x[1]) xy$y <- c(xy$y, foo$coords$y[1]) } ## store in local environment playState$env$localxy <- xy if (playState$is.lattice) { ## lattice plot: use `data` argument callArg(playState, 1) <- quote(y ~ x) callArg(playState, data) <- quote(localxy) } else { ## otherwise set first argument to plot callArg(playState, 1) <- quote(localxy) callArg(playState, y) <- NULL } playReplot(playState) }) } ydata <- c(1:4, 2:1, 5:8) playwith(xyplot(ydata ~ 1:10, type=c("p", "smooth"), pch=8), left=list(addTool)) ## 4. A more complex toolbar item: a "spinbutton" to ## group the data into `n` clusters (in plot or xyplot). ## constructor function clusterTool <- function(playState) { spinner <- gtkSpinButton(min=1, max=10, step=1) spinner["value"] <- 1 gSignalConnect(spinner, "value-changed", cluster_handler, data=playState) vbox <- gtkVBox() vbox$packStart(gtkLabel("Clusters:")) vbox$packStart(spinner) foo <- gtkToolItem() foo$add(vbox) foo } ## this is called when the spinner value changes cluster_handler <- function(widget, playState) { n <- widget["value"] xy <- xyCoords(playState) groups <- NULL if (n > 1) { clusts <- kmeans(cbind(xy$x,xy$y), n) labels <- paste("#", 1:n, " (n = ", clusts$size, ")", sep="") groups <- factor(clusts$cluster, labels=labels) } ## avoid a big vector inline in the call, store in local env if (playState$is.lattice) { playState$env$auto.groups <- groups callArg(playState, groups) <- quote(auto.groups) } else { playState$env$auto.groups <- unclass(groups) callArg(playState, col) <- quote(auto.groups) if (is.null(groups)) callArg(playState, col) <- NULL } playReplot(playState) } ## need to generate random data outside the plot call! xdata <- rnorm(100) ydata <- rnorm(100) * xdata / 2 ## works with lattice::xyplot playwith(xyplot(ydata ~ xdata, aspect="iso", auto.key=list(space="right")), left=list(clusterTool)) ## same tool works with graphics::plot playwith(plot(ydata ~ xdata), left=list(clusterTool)) }