[R] Make playwith a default graphic device

[Deepayan Sarkar]

On 10/15/07, Felix Andrews <felix at nfrac.org> wrote:
> My previous suggestion was inconsistent with the Trellis/Lattice idea
> of creating a trellis object without necessarily creating a plot. And
> it also interfered with attempts to plot to a file device. So here is
> a better solution, based on replacing `print.trellis`, though it is
> still basically a hack.
>
> library(lattice)
> library(plotAndPlayGTK)
>
> setAutoPlaywith <- function(on=TRUE) {
>         if (on == FALSE) {
>                 return(rm(print.trellis, envir=.GlobalEnv))
>         }
>         assign("print.trellis",
>         function(x, position = NULL, split = NULL, more = FALSE, newpage = TRUE,
>                 packet.panel = packet.panel.default, draw.in = NULL, ...)
>         {
>                 dev.interactive2 <- function(orNone) dev.interactive(orNone) ||
>                         (interactive() && .Device == "null device" &&
>                         getOption("device") == "Cairo")
>                 playing <- 'plotAndPlayUpdate' %in% sapply(sys.calls(), function(x)
>                         ifelse(is.symbol(x[[1]]), toString(x[[1]]), ""))
>                 new <- newpage && is.null(draw.in) &&
>                         !lattice:::lattice.getStatus("print.more")
>                 if (require(plotAndPlayGTK, quietly=TRUE) &&
>                         dev.interactive2(TRUE) && !playing && new) {
>                         # starting a new plot on an interactive device
>                         eval.parent(call("playwith", x$call), n=2)
>                         return(invisible())
>                 }
>                 # call the real `print.trellis`, from lattice package
>                 ocall <- sys.call()
>                 ocall[[1]] <- quote(lattice:::print.trellis)
>                 eval.parent(ocall)
>         }, envir=.GlobalEnv)
>         invisible()
> }
>
> setAutoPlaywith(TRUE)
> xyplot(Sepal.Length ~ Sepal.Width | Species, data=iris)
> setAutoPlaywith(FALSE)
> xyplot(Sepal.Length ~ Sepal.Width | Species, data=iris)
>
> Deepayan, what do you think -- would it be appropriate to make a
> Lattice option for something like this?

In the next update (today or tomorrow), I'll have print.trellis changed to

print.trellis <- function(x, ...)
{
    printFunction <- lattice.getOption("print.function")
    if (is.null(printFunction)) printFunction <- plot.trellis
    printFunction(x, ...)
    invisible(x)
}

With this, you could do:

> lattice.options(print.function = function(x, ...) print(summary(x, ...)))
> xyplot(Sepal.Length ~ Sepal.Width | Species, data=iris)

Call:
xyplot(Sepal.Length ~ Sepal.Width | Species, data = iris)

Number of observations:
Species
    setosa versicolor  virginica
        50         50         50

and plotAndPlayGTK could have:


plotAndPlayGTK.trellis <-
    function(x, position = NULL, split = NULL, more = FALSE, newpage = TRUE,
             packet.panel = packet.panel.default, draw.in = NULL, ...)
{
    dev.interactive2 <- function(orNone)
    {
        dev.interactive(orNone) ||
        (interactive() && .Device == "null device" &&
         getOption("device") == "Cairo")
    }
    playing <-
        'plotAndPlayUpdate' %in% sapply(sys.calls(),
                                        function(x)
                                        ifelse(is.symbol(x[[1]]),
                                               toString(x[[1]]), ""))
    new <- (newpage && is.null(draw.in) &&
            !lattice:::lattice.getStatus("print.more"))
    if (require(plotAndPlayGTK, quietly=TRUE) &&
        dev.interactive2(TRUE) && !playing && new) {
        ## starting a new plot on an interactive device
        eval.parent(call("playwith", x$call), n=2)
        return(invisible())
    }
    ## call the real `print.trellis`, from lattice package
    ocall <- sys.call()
    ocall[[1]] <- quote(plot)
    eval.parent(ocall)
}


setAutoPlaywith <- function(on=TRUE)
{
    require("lattice")
    lattice.options(print.function = if (on) plotAndPlayGTK.trellis
                    else NULL)
}


-Deepayan