1# 2plot.SpatialPolygons <- function(x, col, border = par("fg"), add=FALSE, 3 xlim=NULL, ylim=NULL, xpd = NULL, density = NULL, angle = 45, 4 pbg=NULL, axes = FALSE, lty = par("lty"), ..., setParUsrBB=FALSE, 5 usePolypath=NULL, rule=NULL, bgMap = NULL) { 6 7 if (is.null(pbg)) 8 pbg = par("bg") # transparent! 9 if (!is(x, "SpatialPolygons")) 10 stop("Not a SpatialPolygons object") 11 if (is.null(usePolypath)) usePolypath <- get_Polypath() 12 if (is.null(rule)) rule <- get_PolypathRule() 13 14 if (! add) 15 plot(as(x, "Spatial"), xlim=xlim, ylim=ylim, axes = axes, 16 ..., setParUsrBB=setParUsrBB, bgMap = bgMap) 17 18 n <- length(slot(x, "polygons")) 19 if (length(border) != n) 20 border <- rep(border, n, n) 21 polys <- slot(x, "polygons") 22 pO <- slot(x, "plotOrder") 23 if (!is.null(density)) { 24 if (missing(col)) col <- par("fg") 25 if (length(col) != n) col <- rep(col, n, n) 26 if (length(density) != n) 27 density <- rep(density, n, n) 28 if (length(angle) != n) 29 angle <- rep(angle, n, n) 30 for (j in pO) 31 .polygonRingHoles(polys[[j]], border = border[j], 32 xpd = xpd, density = density[j], angle = angle[j], 33 col = col[j], pbg = pbg, lty=lty, ...) 34 } else { 35 if (missing(col)) col <- NA 36 if (length(col) != n) col <- rep(col, n, n) 37 for (j in pO) 38 .polygonRingHoles(polys[[j]], col=col[j], 39 border=border[j], xpd = xpd, pbg = pbg, lty=lty, ..., 40 usePolypath=usePolypath, rule=rule) 41 } 42} 43 44setMethod("plot", signature(x = "SpatialPolygons", y = "missing"), 45 function(x, y, ...) plot.SpatialPolygons(x, ...)) 46 47.polygonRingHoles <- function(Sr, col=NA, border=NULL, xpd=NULL, density=NULL, 48 angle=45, pbg, lty = par("lty"), ..., usePolypath=NULL, 49 rule=NULL) { 50 if (!is(Sr, "Polygons")) 51 stop("Not an Polygons object") 52 if (is.null(usePolypath)) usePolypath <- get_Polypath() 53 if (is.null(rule)) rule <- get_PolypathRule() 54 if (!is.null(density)) hatch <- TRUE 55 else hatch <- FALSE 56 pO <- slot(Sr, "plotOrder") 57 polys <- slot(Sr, "Polygons") 58 59 if (hatch) { 60 for (i in pO) { 61 if (!slot(polys[[i]], "hole")) 62 .polygon(slot(polys[[i]], "coords"), 63 border = border, xpd = xpd, 64 density = density, angle = angle, 65 col=col, hatch=TRUE, lty=lty, ...) 66 else .polygon(slot(polys[[i]], "coords"), 67 border = border, xpd = xpd, col=pbg, 68 density = NULL, lty=lty, ...) 69 } 70 } else if (exists("polypath") && usePolypath) { 71 Srl <- as(Sr, "Lines") 72 crds <- coordinates(Srl) 73 if (length(crds) == 1) mcrds <- crds[[1]] 74 else { 75 NAr <- as.double(c(NA, NA)) 76 crds1 <- lapply(crds, function(x) rbind(x, NAr)) 77 mcrds <- do.call(rbind, crds1) 78 mcrds <- mcrds[-nrow(mcrds),] 79 rownames(mcrds) <- NULL 80 } 81 polypath(x=mcrds[,1], y=mcrds[,2], border=border, col=col, 82 lty=lty, rule=rule, xpd=xpd, ...) 83 } else { 84 for (i in pO) { 85 if (!slot(polys[[i]], "hole")) 86 .polygon(slot(polys[[i]], "coords"), 87 border = border, xpd = xpd, 88 col=col, lty=lty, ...) 89 else .polygon(slot(polys[[i]], "coords"), 90 border = border, xpd = xpd, col=pbg, lty=lty, 91 ...) 92 } 93 } 94} 95 96 97.polygon = function(x, y = NULL, density = NULL, angle = 45, 98 border = NULL, col = NA, lty = NULL, xpd = NULL, hatch=NA, ...) { 99 if (is.na(hatch)) polygon(x = x, y = y, border = border, 100 col = col, lty = lty, xpd = xpd, ...) 101 else polygon(x = x, y = y, density = density, angle = angle, 102 border = border, lty = lty, xpd = xpd, col=col, ...) 103} 104 105 106