Skip to content

Commit

Permalink
bugfixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@deepayan
deepayan committed Mar 28, 2007
1 parent 2547c2c commit 267175f
Show file tree
Hide file tree
Showing 14 changed files with 168 additions and 71 deletions.
20 changes: 10 additions & 10 deletions R/axis.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -228,17 +228,17 @@ axis.default <-
bottom = scales$tck[1],
right = ,
top = scales$tck[2])
panel.axis(side = side,
at = comp.list$ticks$at,
labels = comp.list$labels$labels,
draw.labels = do.labels,
check.overlap = comp.list$labels$check.overlap,
outside = TRUE,
tick = do.ticks,
tck = scales.tck * comp.list$ticks$tck,
...)
if (!is.logical(comp.list)) ## must be FALSE if it is
panel.axis(side = side,
at = comp.list$ticks$at,
labels = comp.list$labels$labels,
draw.labels = do.labels,
check.overlap = comp.list$labels$check.overlap,
outside = TRUE,
tick = do.ticks,
tck = scales.tck * comp.list$ticks$tck,
...)
}

}


Expand Down
2 changes: 1 addition & 1 deletion R/bwplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1044,7 +1044,7 @@ bwplot.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/cloud.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1446,7 +1446,7 @@ cloud.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/densityplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -216,7 +216,7 @@ densityplot.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/histogram.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@ histogram.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/levelplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -431,7 +431,7 @@ levelplot.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
186 changes: 137 additions & 49 deletions R/panels.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,11 @@


panel.abline <-
function(a, b = NULL,
h = numeric(0),
v = numeric(0),
function(a = NULL, b = NULL,
h = NULL,
v = NULL,
reg = NULL,
coef = NULL,
col,
col.line = add.line$col,
lty = add.line$lty,
Expand All @@ -34,66 +36,152 @@ panel.abline <-
{
add.line <- trellis.par.get("add.line")
if (!missing(col) && missing(col.line)) col.line <- col
if (!missing(a))
{
coeff <-
if (inherits(a,"lm")) coef(a)
else if (!is.null(coef(a))) coef(a) # ????
else c(a,b)

if (length(coeff) == 1) coeff <- c(0, coeff)

if (coeff[2] == 0) h <- c(h, coeff[1])
else if (!any(is.null(coeff)))
{
xx <- current.viewport()$xscale
yy <- current.viewport()$yscale

x <- numeric(0)
y <- numeric(0)
ll <- function(i, j, k, l)
(yy[j]-coeff[1]-coeff[2]*xx[i]) *
(yy[l]-coeff[1]-coeff[2]*xx[k])

if (ll(1,1,2,1)<=0) {
y <- c(y, yy[1])
x <- c(x, (yy[1]-coeff[1])/coeff[2])
}

if (ll(2,1,2,2)<=0) {
x <- c(x, xx[2])
y <- c(y, coeff[1] + coeff[2] * xx[2])
}
## mostly copied from abline
if (!is.null(reg))
{
if (!is.null(a))
warning("'a' is overridden by 'reg'")
a <- reg
}
if (is.object(a) || is.list(a))
{
p <- length(coefa <- as.vector(coef(a)))
if (p > 2)
warning("only using the first two of ", p, "regression coefficients")
islm <- inherits(a, "lm")
noInt <- if (islm)
!as.logical(attr(stats::terms(a), "intercept"))
else p == 1
if (noInt) {
a <- 0
b <- coefa[1]
}
else {
a <- coefa[1]
b <- if (p >= 2)
coefa[2]
else 0
}
}
if (!is.null(coef))
{
if (!is.null(a))
warning("'a' and 'b' are overridden by 'coef'")
a <- coef[1]
b <- coef[2]
}
## draw y = a + bx if appropriate
if (!is.null(a))
{
coeff <- c(a, b)
cpl <- current.panel.limits()
xx <- cpl$xlim
yy <- cpl$ylim

if (ll(2,2,1,2)<=0) {
y <- c(y, yy[2])
x <- c(x, (yy[2]-coeff[1])/coeff[2])
}
x <- numeric(0)
y <- numeric(0)
ll <- function(i, j, k, l)
(yy[j]-coeff[1]-coeff[2]*xx[i]) *
(yy[l]-coeff[1]-coeff[2]*xx[k])

if (ll(1,2,1,1)<=0) {
x <- c(x, xx[1])
y <- c(y, coeff[1] + coeff[2] * xx[1])
}

panel.lines(x = x, y = y,
col = col.line,
lty = lty,
lwd = lwd,
...)
if (ll(1,1,2,1)<=0) {
y <- c(y, yy[1])
x <- c(x, (yy[1]-coeff[1])/coeff[2])
}
if (ll(2,1,2,2)<=0) {
x <- c(x, xx[2])
y <- c(y, coeff[1] + coeff[2] * xx[2])
}
if (ll(2,2,1,2)<=0) {
y <- c(y, yy[2])
x <- c(x, (yy[2]-coeff[1])/coeff[2])
}
if (ll(1,2,1,1)<=0) {
x <- c(x, xx[1])
y <- c(y, coeff[1] + coeff[2] * xx[1])
}
panel.lines(x = x, y = y,
col = col.line,
lty = lty,
lwd = lwd,
...)
}

if (length(h <- as.numeric(h)))
if (length(h <- as.numeric(h)) > 0)
grid.segments(y0 = h, y1 = h, default.units="native",
gp = gpar(col = col.line, lty = lty, lwd = lwd))
if (length(as.numeric(v)))
if (length(as.numeric(v)) > 0)
grid.segments(x0 = v, x1 = v, default.units="native",
gp = gpar(col = col.line, lty = lty, lwd = lwd))
invisible()
}





### old version of panel.abline

## panel.abline <-
## function (a, b = NULL, h = numeric(0), v = numeric(0), col, col.line = add.line$col,
## lty = add.line$lty, lwd = add.line$lwd, type, ...)
## {
## add.line <- trellis.par.get("add.line")
## if (!missing(col) && missing(col.line))
## col.line <- col
## if (!missing(a)) {
## coeff <- if (inherits(a, "lm"))
## coef(a)
## else if (!is.null(coef(a)))
## coef(a)
## else c(a, b)
## if (length(coeff) == 1)
## coeff <- c(0, coeff)
## if (coeff[2] == 0)
## h <- c(h, coeff[1])
## else if (!any(is.null(coeff))) {
## xx <- current.viewport()$xscale
## yy <- current.viewport()$yscale
## x <- numeric(0)
## y <- numeric(0)
## ll <- function(i, j, k, l) (yy[j] - coeff[1] - coeff[2] *
## xx[i]) * (yy[l] - coeff[1] - coeff[2] * xx[k])
## if (ll(1, 1, 2, 1) <= 0) {
## y <- c(y, yy[1])
## x <- c(x, (yy[1] - coeff[1])/coeff[2])
## }
## if (ll(2, 1, 2, 2) <= 0) {
## x <- c(x, xx[2])
## y <- c(y, coeff[1] + coeff[2] * xx[2])
## }
## if (ll(2, 2, 1, 2) <= 0) {
## y <- c(y, yy[2])
## x <- c(x, (yy[2] - coeff[1])/coeff[2])
## }
## if (ll(1, 2, 1, 1) <= 0) {
## x <- c(x, xx[1])
## y <- c(y, coeff[1] + coeff[2] * xx[1])
## }
## panel.lines(x = x, y = y, col = col.line, lty = lty,
## lwd = lwd, ...)
## }
## }
## if (length(h <- as.numeric(h)))
## grid.segments(y0 = h, y1 = h, default.units = "native",
## gp = gpar(col = col.line, lty = lty, lwd = lwd))
## if (length(as.numeric(v)))
## grid.segments(x0 = v, x1 = v, default.units = "native",
## gp = gpar(col = col.line, lty = lty, lwd = lwd))
## }









panel.curve <-
function (expr, from, to, n = 101,
curve.type = "l",
Expand Down
2 changes: 1 addition & 1 deletion R/parallel.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -228,7 +228,7 @@ parallel.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/qq.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ qq.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/qqmath.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -267,7 +267,7 @@ qqmath.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/splom.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -388,7 +388,7 @@ splom.formula <-
subset <- eval(substitute(subset), data, environment(formula))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
2 changes: 1 addition & 1 deletion R/xyplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -208,7 +208,7 @@ xyplot.formula <-
subset <- eval(substitute(subset), data, environment(x))
if (!is.null(lattice.options))
{
oopt <- lattice.options(x$lattice.options)
oopt <- lattice.options(lattice.options)
on.exit(lattice.options(oopt), add = TRUE)
}

Expand Down
3 changes: 2 additions & 1 deletion demo/lattice.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -165,9 +165,10 @@ qq(gl(2, 100) ~ c(runif(100, min = -2, max = 2), rnorm(100)),

## non-trivial strip function

barchart(variety ~ yield | year * site, barley,
barchart(variety ~ yield | year * site, barley, origin = 0,
layout = c(4, 3),
between = list(x = c(0, 0.5, 0)),
par.settings = list(clip = list(strip = "on")),
strip =
function(which.given,
which.panel,
Expand Down
10 changes: 9 additions & 1 deletion tests/test.R
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
postscript("misctests.ps")
postscript("test.ps")
library(lattice)

densityplot(~ 5)
Expand All @@ -16,6 +16,14 @@ xyplot(y ~ x | z * a, strip = function(...) strip.default(..., style = 4),
##scales = list(x = list(draw = FALSE), y = "sliced"))
scales = list(x = list(rot = 0), y = list(rot = 0)))

xyplot(a ~ x | z,
main = "xyplot call with modified options",
lattice.options =
list(panel.xyplot = "panel.bwplot",
default.args = list(between = list(x = 1, y = 1))))




bwplot(zz ~ xx | aa, df.test)

Expand Down

0 comments on commit 267175f

Please sign in to comment.