File: common.R

package info (click to toggle)
r-cran-eaf 1.8-2~bpo9+1
  • links: PTS, VCS
  • area: main
  • in suites: stretch-backports
  • size: 4,328 kB
  • sloc: ansic: 2,796; perl: 848; sh: 33; makefile: 2
file content (108 lines) | stat: -rw-r--r-- 3,514 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

### Copyright (C) 2001-2006  Deepayan Sarkar <Deepayan.Sarkar@R-project.org>
### Copyright (C) 2001-2005  Saikat DebRoy <saikat@stat.wisc.edu>
###
### This file is part of the lattice package for R.
### It is made available under the terms of the GNU General Public
### License, version 2, or at your option, any later version,
### incorporated herein by reference.
###
### 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.
###
### You should have received a copy of the GNU General Public
### License along with this program; if not, write to the Free
### Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
### MA 02110-1301, USA




.cupdate <- function(index, maxim)
{
	
	## This unexported function is used to handle arbitrary number of
	## conditioning variables : every time it is called, it increments
	## the "current" level of the conditioning variables suitably,
	## i.e., it tries to increment the level of the 1st conditining
	## variable (the one which varies fastest along panel order) and
	## if it happens to be at its maximum (last) value, it sets it to
	## the first value AND increments the "current" level of the 2nd
	## (next) conditioning variable recursively.
	
	if(length(index)!=length(maxim)||length(maxim)<=0)
		stop("Inappropriate arguments")
	index[1] <- index[1] + 1
	if (index[1] > maxim[1] && length(maxim) > 1)
		c(1, .cupdate(index[-1], maxim[-1]))
	else index
}



.check.layout <-
    function(layout, cond.max.level, skip = FALSE)
{
    if (all(skip)) stop("skip cannot be all TRUE")
    number.of.cond <- length(cond.max.level)
    nplots <- prod(cond.max.level)

    if (!is.numeric(layout))
    {
        layout <- c(0,1,1)
        if (number.of.cond == 1) layout[2] <- nplots
        else
        {
            layout[1] <- cond.max.level[1]
            layout[2] <- cond.max.level[2]
        }
        skip <- rep(skip, length.out = max(layout[1] * layout[2], layout[2]))
        plots.per.page <- length(skip) - length(skip[skip])
        layout[3] <- ceiling(nplots/plots.per.page) # + 1
    }
    else if (length(layout) == 1)
        stop("layout must have at least 2 elements")
    else if (length(layout) == 2)
    {
        if (all(is.na(layout)))
            stop("inadmissible value of layout")
        else if (all(layout < 1))
            stop("at least one element of layout must be positive")
        else if (isTRUE(layout[2] == 0))
            stop("inadmissible value of layout")

        if (is.na(layout[1]))
            layout[1] <- ceiling(nplots / layout[2])
        if (is.na(layout[2]))
            layout[2] <- ceiling(nplots / layout[1])

        skip <- rep(skip, length.out = max(layout[1] * layout[2], layout[2]))
        plots.per.page <- length(skip) - length(skip[skip])
        layout[3] <- ceiling(nplots / plots.per.page) # + 1
    }
    else if (length(layout)==3)
    {
        if(layout[1] < 0 || layout[2] < 1 || layout[3] < 1)
            stop("invalid value for layout")
    }
    layout
}


.compute.packet <-
    function(cond, levels)
{
    id <- !(do.call("pmax", lapply(cond, is.na)))
    stopifnot(any(id))
    for (i in seq_along(cond))
    {
        var <- cond[[i]]
        id <-  id & (as.numeric(var) == levels[i])
    	## MARCO: Removed the possibility of numerical conditioning variables
	}
    id
}