Hello dear members of R-help and R-core mailing list,
I am not sure if this request is a "ticket" that should be filled somewhere
outside the mailing list. If so, I apologize for not doing and would like
to know where I should have filled it.
And to the subject matter:
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:
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-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
