playwith.API {playwith}R Documentation

The playwith API

Description

The playwith Application Programming Interface.

Details

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())

Author(s)

Felix Andrews felix@nfrac.org

See Also

playwith

Examples

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))

}

[Package playwith version 0.8.51 Index]