SCM Repository
[latticeextra] / pkg / R / tileplot.R |
View of /pkg/R/tileplot.R
Parent Directory
|
Revision Log
Revision 210 -
(download)
(annotate)
Fri Jun 24 11:28:30 2022 UTC (7 months, 2 weeks ago) by deepayan
File size: 4679 byte(s)
Fri Jun 24 11:28:30 2022 UTC (7 months, 2 weeks ago) by deepayan
File size: 4679 byte(s)
update URLs
## ## Copyright (c) 2008 Felix Andrews <felix@nfrac.org> ## Copyright (c) 2022 Deepayan Sarkar <deepayan.sarkar@r-project.org> ## GPL version 2 or newer tileplot <- function(x, data = NULL, aspect = "iso", prepanel = "prepanel.default.xyplot", panel = "panel.voronoi", ...) { foo <- levelplot(x, data = data, aspect = aspect, panel = panel, prepanel = prepanel, ...) foo$call <- sys.call(sys.parent()) foo } ## panel function to draw Voronoi mosaic panel.voronoi <- function(x, y, z, subscripts = TRUE, at = pretty(z), points = TRUE, border = "transparent", na.rm = FALSE, win.expand = 0.07, use.tripack = FALSE, backend = c("interp", "deldir"), ..., col.regions = regions$col, alpha.regions = regions$alpha) { backend <- match.arg(backend) ## latticeExtra <= 0.6-29 offered the choice of using the non-free ## ACM licensed 'tripack' package, which was faster than the ## 'deldir' implementation. Later versions use the FOSS ## replacements in 'interp', and deprecates the 'use.tripack' ## argument. 'deldir' can still be used using 'backend = "deldir"'. if (!missing(use.tripack)) { warning("The 'use.tripack' argument is deprecated and ignored. See ?panel.voronoi") } ## find subset of points to use x0 <- x[subscripts] y0 <- y[subscripts] z0 <- z[subscripts] ## throw away NAs, but keep originals for panel.xyplot() ok <- complete.cases(x0, y0) if (na.rm) ok <- ok & !is.na(z0) x <- x0[ok] y <- y0[ok] z <- z0[ok] if (!any(is.finite(z))) return() ## strip duplicated locations, with warning dup <- duplicated(cbind(x, y)) if (any(dup)) { warning(paste("Ignoring", sum(dup), "cases of duplicated locations")) x <- x[!dup] y <- y[!dup] z <- z[!dup] } ## compute bounds data.rg <- list(x = extendrange(x, f = win.expand), y = extendrange(y, f = win.expand)) bounds <- c(data.rg$x, data.rg$y) #panel.rg <- lapply(current.panel.limits(), sort) #bounds <- c(max(panel.rg$x[1], data.rg$x[1]), # min(panel.rg$x[2], data.rg$x[2]), # max(panel.rg$y[1], data.rg$y[1]), # min(panel.rg$y[2], data.rg$y[2])) ## check if any points in visible plot region #if (is.unsorted(bounds[1:2])) # bounds[1:2] <- panel.rg$x #if (is.unsorted(bounds[3:4])) # bounds[3:4] <- panel.rg$y if (backend == "interp") { xy <- data.frame(x = x, y = y) ## add dummy points to ensure that voronoi polygons are finite dummies <- data.frame(x = c(-1,-1,1,1), y = c(-1,1,-1,1)) * 10 * max(abs(xy)) xy <- rbind(xy, dummies) tiles <- voronoi.polygons(voronoi.mosaic(xy, duplicate = "error")) } else { if (!requireNamespace("deldir", quietly = TRUE)) stop("The 'deldir' backend requires the 'deldir' package to be installed.") ## NB: the 'rw' argument as subset of data is bad because ## need to take corresponding subset of z ! ## (but not easy to work out what that is) #set <- ((bounds[1] < x) & (x < bounds[2]) & # (bounds[3] < y) & (y < bounds[4])) #x <- x[set] #y <- y[set] #z <- z[set] tiles <- deldir::tile.list(deldir::deldir(x, y, rw = bounds)) tiles <- lapply(tiles, function(p) as.data.frame(p[c("x", "y")])) } ## draw it as one composite polygon polydata <- do.call("rbind", tiles) regions <- trellis.par.get("regions") zcol <- level.colors(z, at, col.regions, colors = TRUE) grid.polygon(polydata[,1], polydata[,2], id.lengths = sapply(tiles, nrow), default.units = "native", gp = gpar(fill = zcol, col = border, alpha = alpha.regions)) if (points) { panel.xyplot(x0, y0, ...) } } panel.levelplot.points <- function(x, y, z, subscripts = TRUE, at = pretty(z), shrink, labels, label.style, contour, region, ## (all ignored) pch = 21, col.symbol = "#00000044", ..., col.regions = regions$col, fill = NULL) ## (ignored) { regions <- trellis.par.get("regions") zcol <- level.colors(z, at, col.regions, colors = TRUE) x <- x[subscripts] y <- y[subscripts] zcol <- zcol[subscripts] ## panel.xyplot does the work (can handle 'type' argument, etc) panel.xyplot(x, y, fill = zcol, pch = pch, col.symbol = col.symbol, ...) }
root@r-forge.r-project.org | ViewVC Help |
Powered by ViewVC 1.0.0 |