← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/latticeextra/oneiric

« back to all changes in this revision

Viewing changes to R/panel.xyarea.R

  • Committer: Bazaar Package Importer
  • Author(s): Dirk Eddelbuettel
  • Date: 2011-05-13 15:40:08 UTC
  • mfrom: (1.4.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20110513154008-ogqy8zo6elhazff4
Tags: 0.6-16-1
* New upstream release

* debian/control: Set (Build-)Depends: to current R version
* debian/control: Set Standards-Version: to current version 

Show diffs side-by-side

added added

removed removed

Lines of Context:
R/panel.xyarea.R
8
8
## Plot a series as a filled polygon connected at given origin (on y axis).
9
9
## With groups, acts like panel.superpose, but with polygon style settings.
10
10
panel.xyarea.default <-
11
 
    function(x, y, groups = NULL, origin = NULL,
 
11
    function(x, y, groups = NULL, origin = NULL, horizontal = FALSE,
12
12
             col = if (is.null(groups)) plot.polygon$col else superpose.polygon$col,
13
13
             border = if (is.null(groups)) plot.polygon$border else superpose.polygon$border,
14
14
             lty = if (is.null(groups)) plot.polygon$lty else superpose.polygon$lty,
25
25
        ## NOTE superpose does not handle 'border' argument, so pass it as col.line
26
26
        panel.superpose(x, y, ..., groups = groups, panel.groups = panel.groups,
27
27
                        col = col, col.line = border, lty = lty, lwd = lwd,
28
 
                        alpha = alpha, origin = origin)
 
28
                        alpha = alpha, origin = origin, horizontal = horizontal)
29
29
    } else {
30
 
        if (all(is.na(col)) && !missing(col.line))
 
30
        if (!missing(col.line))
31
31
            col <- col.line
32
 
        if (is.null(origin))
33
 
            origin <- current.panel.limits()$ylim[1]
 
32
        if (horizontal == TRUE) {
 
33
            ## actually means origin is vertical. for consistency with panel.xyplot.
 
34
            xlim <- current.panel.limits()$xlim
 
35
            if (is.null(origin))
 
36
                origin <- xlim[1]
 
37
            infi <- is.infinite(x)
 
38
            x[infi] <- ifelse(x[infi] > 0, max(xlim), min(xlim))
 
39
        } else {
 
40
            ## default case; origin is horizontal
 
41
            ylim <- current.panel.limits()$ylim
 
42
            if (is.null(origin))
 
43
                origin <- ylim[1]
 
44
            infi <- is.infinite(y)
 
45
            y[infi] <- ifelse(y[infi] > 0, max(ylim), min(ylim))
 
46
        }
34
47
        stopifnot(is.numeric(origin))
35
48
        ## need to split up the series into chunks without any missing values
36
49
        ## (because NAs split the polygon)
37
50
        xy <- data.frame(x = x, y = y)
38
 
        ok <- is.finite(x) & is.finite(y)
 
51
        ## order by ordinate values
 
52
        ord <- if (horizontal) order(xy$y) else order(xy$x)
 
53
        xy <- xy[ord,]
 
54
        ok <- complete.cases(xy)
39
55
        runs <- rle(ok)
40
56
        ## assign unique values to each chunk, and NAs between (dropped by 'split')
41
57
        runs$values[runs$values == TRUE] <- seq_len(sum(runs$values))
46
62
            x <- xyi$x
47
63
            y <- xyi$y
48
64
            ## drop ends of series to the origin; the polygon will be joined up at that level
49
 
            xx <- c(head(x,1), x, tail(x,1))
50
 
            yy <- c(origin, y, origin)
 
65
            if (horizontal == TRUE) {
 
66
                ## non-default case
 
67
                yy <- c(head(y,1), y, tail(y,1))
 
68
                xx <- c(origin, x, origin)
 
69
            } else {
 
70
                ## default case
 
71
                xx <- c(head(x,1), x, tail(x,1))
 
72
                yy <- c(origin, y, origin)
 
73
            }
51
74
            ## we need to catch the 'fill' argument from panel.superpose, otherwise over-rides 'col'
52
75
            panel.polygon(xx, yy, alpha = alpha, col = col, border = col.line, lty = lty, lwd = lwd, ...)
53
76
        }, ...)