Hello dear members of R-devel mailing list and Kevin Buhr (the author of
the polygon function),
After some private e-mails, I was informed this is the place to post this
feature request. I hope I am correct.
I would like to use a command like this:
plot(c(1,8), 1:2, type="n")
polygon(1:7, c(2,1,2,NA,2,1,2),
col=c("red", "blue"),
# border=c("green", "yellow"),
border=c(1,10),
lwd=c(1:10))
To create two triangles, with different line widths.
But the polygon command doesn't seem to recycle the "lwd" parameter as it
does for the col, lty, and the border parameters.
I would like the resulting plot to look like what the following code will
produce:
plot(c(1,8), 1:2, type="n")
polygon(1:3, c(2,1,2),
col=c("red"),
# border=c("green", "yellow"),
border=c(1,10),
lwd=c(1))
polygon(5:7, c(2,1,2),
col=c( "blue"),
# border=c("green", "yellow"),
border=c(1,10),
lwd=c(10))
I opened up the polygon code to add the lwd parameter so to be used as the
lty is used.
For some reason it didn't work (I am wondering if it is because of some way
.Internal(polygon(xy$x, xy$y, col, border, lty, lwd,...)) doesn't accept
lwd...)
Here is the updates code I wrote (which, for some reason, doesn't work):
polygon2 <- function (x, y = NULL, density = NULL, angle = 45, border =
NULL,
col = NA, lty = par("lty"), lwd
=par("lwd") ,..., fillOddEven = FALSE)
{
..debug.hatch <- FALSE
xy <- xy.coords(x, y)
if (is.numeric(density) && all(is.na(density) | density <
0))
density <- NULL
if (!is.null(angle) && !is.null(density)) {
polygon.onehatch <- function(x, y, x0, y0, xd, yd, ..debug.hatch =
FALSE,
...) {
if (..debug.hatch) {
points(x0, y0)
arrows(x0, y0, x0 + xd, y0 + yd)
}
halfplane <- as.integer(xd * (y - y0) - yd * (x -
x0) <= 0)
cross <- halfplane[-1L] - halfplane[-length(halfplane)]
does.cross <- cross != 0
if (!any(does.cross))
return()
x1 <- x[-length(x)][does.cross]
y1 <- y[-length(y)][does.cross]
x2 <- x[-1L][does.cross]
y2 <- y[-1L][does.cross]
t <- (((x1 - x0) * (y2 - y1) - (y1 - y0) * (x2 -
x1))/(xd * (y2 - y1) - yd * (x2 - x1)))
o <- order(t)
tsort <- t[o]
crossings <- cumsum(cross[does.cross][o])
if (fillOddEven)
crossings <- crossings%%2
drawline <- crossings != 0
lx <- x0 + xd * tsort
ly <- y0 + yd * tsort
lx1 <- lx[-length(lx)][drawline]
ly1 <- ly[-length(ly)][drawline]
lx2 <- lx[-1L][drawline]
ly2 <- ly[-1L][drawline]
segments(lx1, ly1, lx2, ly2, ...)
}
polygon.fullhatch <- function(x, y, density, angle, ..debug.hatch =
FALSE,
...) {
x <- c(x, x[1L])
y <- c(y, y[1L])
angle <- angle%%180
if (par("xlog") || par("ylog")) {
warning("cannot hatch with logarithmic scale active")
return()
}
usr <- par("usr")
pin <- par("pin")
upi <- c(usr[2L] - usr[1L], usr[4L] - usr[3L])/pin
if (upi[1L] < 0)
angle <- 180 - angle
if (upi[2L] < 0)
angle <- 180 - angle
upi <- abs(upi)
xd <- cos(angle/180 * pi) * upi[1L]
yd <- sin(angle/180 * pi) * upi[2L]
if (angle < 45 || angle > 135) {
if (angle < 45) {
first.x <- max(x)
last.x <- min(x)
}
else {
first.x <- min(x)
last.x <- max(x)
}
y.shift <- upi[2L]/density/abs(cos(angle/180 *
pi))
x0 <- 0
y0 <- floor((min(y) - first.x * yd/xd)/y.shift) *
y.shift
y.end <- max(y) - last.x * yd/xd
while (y0 < y.end) {
polygon.onehatch(x, y, x0, y0, xd, yd, ..debug.hatch =
..debug.hatch,
...)
y0 <- y0 + y.shift
}
}
else {
if (angle < 90) {
first.y <- max(y)
last.y <- min(y)
}
else {
first.y <- min(y)
last.y <- max(y)
}
x.shift <- upi[1L]/density/abs(sin(angle/180 *
pi))
x0 <- floor((min(x) - first.y * xd/yd)/x.shift) *
x.shift
y0 <- 0
x.end <- max(x) - last.y * xd/yd
while (x0 < x.end) {
polygon.onehatch(x, y, x0, y0, xd, yd, ..debug.hatch =
..debug.hatch,
...)
x0 <- x0 + x.shift
}
}
}
if (missing(col) || is.null(col) || is.na(col))
col <- par("fg")
if (is.null(border))
border <- col
if (is.logical(border)) {
if (!is.na(border) && border)
border <- col
else border <- NA
}
start <- 1
ends <- c(seq_along(xy$x)[is.na(xy$x) | is.na(xy$y)],
length(xy$x) + 1)
num.polygons <- length(ends)
col <- rep(col, length.out = num.polygons)
border <- rep(border, length.out = num.polygons)
lty <- rep(lty, length.out = num.polygons)
lwd <- rep(lwd, length.out = num.polygons)
density <- rep(density, length.out = num.polygons)
angle <- rep(angle, length.out = num.polygons)
i <- 1
for (end in ends) {
if (end > start) {
den <- density[i]
if (is.na(den) || den < 0)
.Internal(polygon(xy$x[start:(end - 1)], xy$y[start:(end
-
1)], col[i], NA, lty[i],lwd[i], ...))
else if (den > 0) {
polygon.fullhatch(xy$x[start:(end - 1)], xy$y[start:(end
-
1)], col = col[i], lty = lty[i],lwd = lwd[i], density =
density[i],
angle = angle[i], ..debug.hatch = ..debug.hatch,
...)
}
i <- i + 1
}
start <- end + 1
}
.Internal(polygon(xy$x, xy$y, NA, border, lty,lwd, ...))
}
else {
if (is.logical(border)) {
if (!is.na(border) && border)
border <- par("fg")
else border <- NA
}
.Internal(polygon(xy$x, xy$y, col, border, lty, lwd,...))
}
}
Thanks for any help,
Tal
----------------Contact
Details:-------------------------------------------------------
Contact me: tal.gal...@gmail.com | 972-52-7275845
Read me: www.talgalili.com (Hebrew) | www.biostatistics.co.il (Hebrew) |
www.r-statistics.com (English)
----------------------------------------------------------------------------------------------
[[alternative HTML version deleted]]
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
