From 025c2fb122f8a17e9d4e9d3c51cfa39b4a1044b3 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 14 Jan 2020 13:57:43 +0100 Subject: [PATCH 01/44] removed crs-functions, or made them deprecated --- DESCRIPTION | 8 +- NAMESPACE | 69 ------ NEWS | 5 +- R/aggregate_map.R | 308 ------------------------ R/append_data.R | 205 ---------------- R/approx_areas.R | 63 ----- R/approx_distances.R | 129 +--------- R/bb.R | 37 +-- R/bb_poly.R | 15 +- R/calc_densities.R | 4 +- R/crop_shape.R | 70 +++--- R/deprecated.R | 93 ++++++-- R/geocode_OSM.R | 40 ++-- R/get_IDs.R | 27 --- R/get_asp_ratio.R | 3 +- R/get_brewer_pal.R | 12 +- R/get_proj4_code.R | 106 --------- R/is_projected.R | 32 --- R/kde2D.R | 63 ----- R/line_functions.R | 189 --------------- R/map_coloring.R | 5 +- R/onLoad.R | 12 - R/palette_explorer.R | 4 +- R/pkg.R | 32 --- R/projection_units.R | 72 ------ R/read_GPX.R | 38 ++- R/read_osm.R | 99 +++++++- R/read_shape.R | 81 ------- R/sample_dots.R | 223 ------------------ R/sbind.R | 68 ------ R/set_projection.R | 171 -------------- R/sf_stars_functions.R | 11 + R/simplify_shape.R | 24 +- R/smooth_map.R | 454 ------------------------------------ R/smooth_raster_cover.R | 93 -------- R/to_raster.R | 186 --------------- examples/aggregate_map.R | 42 ---- examples/append_data.R | 30 --- examples/approx_areas.R | 2 +- examples/approx_distances.R | 4 +- examples/bb.R | 2 +- examples/calc_densities.R | 2 +- examples/crop_shape.R | 4 +- examples/double_line.R | 32 --- examples/geocode_OSM.R | 5 +- examples/pipe.R | 14 -- examples/points_to_raster.R | 22 -- examples/poly_to_raster.R | 12 - examples/projection_units.R | 10 - examples/read_GPX.R | 30 --- examples/rev_geocode_OSM.R | 2 +- examples/sample_dots.R | 9 - examples/simplify_shape.R | 1 + examples/smooth_map.R | 108 --------- man/aggregate_map.Rd | 97 -------- man/append_data.Rd | 80 ------- man/approx_areas.Rd | 2 +- man/approx_distances.Rd | 4 +- man/bb.Rd | 6 +- man/bb_poly.Rd | 4 +- man/calc_densities.Rd | 4 +- man/crop_shape.Rd | 4 +- man/deprecated_functions.Rd | 51 +++- man/double_line.Rd | 63 ----- man/geocode_OSM.Rd | 9 +- man/get_IDs.Rd | 22 -- man/get_proj4.Rd | 46 ---- man/is_projected.Rd | 17 -- man/pipe.Rd | 16 -- man/points_to_raster.Rd | 60 ----- man/poly_to_raster.Rd | 51 ---- man/read_GPX.Rd | 43 +--- man/read_shape.Rd | 28 --- man/rev_geocode_OSM.Rd | 6 +- man/sample_dots.Rd | 69 ------ man/sbind.Rd | 22 -- man/set_projection.Rd | 43 ---- man/simplify_shape.Rd | 3 +- man/smooth_map.Rd | 183 --------------- man/smooth_raster_cover.Rd | 28 --- man/tmaptools-deprecated.Rd | 13 -- man/tmaptools-package.Rd | 22 -- man/write_shape.Rd | 19 -- sandbox/stars.R | 44 ++++ 84 files changed, 432 insertions(+), 4009 deletions(-) delete mode 100644 R/aggregate_map.R delete mode 100644 R/append_data.R delete mode 100644 R/get_IDs.R delete mode 100644 R/get_proj4_code.R delete mode 100644 R/is_projected.R delete mode 100644 R/kde2D.R delete mode 100644 R/line_functions.R delete mode 100644 R/projection_units.R delete mode 100644 R/read_shape.R delete mode 100644 R/sample_dots.R delete mode 100644 R/sbind.R create mode 100644 R/sf_stars_functions.R delete mode 100644 R/smooth_map.R delete mode 100644 R/smooth_raster_cover.R delete mode 100644 R/to_raster.R delete mode 100644 examples/aggregate_map.R delete mode 100644 examples/append_data.R delete mode 100644 examples/double_line.R delete mode 100644 examples/pipe.R delete mode 100644 examples/points_to_raster.R delete mode 100644 examples/poly_to_raster.R delete mode 100644 examples/projection_units.R delete mode 100644 examples/read_GPX.R delete mode 100644 examples/sample_dots.R delete mode 100644 examples/smooth_map.R delete mode 100644 man/aggregate_map.Rd delete mode 100644 man/append_data.Rd delete mode 100644 man/double_line.Rd delete mode 100644 man/get_IDs.Rd delete mode 100644 man/get_proj4.Rd delete mode 100644 man/is_projected.Rd delete mode 100644 man/points_to_raster.Rd delete mode 100644 man/poly_to_raster.Rd delete mode 100644 man/read_shape.Rd delete mode 100644 man/sample_dots.Rd delete mode 100644 man/sbind.Rd delete mode 100644 man/set_projection.Rd delete mode 100644 man/smooth_map.Rd delete mode 100644 man/smooth_raster_cover.Rd delete mode 100644 man/tmaptools-deprecated.Rd delete mode 100644 man/write_shape.Rd create mode 100644 sandbox/stars.R diff --git a/DESCRIPTION b/DESCRIPTION index 4be7553..f1618d8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,25 +1,23 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 2.1 +Version: 3.0 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2019-12-15 +Date: 2020-01-12 Depends: R (>= 3.0), methods Imports: - sp, sf (>= 0.7-1), lwgeom (>= 0.1-4), + stars, units (>= 0.6-1), grid, raster (>= 2.7-15), - rgdal, - rgeos, classInt, KernSmooth, magrittr, diff --git a/NAMESPACE b/NAMESPACE index bd3b95a..a472c12 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,6 @@ # Generated by roxygen2: do not edit by hand export("%>%") -export(aggregate_map) -export(append_data) export(approx_areas) export(approx_distances) export(bb) @@ -10,9 +8,7 @@ export(bb_earth) export(bb_poly) export(calc_densities) export(crop_shape) -export(double_line) export(geocode_OSM) -export(get_IDs) export(get_asp_ratio) export(get_brewer_pal) export(get_neighbours) @@ -20,97 +16,32 @@ export(get_proj4) export(get_projection) export(is_projected) export(map_coloring) -export(offset_line) -export(osm_line) -export(osm_point) -export(osm_poly) -export(over_coverage) export(palette_explorer) -export(points_to_raster) -export(poly_to_raster) export(read_GPX) export(read_osm) -export(read_shape) export(rev_geocode_OSM) -export(sample_dots) export(set_projection) export(simplify_shape) -export(smooth_map) -export(smooth_raster_cover) export(tmap.pal.info) -export(under_coverage) -export(write_shape) import(RColorBrewer) import(grid) -import(sf) import(sp) -importFrom(KernSmooth,bkde2D) importFrom(XML,xmlAttrs) importFrom(XML,xmlChildren) importFrom(XML,xmlRoot) importFrom(XML,xmlTreeParse) importFrom(XML,xmlValue) -importFrom(classInt,classIntervals) -importFrom(classInt,findCols) importFrom(dichromat,dichromat) importFrom(grDevices,col2rgb) -importFrom(grDevices,colorRampPalette) -importFrom(grDevices,colors) -importFrom(grDevices,contourLines) -importFrom(grDevices,dev.off) -importFrom(grDevices,png) -importFrom(grDevices,rgb) importFrom(lwgeom,st_geod_area) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") -importFrom(methods,as) -importFrom(methods,slot) -importFrom(methods,slotNames) importFrom(raster,brick) -importFrom(raster,colortable) importFrom(raster,couldBeLonLat) -importFrom(raster,crop) -importFrom(raster,extend) importFrom(raster,extent) -importFrom(raster,extract) -importFrom(raster,fromDisk) -importFrom(raster,getValues) importFrom(raster,mask) -importFrom(raster,nlayers) -importFrom(raster,projectExtent) -importFrom(raster,projectRaster) importFrom(raster,raster) -importFrom(raster,rasterToContour) -importFrom(raster,rasterize) importFrom(raster,trim) -importFrom(rgdal,CRSargs) -importFrom(rgdal,checkCRSArgs) -importFrom(rgdal,getPROJ4VersionInfo) -importFrom(rgdal,make_EPSG) -importFrom(rgdal,ogrInfo) -importFrom(rgdal,readOGR) -importFrom(rgdal,writeOGR) -importFrom(rgeos,gArea) -importFrom(rgeos,gBuffer) -importFrom(rgeos,gContains) -importFrom(rgeos,gConvexHull) -importFrom(rgeos,gDifference) -importFrom(rgeos,gIntersection) -importFrom(rgeos,gIsValid) -importFrom(rgeos,gPointOnSurface) -importFrom(rgeos,gUnaryUnion) -importFrom(stats,dnorm) -importFrom(stats,fft) -importFrom(stats,na.omit) -importFrom(stats,runif) -importFrom(stats,weighted.mean) importFrom(units,as_units) importFrom(units,set_units) -importFrom(utils,download.file) -importFrom(utils,head) -importFrom(utils,setTxtProgressBar) -importFrom(utils,tail) -importFrom(utils,txtProgressBar) importFrom(viridisLite,viridis) -importMethodsFrom(raster,as.matrix) -importMethodsFrom(raster,as.vector) diff --git a/NEWS b/NEWS index 1129f55..b1c162e 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,7 @@ -version 2.1 (devel) +version 3 (devel) - added bbox geometry column to output of geocode_OSM when as.sf = TRUE -- stars support for bb and get_projection +- removed hardcoded proj4 shortcuts +- stars support (being implemented) version 2.0-2 - sp-based functions marked as deprecated diff --git a/R/aggregate_map.R b/R/aggregate_map.R deleted file mode 100644 index e0c9731..0000000 --- a/R/aggregate_map.R +++ /dev/null @@ -1,308 +0,0 @@ -first <- function(x, na.rm=FALSE) { - if (!na.rm) x[1] else x[which(!is.na(x))[1]] -} - -last <- function(x, n=length(x), na.rm=FALSE) { - if (!na.rm) x[n] else x[tail(which(!is.na(x)), 1)] -} - -modal <- function(x, na.rm=FALSE) { - ux <- unique(x) - if (na.rm) ux <- na.omit(ux) - ux[which.max(tabulate(match(x, ux)))] -} - -weighted.modal <- function(x, w, na.rm=FALSE) { - isf <- is.factor(x) - isn <- is.numeric(x) - if (!isf) x <- as.factor(x) - - addNA <- !na.rm && any(is.na(x)) - - mx <- max(tapply(w, x, sum), na.rm=TRUE) - wmx <- which.max(tapply(w, x, sum)) - cat <- names(wmx) - - if (addNA) { - nas <- sum(w[is.na(x)]) - if (nas>mx) cat <- NA - } - - if (isf) { - factor(cat, levels=levels(x)) - } else if (isn) { - as.numeric(cat) - } else cat -} - -#' Aggregate map (deprecated) -#' -#' Aggregate spatial polygons, spatial lines or raster objects. For spatial polygons and lines, the units will be merged with the \code{by} variable. For rasters, the \code{fact} parameter determined how many rasters cells are aggregated both horizontally and vertically. Per data variable, an aggregation formula can be specified, by default mean for numeric and modal for categorical varaibles. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' This function is similar to \code{\link[raster:aggregate]{aggregate}} from the \code{raster} package. However, the aggregation can be specified in more detail: weights can be used (e.g. polygon area sizes). Also, an aggregation function can be specified per variable or raster layer. It is also possible to specify a general function for numeric data and a function for categorical data. -#' -#' By default, the data is not aggregated. In this case, this function is similar to \code{unionSpatialPolygons} from the \code{maptools} package. The only difference is way the aggregate-by variable is specified. When using \code{unionSpatialPolygons}, the values have to be assigned to \code{IDs} whereas when using \code{aggregate_map} the data variable name can be assigned to \code{by}. -#' -#' The underlying functions of \code{aggregate_map} for \code{\link[sp:sp]{sp}} objects are \code{\link[rgeos:gUnaryUnion]{gUnaryUnion}}, \code{\link[rgeos:gUnionCascaded]{gUnionCascaded}}, and \code{\link[rgeos:gLineMerge]{gLineMerge}}. For \code{Raster} objects, the \code{\link[raster:aggregate]{aggregate}} is used. -#' -#' This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, the \code{\link[sf:tidyverse]{tidyverse}} methods \code{group_by} and \code{summarize} can be used. -#' -#' @param shp shape object, which is one of -#' \enumerate{ -#' \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} -#' \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -#' \item{\code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}} -#' \item{\code{\link[sp:SpatialPixelsDataFrame]{SpatialPixels(DataFrame)}}} -#' \item{\code{\link[raster:Raster-class]{RasterLayer, RasterStack, or RasterBrick}}} -#' \item{\code{\link[sf:sf]{sf}} object if it can be coerced to an \code{\link[sp:sp]{sp}} object} -#' } -#' @param by variable by which polygons or lines are merged. Does not apply to raster objects. -#' @param fact number that specifies how many cells in both horizontal and vertical direction are merged. Only applied to raster objects. -#' @param agg.fun aggregation function(s). One of the following formats: -#' \enumerate{ -#' \item{One function (name) by which all variables are aggregated.} -#' \item{A vector of two function names called \code{"num"} and \code{"cat"} that determine the functions by which numeric respectively categorical variables are aggregated. For instance \code{c(num="mean", cat="modal")}, which calculates the mean and mode for numeric respectively categorical variables.} -#' \item{A list where per variable the (names of the) function(s) are provided. The list names should correspond to the variable names.} -#' } -#' These predefined functions can be used: \code{"mean"}, \code{"modal"}, \code{"first"}, and \code{"last"}. -#' @param weights name of a numeric variable in \code{shp}. The values serve as weights for the aggregation function. If provided, these values are passed on as second argument. Works with aggregation functions \code{"mean"} and \code{"modal"}. Use \code{"AREA"} for polygon area sizes. -#' @param na.rm passed on to the aggregation function(s) \code{agg.fun}. -#' @param ... other arguments passed on to the aggregation function(s) \code{agg.fun}. -#' @importFrom stats weighted.mean -#' @return A shape object, in the same format as \code{shp} -#' @example ./examples/aggregate_map.R -#' @export -aggregate_map <- function(shp, by=NULL, fact=NULL, agg.fun=NULL, weights=NULL, na.rm=FALSE, ...) { - - .Deprecated("group_by", package = "dplyr", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - weighted.mean <- NULL - - agg.data <- !missing(agg.fun) - - is_f <- inherits(shp, c("sf", "sfc")) - - if (is_f) shp <- as(shp, "Spatial") - - # process aggregation functions - is_raster <- (inherits(shp, c("Raster", "SpatialPixels", "SpatialGrid"))) - shpnms <- names(shp) - - if (!is.null(agg.fun)) { - if (is.list(agg.fun)) { - nms <- names(agg.fun) - if (!(all(nms %in% shpnms))) stop("not all list names of agg.fun are shape variable names") - aggmethod <- "list" - } else if (is.character(agg.fun) && length(agg.fun)>1) { - if (!setequal(names(agg.fun), c("num", "cat"))) stop("the names of agg.fun should be \"num\" and \"cat\"; please use a named list to specify functions per variable") - aggmethod <- "numcat" - } else { - aggmethod <- "one" - } - } else { - if (is_raster) stop("for raster shapes, agg.fun should be defined") - aggmethod <- "none" - } - - - if (is_raster) { - if (missing(fact)) stop("fact is missing") - if (!missing(weights)) stop("weights are not used for raster shapes") - - # keep original class (to reconvert afterwards) - cls <- class(shp) - - # determine levels and set to raster brick - lvls <- get_raster_levels(shp) - if (!inherits(shp, "RasterBrick")) shp <- brick(shp) - - # subset layers - if (aggmethod == "list") { - ids <- match(nms, shpnms) - shp <- raster::subset(shp, ids, drop=FALSE) - lvls <- lvls[ids] - } - - # retrieve build-in functions - get_function <- function(fun) { - # predefined functions - if (is.character(fun)) { - # assign locally defined functions - if (fun=="first") fun <- first - else if (fun=="last") - fun <- last - else if (fun=="modal") fun <- modal - } - fun - } - - # which layers are factors? - isf <- !sapply(lvls, is.null) - - # aggregate raster - if (aggmethod=="numcat") { - - if (any(isf)) { - shp_cat <- raster::subset(shp, subset=which(isf), drop=FALSE) - shp_cat2 <- raster::aggregate(shp_cat, fact=fact, fun=get_function(agg.fun["cat"]), na.rm=na.rm, ...) - } - - if (any(!isf)) { - shp_num <- raster::subset(shp, subset=which(!isf), drop=FALSE) - shp_num2 <- raster::aggregate(shp_num, fact=fact, fun=get_function(agg.fun["num"]), na.rm=na.rm, ...) - } - - if (all(isf)) { - shp2 <- shp_cat2 - } else if (all(!isf)) { - shp2 <- shp_num2 - } else { - # restore order - o <- order(c(which(!isf), which(isf))) - rlayers <- c(lapply(1:nlayers(shp_num), function(i) raster(shp_num2, layer=i)), - lapply(1:nlayers(shp_cat), function(i) raster(shp_cat2, layer=i)))[o] - shp2 <- do.call("brick", rlayers) - } - - } else if (aggmethod=="list") { - rlayers <- mapply(function(var, fun, i) { - raster::aggregate(raster(shp, i), fact=fact, fun=get_function(fun), na.rm=na.rm, ...) - }, names(agg.fun), agg.fun, 1L:length(agg.fun), SIMPLIFY = FALSE, USE.NAMES = FALSE) - shp2 <- do.call("brick", rlayers) - } else { - # so aggmethod=="one" - shp2 <- raster::aggregate(shp, fact=fact, fun=get_function(agg.fun), na.rm=na.rm, ...) - } - - # reset the factor levels as the may have gone lost - if (any(isf)) shp2 <- set_raster_levels(shp2, lvls) - - # reset original class and variable names - if (cls!="RasterBrick") { - shp2 <- as(shp2, cls) - names(shp2) <- names(shp) - } - shp2 - } else { - if (inherits(shp, "SpatialPoints")) stop("SpatialPoints cannot be aggregated") - if (missing(by)) stop("by is missing") - if (!missing(fact)) warning("fact is only used for spatial grid or raster objects") - - if (!(by %in% names(shp))) stop(by, " is not an existing variable name") - - IDs_orig <- shp[[by]] - - IDs_char <- if (storage.mode(IDs_orig) != "character") - as.character(IDs_orig) - else IDs_orig - - IDs_fact <- if (is.factor(IDs_orig)) - IDs_orig - else factor(IDs_orig, levels=unique(IDs_orig)) - - lvls <- levels(IDs_fact) - - - data <- attr(shp, "data") - - data[[by]] <- NULL - - shp2 <- if (inherits(shp, "SpatialLines")) { - rgeos::gLineMerge(spgeom = shp, byid=TRUE, id = IDs_char) - } else if (rgeos::version_GEOS0() < "3.3.0") { - rgeos::gUnionCascaded(spgeom = shp, id = IDs_char) - } else rgeos::gUnaryUnion(spgeom = shp, id = IDs_char) - - # restore order - ids2 <- get_IDs(shp2) - - # get selection of levels that are present - lsel <- lvls %in% ids2 - - - shp2 <- shp2[match(lvls[lsel], ids2), ] - - if (agg.data) { - IDs2_char <- get_IDs(shp2) - IDs2_orig <- if (is.factor(IDs_orig)) factor(IDs2_char, levels=lvls) else IDs2_char - - if (aggmethod=="none") { - data2 <- data.frame(IDs2_orig, stringsAsFactors = FALSE) - names(data2) <- by - } else { - #IDs2_fact <- factor(IDs2_char, levels=IDs2_char) - - if (missing(weights)) { - w <- NULL - } else { - if (!is.character(weights) && !weights %in% names(data)) stop("weights should be a shape variable") - if (length(weights)>1) { - warning("only one variable can be used for weights") - weights <- weights[1] - } - if (weights=="AREA") { - w <- approx_areas(shp) - } else { - w <- shp[[weights[1]]] - if (!is.numeric(w)) stop("weights variable is not numeric") - } - if (any(is.na(w))) stop("weights variable contains missing values") - # normalize weights - w <- w / sum(w) - } - - - # retrieve build-in functions - get_function <- function(fun) { - if (!is.function(fun) && !is.character(fun)) stop("invalid function found in agg.fun") - if (!is.null(w) && is.character(fun)) { - # assign locally defined functions - if (fun=="mean") { - fun <- stats::weighted.mean - } else if (fun=="modal") { - fun <- weighted.modal - } - } else if (identical(fun, mean)) { - fun <- stats::weighted.mean - } - fun - } - - if (aggmethod=="numcat") { - isnum <- sapply(data, is.numeric) - agg.fun <- lapply(1:ncol(data), function(i) { - agg.fun[ifelse(isnum[i], "num", "cat")] - }) - names(agg.fun) <- names(data) - } else if (aggmethod=="one") { - agg.fun <- lapply(1:ncol(data), function(i) { - agg.fun - }) - names(agg.fun) <- names(data) - } - - vars <- mapply(function(var, fun) { - dv <- data[[var]] - v <- if (is.null(w)) { - as.vector(tapply(X = dv, INDEX = IDs_fact, FUN = get_function(fun), na.rm=na.rm))[lsel] - } else { - dvs <- split(as.integer(dv), IDs_fact) - ws <- split(w, IDs_fact) - ws <- lapply(ws, function(wss) { - wss <- wss / sum(wss) - }) - unlist(mapply(dvs, ws, FUN = get_function(fun), MoreArgs = c(list(na.rm=na.rm), list(...)), SIMPLIFY = FALSE, USE.NAMES = FALSE))[lsel] - } - if (is.factor(dv)) factor(v, levels=1L:nlevels(dv), labels=levels(dv)) else v - }, names(agg.fun), agg.fun, SIMPLIFY = FALSE, USE.NAMES = FALSE) - - lst2 <- c(list(IDs2_orig), vars, list(FALSE)) - names(lst2) <- c(by, names(agg.fun), "stringsAsFactors") - - data2 <- do.call(data.frame, lst2) - } - shp2 <- append_data(shp2, data=data2, fixed.order=TRUE) - } - if (is_f) as(shp2, "sf") else shp2 - } -} diff --git a/R/append_data.R b/R/append_data.R deleted file mode 100644 index 6d21108..0000000 --- a/R/append_data.R +++ /dev/null @@ -1,205 +0,0 @@ -#' Append data to a shape object (deprecated) -#' -#' Data, in the format of a data.frame, is appended to a shape object. This is either done by a left join where keys are specified for both shape and data, or by fixed order. Under coverage (shape items that do not correspond to data records), over coverage (data records that do not correspond to shape items respectively) as well as the existence of duplicated key values are automatically checked and reported via console messages. With \code{under_coverage} and \code{over_coverage} the under and over coverage key values from the last \code{append_data} call can be retrieved. Tip: run \code{append_data} without assigning the result to check the coverage. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' This function supports \code{sf} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, the \code{\link[sf:tidyverse]{tidyverse}} method \code{left_join} can be used. -#' -#' @param shp shape object, which is one of -#' \enumerate{ -#' \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} -#' \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} -#' \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -#' \item{\code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}} -#' \item{\code{\link[sp:SpatialPixelsDataFrame]{SpatialPixels(DataFrame)}}} -#' \item{\code{\link[sf:sf]{sf}} object that can be coerced as one above} -#' } -#' @param data data.frame -#' @param key.shp variable name of \code{shp} map data to be matched with \code{key.data}. If not specified, and \code{fixed.order} is \code{FALSE}, the ID's of the polygons/lines/points are taken. -#' @param key.data variable name of \code{data} to be matched with \code{key.shp}. If not specified, and \code{fixed.order} is \code{FALSE}, the row names of \code{data} are taken. -#' @param ignore.duplicates should duplicated keys in \code{data} be ignored? (\code{FALSE} by default) -#' @param ignore.na should NA values in \code{key.data} and \code{key.shp} be ignored? (\code{FALSE} by default) -#' @param fixed.order should the data be append in the same order as the shapes in \code{shp}? -#' @return Shape object with appended data. Tip: run \code{append_data} without assigning the result to check the coverage. -#' @example ./examples/append_data.R -#' @rdname append_data -#' @export -append_data <- function(shp, data, key.shp = NULL, key.data = NULL, ignore.duplicates=FALSE, ignore.na=FALSE, fixed.order=is.null(key.data) && is.null(key.shp)) { - .Deprecated("left_join", package = "dplyr", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - is_sf <- inherits(shp, c("sf", "sfc")) - if (is_sf) shp <- as(shp, "Spatial") - - spatialDF <- inherits(shp, c("SpatialPolygonsDataFrame", "SpatialPointsDataFrame", "SpatialLinesDataFrame", "SpatialGridDataFrame", "SpatialPixelsDataFrame")) - - callAD <- deparse(match.call()) - - dataName <- deparse(substitute(data)) - shpName <- deparse(substitute(shp)) - - if (fixed.order) { - if (length(shp)!=nrow(data)) - stop("Number of shapes not equal to number of data rows") - data2 <- data - } else { - # key.data specification - if (missing(key.data)) { - message("No key.data specified. Therefore, rownames are taken as keys.\n") - ids.data <- rownames(data) - } else { - if (!key.data %in% names(data)) stop("Variable \"", key.data, "\" not found in ", dataName, ".") - ids.data <- as.character(data[[key.data]]) - } - - # key.data remove duplicates - if (any(duplicated(ids.data))) { - duplicated_data <- unique(ids.data[duplicated(ids.data)]) - if (length(duplicated_data) >= 20) { - duplicated_data <- paste0(paste(head(duplicated_data, 10), collapse=", "), ", ...") - } else { - duplicated_data <- paste(duplicated_data, collapse=", ") - } - if (ignore.duplicates) { - message("Data contains duplicated keys: ", duplicated_data) - data_ID <- which(!duplicated(ids.data)) - data <- data[data_ID, ] - ids.data <- ids.data[data_ID] - } else stop("Data contains duplicated keys: ", duplicated_data, - ". Set ignore.duplicates=TRUE to ignore duplicates in data.") - } else { - data_ID <- 1L:nrow(data) - } - - # key.data any NA? - if (any(is.na(ids.data))) { - if (ignore.na) { - message(dataName, " key variable \"", key.data, "\" contains NA's, which are ignored") - ids.data[is.na(ids.data)] <- "data_key_NA" - } else { - stop("Data key contains NA's. Set ignore.na = TRUE to ignore them.") - } - } - - # key.shp specification - if (missing(key.shp)) { - # if key.shp is NULL, then take the polygon id's - ids.shp <- get_IDs(shp) - } else { - # use the key.shp variable of shp@data - if (!spatialDF) - stop(shpName, " is not a Spatial*DataFrame, while key.shp is specified") - if (!key.shp %in% names(shp@data)) - stop("Variable \"", key.shp, "\" not found in ", shpName, "@data") - ids.shp <- as.character(shp@data[[key.shp]]) - } - - # key.shp check duplicates - if (any(duplicated(ids.shp))) { - duplicated_shp <- unique(ids.shp[duplicated(ids.shp)]) - if (length(duplicated_shp) >= 20) { - duplicated_shp <- c(paste(head(duplicated_shp, 10), collapse=", "), ", ...") - } else { - duplicated_shp <- paste(duplicated_shp, collapse=", ") - } - message(shpName, " key variable \"", key.shp, "\" contains duplicated keys:", duplicated_shp, "\n") - } - - # key.shp any NA? - if (any(is.na(ids.shp))) { - if (ignore.na) { - message(shpName, " key variable \"", key.shp ,"\" contains NA's, which are ignored") - ids.shp[is.na(ids.shp)] <- "shp_key_NA" - } else { - stop(shpName, " key variable \"", key.shp ,"\" contains NA's. Set ignore.na = TRUE to ignore them.") - } - } - - # prepare data - data2 <- data[match(ids.shp, ids.data),] - - data2[[key.data]] <- NULL - - # check coverage - uc_id <- which(!(ids.shp %in% ids.data)) - oc_id <- which(!(ids.data %in% ids.shp)) - - ndata <- nrow(data) - nshp <- length(shp) - - #ids.data <- setdiff(ids.data, "data_key_NA") - #ids.shp <- setdiff(ids.shp, "shp_key_NA") - if (length(uc_id)==0 && length(oc_id)==0) { - message("Keys match perfectly.\n") - uc_res <- "No under coverage: each shape feature has appended data." - oc_res <- "No over coverage: each data record is appended to a shape feature." - } else { - if (length(uc_id)) { - nnm <- length(uc_id) - if (nnm==nshp) stop("No match found") - uc_res <- paste("Under coverage: ", nnm, " out of ", nshp, " shape features did not get appended data." , sep="") - message(uc_res, " Run under_coverage() to get the corresponding feature id numbers and key values.") - } else { - uc_res <- "No under coverage: each shape feature has appended data." - } - if (length(oc_id)) { - nnm <- length(oc_id) - oc_res <- paste("Over coverage: ", nnm, " out of ", ndata, " data records were not appended.", sep="") - message(oc_res, " Run over_coverage() to get the corresponding data row numbers and key values.") - } else { - oc_res <- "No over coverage: each data record is appended to a shape feature." - } - } - assign(".underCoverage", list(result=uc_res, call=callAD, id=uc_id, value=shp@data[uc_id, key.shp]), envir = .TMAPTOOLS_CACHE) - assign(".overCoverage", list(result=oc_res, call=callAD, id=data_ID[oc_id], value=data[oc_id, ][[key.data]]), envir = .TMAPTOOLS_CACHE) - - } - - # attach data to shp - if (spatialDF) { - doubleNames <- names(data2) %in% names(shp@data) - names(data2)[doubleNames] <- paste(names(data2)[doubleNames], ".data", sep="") - shp@data <- cbind(shp@data, data2) - } else if (inherits(shp, "SpatialPolygons")) { - shp <- SpatialPolygonsDataFrame(shp, data2, match.ID = FALSE) - } else if (inherits(shp, "SpatialPoints")) { - shp <- SpatialPointsDataFrame(shp, data2, match.ID = FALSE) - } else if (inherits(shp, "SpatialLines")) { - shp <- SpatialLinesDataFrame(shp, data2, match.ID = FALSE) - } else if (inherits(shp, "SpatialGrid")) { - shp <- SpatialGridDataFrame(shp, data2) - } else if (inherits(shp, "SpatialPixels")) { - shp <- SpatialPixelsDataFrame(shp, data2) - } else { - stop("shp is not a shape file") - } - if (is_sf) shp <- as(shp, "sf") - - invisible(shp) -} - -#' @rdname append_data -#' @export -under_coverage <- function() { - .Deprecated("left_join", package = "dplyr", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - res <- get(".underCoverage", envir = .TMAPTOOLS_CACHE) - if (is.null(res)) { - message("Function append_data not called yet.") - invisible() - } else { - #if (length(res$id)==0) message("No under coverage: each shape feature has appended data.") - res - } -} - -#' @export -#' @rdname append_data -over_coverage <- function() { - .Deprecated("left_join", package = "dplyr", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - res <- get(".overCoverage", envir = .TMAPTOOLS_CACHE) - if (is.null(res)) { - message("Function append_data not called yet.") - invisible() - } else { - #if (length(res$id)==0) message("No over coverage: each data record is appended to a shape feature.") - res - } -} diff --git a/R/approx_areas.R b/R/approx_areas.R index 3bd32b4..90c9bb0 100755 --- a/R/approx_areas.R +++ b/R/approx_areas.R @@ -17,7 +17,6 @@ #' @return Numeric vector of area sizes (class \code{\link[units:units]{units}}). #' @example ./examples/approx_areas.R #' @seealso \code{\link{approx_distances}} -#' @importFrom rgeos gArea #' @importFrom units set_units as_units #' @importFrom lwgeom st_transform_proj st_geod_area #' @export @@ -52,65 +51,3 @@ approx_areas <- function(shp, target="metric", total.area=NULL) { areas } -#' -#' -# approx_areas <- function(shp, target="metric", orig=NA, to=NA, total.area=NA, show.warnings=TRUE) { -# -# is_metric <- target=="metric" -# is_imperial <- target=="imperial" -# -# if (is_metric) target <- "km" -# if (is_imperial) target <- "mi" -# -# if (!(target %in% c("abs", "prop", "norm"))) { -# res <- projection_units(get_projection(shp), target=target, orig=orig, to=to) -# -# projected <- res$projected -# newtarget <- res$target -# orig <- res$orig -# to <- res$to -# } else { -# projected <- is_projected(shp) -# newtarget <- target -# } -# -# # determine area sizes and corresponding units -# if (projected) { -# x <- rgeos::gArea(shp, byid = TRUE) -# } else { -# x <- geosphere::areaPolygon(shp) -# orig <- "m" -# to <- to_m["m"] / to_m[newtarget] -# } -# -# if (!(target %in% c("abs", "prop", "norm")) && is.na(to)) { -# if (show.warnings) warning("Target unit or original unit unknown. Please specify valid the arguments target and orig, or the argument to") -# target <- "abs" -# } -# -# if (any(is.na(x)) || any(is.infinite(x))) { -# naid <- sort(union(which(is.na(x)), which(is.infinite(x)))) -# if (show.warnings) warning("cannot determine area of polygon(s) ", paste(naid, collapse=",")) -# } -# -# if (is.na(total.area)) total.area <- sum(x, na.rm = TRUE) * (to^2) -# denom <- switch(target, norm=max(x), prop=sum(x), abs=1, sum(x, na.rm = TRUE)/total.area) -# x2 <- x / denom -# -# # revert back to meters or feet is needed -# if (is_metric) { -# if (max(x2, na.rm = TRUE) < 1) { -# x2 <- x2 * 1e6 -# newtarget <- "m" -# } -# } else if (is_imperial) { -# if (max(x2, na.rm = TRUE) < 1) { -# x2 <- x2 * 27878400 -# newtarget <- "ft" -# } -# } -# -# if (!(target %in% c("abs", "prop", "norm"))) newtarget <- paste("sq", newtarget) -# attr(x2, "unit") <- newtarget -# x2 -# } diff --git a/R/approx_distances.R b/R/approx_distances.R index f4387b5..079e22e 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -26,11 +26,9 @@ approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { if (missing(projection)) { projection <- st_crs(NA) #stop("Please specify projection") - } else { - projection <- get_proj4(projection, output = "crs") } } else { - projection <- get_projection(x, output = "crs") + projection <- st_crs(x) } if (is.na(projection)) { @@ -80,128 +78,3 @@ get_distance <- function(p1, p2) { lwgeom::st_geod_distance(p1ll, p2ll)[1,1] }) } - - - -#' -#' -# approx_distances <- function(x, y = NULL, projection = NULL, target="metric", orig=NA, to=NA, show.warnings=TRUE) { -# ## set metric and imperial to defaults: km and mi -# is_metric <- target=="metric" -# is_imperial <- target=="imperial" -# -# if (is_metric) target <- "km" -# if (is_imperial) target <- "mi" -# -# if (inherits(x, c("Spatial", "Raster", "sf", "sfc"))) { -# ## get projection and bounding box for spatial objects -# prj <- get_projection(x, as.CRS=FALSE, guess.longlat = TRUE) -# if (is.na(prj) && missing(projection)) stop("shape projection unknown; please specify it") -# if (!is.na(prj) && !missing(projection)) warning("projection already defined in shape") -# -# if (is.na(prj)) prj <- get_projection(projection, as.CRS = FALSE) -# bbx <- bb(x) -# if (!missing(y)) { -# warning("y is only used if x is a pair of coordinates") -# y <- NULL -# } -# } else { -# ## get projection and bounding box for points and bounding boxes. Guess projection -# if (is.vector(x) && length(x)==2) { -# if (missing(y)) stop("y is required") -# if (!is.vector(y) || length(y)!=2) stop("y is not a vector of 2") -# bbx <- matrix(c(x, y), ncol=2, byrow = FALSE) -# } else { -# bbx <- bb(x) -# if (!missing(y)) { -# if (show.warnings) warning("y is only used if x is a pair of coordinates") -# y <- NULL -# } -# } -# if (missing(projection)) { -# if (maybe_longlat(bbx)) { -# prj <- get_proj4("longlat") -# } else { -# if (show.warnings) warning("projection unknown") -# prj <- NA -# } -# } else { -# prj <- get_proj4(projection, as.CRS = FALSE) -# } -# } -# -# ## Get projection info -# res <- projection_units(x=prj, target = target, orig=orig, to=to) -# projected <- res$projected -# target <- res$target -# orig <- res$orig -# to <- res$to -# -# ## For non-projected case, units of coordinates will be meters (distGeo) -# if (!projected) { -# orig <- "m" -# to <- to_m["m"] / to_m[target] -# } else if (is.na(to)) { -# if (show.warnings) warning("Target unit or original unit unknown. Please specify valid the arguments target and orig, or the argument to") -# target <- "abs" -# to <- 1 -# is_metric <- FALSE -# is_imperial <- FALSE -# } -# -# -# if (is.null(y)) { -# if (projected) { -# vdist <- (bbx[4] - bbx[2]) * to -# hdist <- (bbx[3] - bbx[1]) * to -# } else { -# # also add middle values to prevent the shortest route is reverse -# h <- c(bbx[1], mean(c(bbx[1], bbx[3])), bbx[3]) -# v <- c(bbx[2], mean(c(bbx[2], bbx[4])), bbx[4]) -# hdist <- (geosphere::distGeo(c(h[1], v[2]), c(h[2], v[2])) + geosphere::distGeo(c(h[2], v[2]), c(h[3], v[2]))) * to -# vdist <- (geosphere::distGeo(c(h[2], v[1]), c(h[2], v[2])) + geosphere::distGeo(c(h[2], v[2]), c(h[2], v[3]))) * to -# } -# if (is_metric) { -# if (hdist < 1 || vdist < 1) { -# hdist <- hdist * 1000 -# vdist <- vdist * 1000 -# target <- "m" -# } -# } else if (is_imperial) { -# if (hdist < 1 || vdist < 1) { -# hdist <- hdist * 5280 -# vdist <- vdist * 5280 -# target <- "ft" -# } -# } -# -# list(unit=target, -# hdist=hdist, -# vdist=vdist) -# -# } else { -# if (projected) { -# #to_meter <- get_shape_units(projection = prj)$to_meter -# xd <- y[1] - x[1] -# yd <- y[2] - x[2] -# dist <- unname(sqrt(xd^2+yd^2)) * to -# } else { -# dist <- geosphere::distGeo(x, y) * to -# } -# -# if (is_metric) { -# if (dist < 1) { -# dist <- dist * 1000 -# target <- "m" -# } -# } else if (is_imperial) { -# if (dist < 1) { -# dist <- dist * 5280 -# target <- "ft" -# } -# } -# -# list(unit=target, -# dist=dist) -# } -# } diff --git a/R/bb.R b/R/bb.R index c34aae7..43c9482 100755 --- a/R/bb.R +++ b/R/bb.R @@ -29,8 +29,8 @@ #' @param xlim limits of the x-axis. These are either absolute or relative (depending on the argument \code{relative}). #' @param ylim limits of the y-axis. See \code{xlim}. #' @param relative boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}. -#' @param current.projection projection that corresponds to the bounding box specified by \code{x}. See \code{\link{get_proj4}} for options. -#' @param projection projection to transform the bounding box to. See \code{\link{get_proj4}} for options. +#' @param current.projection projection that corresponds to the bounding box specified by \code{x}. +#' @param projection projection to transform the bounding box to. #' @param output output format of the bounding box, one of: #' \itemize{ #' \item \code{"bbox"} a \code{sf::bbox} object, which is a numeric vector of 4: xmin, ymin, xmax, ymax. This representation used by the \code{\link[sf:sf]{sf}} package. @@ -41,12 +41,15 @@ #' @import sp #' @importFrom raster extent #' @importFrom XML xmlTreeParse xmlChildren xmlRoot xmlAttrs -#' @importFrom rgeos gIntersection #' @example ./examples/bb.R #' @seealso \code{\link{geocode_OSM}} #' @export bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim=NULL, relative = FALSE, current.projection=NULL, projection=NULL, output = c("bbox", "matrix", "extent")) { + # check projections + if (!is.null(current.projection)) current.projection <- sf::st_crs(current.projection) + if (!is.null(projection)) projection <- sf::st_crs(projection) + ## get unprocessed bounding box res <- get_bb(x, cx=cx, cy=cy, width=width, height=height, xlim=xlim, ylim=ylim, current.projection=current.projection) b <- res$b @@ -133,8 +136,7 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N } warning("Current projection unknown. Long lat coordinates (wgs84) assumed.", call. = FALSE) current.projection <- .crs_longlat - } else current.projection <- get_proj4(current.projection, output = "crs") - projection <- get_proj4(projection, output = "crs") + } sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) @@ -174,11 +176,11 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N b <- sf::st_bbox(sf_pnts2_prj) - is_prj <- is_projected(projection) + is_prj <- !sf::st_is_longlat(projection) } else { is_prj <- if (is.na(current.projection)) { !maybe_longlat(b) - } else is_projected(current.projection) + } else !sf::st_is_longlat(current.projection) if (is.na(current.projection) && !is_prj) current.projection <- .crs_longlat } @@ -196,7 +198,7 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N if (output == "bbox") { if (!inherits(b, "bbox")) { b <- unname(b) - b <- st_bbox(c(xmin = b[1], ymin = b[2], xmax = b[3], ymax = b[4]), crs = st_crs(current.projection)) + b <- sf::st_bbox(c(xmin = b[1], ymin = b[2], xmax = b[3], ymax = b[4]), crs = sf::st_crs(current.projection)) } } else if (output == "matrix") { b <- matrix(b, ncol=2, dimnames = list(c("x", "y"), c("min", "max"))) @@ -214,10 +216,10 @@ get_sf_bbox <- function(shp) { sfbb <- function(bb) { if (is.matrix(bb)) { bb <- unname(as.vector(bb)) - st_bbox(c(xmin = bb[1], ymin = bb[2], xmax = bb[3], ymax = bb[4]), crs = st_crs(NA)) + sf::st_bbox(c(xmin = bb[1], ymin = bb[2], xmax = bb[3], ymax = bb[4]), crs = sf::st_crs(NA)) } else if (inherits(bb, "Extent")) { bb <- unname(as.vector(bb)) - st_bbox(c(xmin = bb[1], ymin = bb[3], xmax = bb[2], ymax = bb[4]), crs = st_crs(NA)) + sf::st_bbox(c(xmin = bb[1], ymin = bb[3], xmax = bb[2], ymax = bb[4]), crs = sf::st_crs(NA)) } else stop("bb not 2x2 matrix nor extent object") } @@ -238,15 +240,15 @@ get_bb <- function(x, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim b <- sfbb(attr(x, "bbox")) current.projection <- get_projection(x, output = "crs") } else if (inherits(x, c("sf", "sfc", "stars"))) { - b <- st_bbox(x) - current.projection <- st_crs(x) + b <- sf::st_bbox(x) + current.projection <- sf::st_crs(x) } else if (is.matrix(x) && length(x)==4) { b <- sfbb(x) } else if (inherits(x, "bbox")) { b <- x } else if (is.vector(x) && length(x)==4) { x <- unname(check_bb_order(x)) - b <- st_bbox(c(xmin = x[1], ymin = x[2], xmax = x[3], ymax = x[4]), crs = st_crs(NA)) + b <- sf::st_bbox(c(xmin = x[1], ymin = x[2], xmax = x[3], ymax = x[4]), crs = sf::st_crs(NA)) } else if (!is.na(x)[1]) { stop("Incorrect x argument") } else { @@ -255,10 +257,10 @@ get_bb <- function(x, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim ## create new bounding box if (is.null(xlim)) xlim <- cx + c(-.5, .5) * width if (is.null(ylim)) ylim <- cy + c(-.5, .5) * height - b <- st_bbox(c(xmin = xlim[1], ymin = ylim[1], xmax = xlim[2], ymax = ylim[2]), crs = st_crs(NA)) + b <- sf::st_bbox(c(xmin = xlim[1], ymin = ylim[1], xmax = xlim[2], ymax = ylim[2]), crs = sf::st_crs(NA)) } - if (is.null(current.projection)) current.projection <- st_crs(NA) + if (is.null(current.projection)) current.projection <- sf::st_crs(NA) if (!is.na(current.projection)) { attr(b, "crs") <- current.projection } else if (!is.na(attr(b, "crs"))) { @@ -281,3 +283,8 @@ check_bb_order <- function(x) { x[c(1,3,2,4)] } else x } + +maybe_longlat <- function(bb) { + (bb[1] >= -180.1 && bb[3] <= 180.1 && bb[2] >= -90.1 && bb[4] <= 90.1) +} + diff --git a/R/bb_poly.R b/R/bb_poly.R index 4fa0335..3715da4 100755 --- a/R/bb_poly.R +++ b/R/bb_poly.R @@ -3,10 +3,10 @@ #' Convert bounding box to a spatial (\code{\link[sf:st_sfc]{sfc}}) object . Useful for plotting (see example). The function \code{bb_earth} returns a spatial polygon of the 'boundaries' of the earth, which can also be done in other projections (if a feasible solution exists). #' #' @param x object that can be coerced to a bounding box with \code{\link{bb}} -#' @param projection projection in which the coordinates of \code{x} are provided, see \code{\link{get_proj4}}. For \code{bb_earth}, \code{projection} is the projection in which the bounding box is returned (if possible). +#' @param projection projection in which the coordinates of \code{x} are provided. For \code{bb_earth}, \code{projection} is the projection in which the bounding box is returned (if possible). #' @param steps number of intermediate points along the shortest edge of the bounding box. The number of intermediate points along the longest edge scales with the aspect ratio. These intermediate points are needed if the bounding box is plotted in another projection. #' @param stepsize stepsize in terms of coordinates (usually meters when the shape is projected and degrees of longlat coordinates are used). If specified, it overrules \code{steps} -#' @param earth.datum Geodetic datum to determine the earth boundary. By default \code{"WGS84"}, other frequently used datums are \code{"NAD83"} and \code{"NAD27"}. Any other \code{PROJ.4} character string can be used. See \code{\link{get_proj4}}. +#' @param earth.datum Geodetic datum to determine the earth boundary. By default EPSG 4326. #' @param bbx boundig box of the earth in a vector of 4 values: min longitude, max longitude, min latitude, max latitude. By default \code{c(-180, 180, -90, 90)}. If for some \code{projection}, a feasible solution does not exist, it may be wise to choose a smaller bbx, e.g. \code{c(-180, 180, -88, 88)}. However, this is also automatically done with the next argument, \code{buffer}. #' @param buffer In order to determine feasible earth bounding boxes in other projections, a buffer is used to decrease the bounding box by a small margin (default \code{1e-06}). This value is subtracted from each the bounding box coordinates. If it still does not result in a feasible bounding box, this procedure is repeated 5 times, where each time the buffer is multiplied by 10. Set \code{buffer=0} to disable this procedure. #' @return \code{\link[sf:st_sfc]{sfc}} object @@ -58,11 +58,12 @@ create_sf_rect <- function(bbx, steps=100, stepsize=NA, projection=NULL) { #' @rdname bb_poly #' @export bb_earth <- function(projection=NULL, stepsize=1, earth.datum=4326, bbx=c(-180, -90, 180, 90), buffer=1e-6) { - crs_datum <- get_proj4(earth.datum, output = "crs") - if (missing(projection)) - projection <- NA - else - projection <- get_proj4(projection, output = "crs") + crs_datum <- sf::st_crs(earth.datum) + if (missing(projection)) { + projection <- sf::st_crs(NA) + } else { + projection <- sf::st_crs(projection) + } if (buffer==0) { bs <- 0 diff --git a/R/calc_densities.R b/R/calc_densities.R index 0843a05..7355225 100644 --- a/R/calc_densities.R +++ b/R/calc_densities.R @@ -9,7 +9,7 @@ #' @param suffix character that is appended to the variable names. The resulting names are used as column names of the returned data.frame. By default, \code{_sq_}, where target corresponds to the target unit, e.g. \code{_sq_km} #' @param drop boolean that determines whether an one-column data-frame should be returned as a vector #' @keywords densities -#' @return Vector or data.frame (depending on whether \code{length(var)==1} with density values. This can be appended directly to the shape file with \code{\link{append_data}} with \code{fixed.order=TRUE}. +#' @return Vector or data.frame (depending on whether \code{length(var)==1} with density values. #' @example ./examples/calc_densities.R #' @export calc_densities <- function(shp, var, target="metric", total.area=NULL, suffix=NA, drop=TRUE) { @@ -25,7 +25,7 @@ calc_densities <- function(shp, var, target="metric", total.area=NULL, suffix=NA if (is.na(suffix)) suffix <- paste("_", sub(" ", replacement = "_", areas_unit), sep = "") ## calculate and return densities - shp <- st_set_geometry(shp, NULL) + shp <- sf::st_set_geometry(shp, NULL) if (length(var)==1 && drop) return(shp[[var]] / areas) diff --git a/R/crop_shape.R b/R/crop_shape.R index c93770c..ebcbb30 100755 --- a/R/crop_shape.R +++ b/R/crop_shape.R @@ -19,44 +19,37 @@ crop_shape <- function(x, y, polygon = FALSE, ...) { xname <- deparse(substitute(x)) yname <- deparse(substitute(y)) - # check and convert x (to sf or brick) - is_sp <- inherits(x, "Spatial") - is_sp_raster <- inherits(x, c("SpatialGrid", "SpatialPixels")) - if (is_sp) x <- (if (is_sp_raster) brick(x) else as(x, "sf")) - israsterx <- inherits(x, "Raster") + x <- to_sf_stars(x) + israsterx <- inherits(x, "stars") + px <- sf::st_crs(x) - if (!inherits(x, c("sf", "sfc", "Raster"))) stop(xname, " is not a sf/Spatial/Raster object.", call.=FALSE) + if (inherits(y, c("sf", "sfc", "stars", "Spatial", "Raster"))) { + y <- to_sf_stars(y) + israstery <- inherits(y, "stars") + py <- sf::st_crs(y) + polycut <- polygon && !israstery - px <- get_projection(x) - - # check and convert y (to sf or brick) - is_sp_y <- inherits(y, "Spatial") - is_sp_raster_y <- inherits(y, c("SpatialGrid", "SpatialPixels")) - if (is_sp_y) y <- (if (is_sp_raster_y) brick(y) else as(y, "sf")) - israstery <- inherits(y, "Raster") + # align projections + if (!is.na(px) && !is.na(py)) { + if (px!=py) { + y <- sf::st_transform(y, crs = px) + } + } + if (!polycut) { + y <- bb(y) + } - polycut <- polygon && !israstery # && !inherits(x, c("Raster", "SpatialGrid")) + } else { + israstery <- FALSE + polycut <- FALSE + y <- tryCatch({ + bb(y) + }, error=function(e){ + stop(yname, " is not a shape and cannot be coerced by bb") + }) - if (inherits(y, c("Raster", "sf"))) { - py <- get_projection(y) - - # align projections - if (!is.na(px) && !is.na(py)) { - if (px!=py) { - y <- set_projection(y, projection = px) - } - } - if (!polycut) { - y <- bb(y) - } - } else { - y <- tryCatch({ - bb(y) - }, error=function(e){ - stop(yname, " is not a shape and cannot be coerced by bb") - }) - } + } if (polycut) { if (inherits(y, "bbox")) y <- create_sf_rect(y) @@ -64,8 +57,9 @@ crop_shape <- function(x, y, polygon = FALSE, ...) { yunion <- st_union(y) ## REQUIRE SP if (israsterx) { - yunion <- as(yunion, "Spatial") - x2 <- raster::trim(raster::mask(x, yunion)) + stop("Rasterized method not implemented yet") + #yunion <- as(yunion, "Spatial") + #x2 <- raster::trim(raster::mask(x, yunion)) } else { x2 <- suppressMessages(suppressWarnings(st_intersection(x, yunion))) } @@ -74,13 +68,13 @@ crop_shape <- function(x, y, polygon = FALSE, ...) { # bounding box crop (suppress warnings, because projections may not be perfectly identical) if (israsterx) { - y <- bb(y, output = "extent") - x2 <- suppressWarnings(crop(x, y, ...)) + stop("Rasterized method not implemented yet") + # y <- bb(y, output = "extent") + # x2 <- suppressWarnings(crop(x, y, ...)) } else { y <- create_sf_rect(y) x2 <- suppressMessages(suppressWarnings(st_intersection(x, y))) } } - x2 } diff --git a/R/deprecated.R b/R/deprecated.R index a094b2b..c2710ae 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -1,11 +1,27 @@ #' Deprecated tmaptools functions #' -#' The following functions are not used anymore or deprecated as of tmaptools version 2.0 +#' The following functions are not used anymore or deprecated as of tmaptools version 3.0. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} #' +#' @param x see documentation in tmaptools 2.x for details +#' @param shp see documentation in tmaptools 2.x for details +#' @param output see documentation in tmaptools 2.x for details +#' @param projection see documentation in tmaptools 2.x for details +#' @param current.projection see documentation in tmaptools 2.x for details +#' @param overwrite.current.projection see documentation in tmaptools 2.x for details +#' @param guess.longlat see documentation in tmaptools 2.x for details +#' +#' Deprecated as of version 2.0 +#' \itemize{ +#' \item \code{append_data}, \code{aggregate_map}, \code{double_line}, \code{points_to_raster}, \code{poly_to_raster}, \code{sample_dots}, \code{sbind}, \code{smooth_map}, \code{smooth_raster_cover}, \code{read_shape}, \code{write_shape}. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} +#' \item \code{osm_poly}, \code{osm_line}, \code{osm_point}. Please use the package \code{osmdata} +#' } +#' +#' Deprecated as of version 3.0 #' \itemize{ -#' \item \code{osm_poly}: for reading vector OSM data, use the \code{osmdata} package -#' \item \code{osm_line}: for reading vector OSM data, use the \code{osmdata} package -#' \item \code{osm_point}: for reading vector OSM data, use the \code{osmdata} package +#' \item \code{get_proj4}: for projections, please use the function \code{\link[sf:st_crs]{st_crs}} +#' \item \code{set_projection} for setting map projections, use \code{\link[sf:st_crs]{st_crs}} or \code{\link[sf:st_transform]{st_transform}} +#' \item \code{get_projection} for getting map projections, use \code{\link[sf:st_crs]{st_crs}} +#' \item \code{is_projected} for checking if projections are long lat coordinates, use \code{\link[sf:st_is_longlat]{st_is_longlat}} #' } #' #' @rdname deprecated_functions @@ -13,25 +29,76 @@ NULL #' @rdname deprecated_functions -#' @name osm_poly +#' @name get_proj4 +#' @keywords internal +#' @export +get_proj4 <- function(x, output = c("crs", "character", "epsg", "CRS")) { + warning("get_proj4 is deprecated; for projections, please use the function st_crs from the sf package") + output <- match.arg(output) + crs <- sf::st_crs(x) + + if (output == "crs") { + crs + } else if (output == "character") { + crs$proj4string + } else if (output == "epsg") { + crs$epsg + } else if (output == "CRS") { + stop("output CRS not supported anymore") + } else { + stop("Unknown output") + } +} + + +#' @rdname deprecated_functions +#' @name set_projection #' @keywords internal #' @export -osm_poly <- function() { - stop("for reading vector OSM data, use the osmdata package") +set_projection <- function(shp, projection=NA, current.projection=NA, overwrite.current.projection=FALSE) { + warning("set_projection is deprecated; for projections, please use the functions st_crs or st_transform from the sf package") + if (!is.na(current.projection)) { + if (!is.na(sf::st_crs(shp)) && !overwrite.current.projection) stop("Current projection already known. Use overwrite.current.projection = TRUE") + sf::st_crs(shp) <- sf::st_crs(current.projection) + } + + if (!is.na(projection)) { + shp <- sf::st_transform(shp, crs = sf::st_crs(projection)) + } + shp } #' @rdname deprecated_functions -#' @name osm_line +#' @name get_projection #' @keywords internal #' @export -osm_line <- function() { - stop("for reading vector OSM data, use the osmdata package") +get_projection <- function(shp, guess.longlat=FALSE, + output = c("character", "crs", "epsg", "CRS")) { + warning("get_projection is deprecated; for projections, please use the function st_crs from the sf package") + + p <- if (inherits(shp, c("sf", "sfc", "stars"))) { + st_crs(shp) + } else if (inherits(shp, "Spatial")) { + st_crs(attr(attr(shp, "proj4string"), "projargs")) + } else if (inherits(shp, "Raster")) { + st_crs(attr(attr(shp, "crs"), "projargs")) + } else { + stop("shp is neither an sf, sp, raster, nor a stars object") + } + + output <- match.arg(output) + if (output == "CRS") stop("output CRS not supported anymore") + switch(output, + character = p$proj4string, + crs = p, + epsg = p$epsg) } #' @rdname deprecated_functions -#' @name osm_point +#' @name is_projected #' @keywords internal #' @export -osm_point <- function() { - stop("for reading vector OSM data, use the osmdata package") +is_projected <- function(x) { + warning("is_projected is deprecated; for projections, please use the function st_is_longlat from the sf package") + !sf::st_is_longlat(x) } diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index f2f06cf..a680f73 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -20,7 +20,6 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS addr <- paste0(server, "/search?q=", q2, "&format=xml&polygon=0&addressdetails=0") project <- !missing(projection) - if (project) projection <- get_proj4(projection, output = "crs") if (is.na(as.data.frame)) as.data.frame <- (n>1) @@ -67,14 +66,14 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS names(coords) <- c("x", "y") } else { - b <- bb(xlim=search_result_bb[3:4], ylim=search_result_bb[1:2], current.projection = .CRS_longlat, projection=projection) + b <- bb(xlim=search_result_bb[3:4], ylim=search_result_bb[1:2], current.projection = .crs_longlat, projection=projection) search_result_bb <- b[c(2,4,1,3)] names(search_result_bb) <- c("y_min", "y_max", "x_min", "x_max") p <- st_sf(st_sfc(st_point(search_result_loc[2:1]), crs = .crs_longlat)) - p <- set_projection(p, projection=projection) + p <- sf::st_transform(p, crs=projection) coords <- as.vector(st_coordinates(p)) names(coords) <- c("x", "y") @@ -144,7 +143,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS #' @param x x coordinate(s), or a spatial points object (\code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPoints]{SpatialPoints}}) #' @param y y coordinate(s) #' @param zoom zoom level -#' @param projection projection in which the coordinates \code{x} and \code{y} are provided. Either a \code{\link[sp:CRS]{CRS}} object or a character value. If it is a character, it can either be a \code{PROJ.4} character string or a shortcut. See \code{\link{get_proj4}} for a list of shortcut values. By default latitude longitude coordinates. +#' @param projection projection in which the coordinates \code{x} and \code{y} are provided. #' @param as.data.frame return as data.frame (\code{TRUE}) or list (\code{FALSE}). By default a list, unless multiple coordinates are provided. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. #' @export @@ -152,33 +151,21 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS #' @return A data frmame or a list with all atributes that are contained in the search result #' @example ./examples/rev_geocode_OSM.R #' @seealso \code{\link{geocode_OSM}} -rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=NULL, as.data.frame=NA, server="http://nominatim.openstreetmap.org") { +rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="http://nominatim.openstreetmap.org") { project <- !missing(projection) - if (project) projection <- get_proj4(projection, output = "CRS") + if (inherits(x, "Spatial")) x <- as(x, "sf") if (inherits(x, "sf")) { - if (!all(st_geometry_type(x) == "POINT")) stop("sf object should only contain POINT geometries") + if (!all(sf::st_geometry_type(x) == "POINT")) stop("sf object should only contain POINT geometries") - isproj <- is_projected(x) + x <- sf::st_transform(x, crs = .crs_longlat) - if (is.na(isproj)) { - if (project) { - x <- set_projection(x, current.projection = projection, projection=.crs_longlat) - } else { - ll <- maybe_longlat(st_bbox(x)) - if (!ll) stop("Projection of x unknown. Please specify projection.") - warning("Projection of SpatialPoints object unknown. Assuming longitude latitude coordinates.") - x <- set_projection(x, current.projection = .crs_longlat) - } - } else { - if (isproj) x <- set_projection(x, projection = .crs_longlat) - } n <- nrow(x) - co <- st_coordinates(x) + co <- sf::st_coordinates(x) lon <- x <- co[,1] lat <- y <- co[,2] } else { @@ -192,11 +179,12 @@ rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=NULL, as.data.frame lon <- x lat <- y } else { - projection <- get_proj4(projection, output = "CRS") - single_point <- SpatialPoints(matrix(c(x,y), ncol=2), proj4string=projection) - coords <- attr(set_projection(single_point, projection = .CRS_longlat), "coords") - lon <- coords[,1] - lat <- coords[,2] + projection <- sf::st_crs(projection) + coords <- data.frame(x=x, y=y) + single_point <- sf::st_as_sf(x = coords, coords = c("x", "y"), crs = projection) + coords <- sf::st_transform(single_point, crs = .crs_longlat) + lon <- sf::st_coordinates(coords)[,1] + lat <- sf::st_coordinates(coords)[,2] } } diff --git a/R/get_IDs.R b/R/get_IDs.R deleted file mode 100644 index 332c1e3..0000000 --- a/R/get_IDs.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Get ID's of the shape items of sp objects -#' -#' Get ID's of the shape items of sp objects. For polygons and lines, the ID attribute is used. For points, the coordinates are used. -#' -#' @param shp shape object, which is one of -#' \enumerate{ -#' \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} -#' \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} -#' \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -#' } -#' @return vector of ID's -#' @export -get_IDs <- function(shp) { - if (inherits(shp, "SpatialPolygons")) { - sapply(shp@polygons, function(x)x@ID) - } else if (inherits(shp, "SpatialLines")) { - sapply(shp@lines, function(x)x@ID) - } else if (inherits(shp, "SpatialPixels")) { - shp@grid.index - } else if (inherits(shp, "SpatialPoints")) { - apply(shp@coords, MARGIN=1, function(x) { - paste(format(round(x, 6), nsmall = 6), collapse="_") - }) - } else { - return(NULL) - } -} diff --git a/R/get_asp_ratio.R b/R/get_asp_ratio.R index a36c973..f8cfe4b 100644 --- a/R/get_asp_ratio.R +++ b/R/get_asp_ratio.R @@ -22,8 +22,9 @@ get_asp_ratio <- function(x, is.projected = NA, width=700, height=700, res=100) dev.off() } else { if (inherits(x, c("Spatial", "Raster", "sf", "sfc"))) { + x <- to_sf_stars(x) bbx <- bb(x) - if (is.na(is.projected)) is.projected <- is_projected(x) + if (is.na(is.projected)) is.projected <- !sf::st_is_longlat(x) } else { bbx <- bb(x) if (is.na(is.projected)) is.projected <- !maybe_longlat(bbx) diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R index c65919f..7f1cfa4 100644 --- a/R/get_brewer_pal.R +++ b/R/get_brewer_pal.R @@ -21,27 +21,27 @@ get_brewer_pal <- function(palette, n=5, contrast=NA, stretch=TRUE, plot=TRUE) { if (reverse) palette <- substr(palette, 2, nchar(palette)) - nmax <- brewer.pal.info[palette, "maxcolors"] - if (brewer.pal.info[palette, "category"]=="qual") { + nmax <- RColorBrewer::brewer.pal.info[palette, "maxcolors"] + if (RColorBrewer::brewer.pal.info[palette, "category"]=="qual") { if ("contrast" %in% call) warning("contrast not used in qualitative color palettes") - brewerpal <- brewer.pal(min(nmax, max(n, 3)), name=palette) + brewerpal <- RColorBrewer::brewer.pal(min(nmax, max(n, 3)), name=palette) if (stretch && n > length(brewerpal)) { p <- colorRampPalette(brewerpal)(n) } else { p <- rep(brewerpal, length.out=n) } - } else if (brewer.pal.info[palette, "category"]=="seq") { + } else if (RColorBrewer::brewer.pal.info[palette, "category"]=="seq") { if ("stretch" %in% call) warning("stretch not used in sequential color palettes") if (is.na(contrast[1])) contrast <- default_contrast_seq(n) if (length(contrast)==1) contrast <- c(0, contrast) - brewerpal <- brewer.pal(nmax, name=palette) + brewerpal <- RColorBrewer::brewer.pal(nmax, name=palette) contrastIDs <- round(seq(contrast[1]*100, contrast[2]*100, length.out=n))+1 p <- colorRampPalette(brewerpal)(101)[contrastIDs] } else { if ("stretch" %in% call) warning("stretch not used in diverging color palettes") if (is.na(contrast[1])) contrast <- default_contrast_div(n) if (length(contrast)==1) contrast <- c(0, contrast) - brewerpal <- brewer.pal(nmax, name=palette) + brewerpal <- RColorBrewer::brewer.pal(nmax, name=palette) contrastIDs <- map2divscaleID(breaks=seq(-10,10, length.out=n+1), contrast=contrast) p <- colorRampPalette(brewerpal)(101)[contrastIDs] } diff --git a/R/get_proj4_code.R b/R/get_proj4_code.R deleted file mode 100644 index eb68e50..0000000 --- a/R/get_proj4_code.R +++ /dev/null @@ -1,106 +0,0 @@ -#' Get a PROJ.4 character string -#' -#' Get full PROJ.4 string from an existing PROJ.4 string, a shortcut, or a \code{\link[sp:CRS]{CRS}} object. -#' -#' @param x a projection. One of: -#' \enumerate{ -#' \item{a \code{PROJ.4} character string} -#' \item{a \code{\link[sf:st_crs]{crs}} object} -#' \item{a \code{\link[sp:CRS]{CRS}} object} -#' \item{an EPSG code} -#' \item{one the following shortcuts codes: -#' \describe{ -#' \item{\code{"longlat"}}{Not really a projection, but a plot of the longitude-latitude coordinates (WGS84 datum).} -#' \item{\code{"wintri"}}{Winkel Tripel (1921). Popular projection that is useful in world maps. It is the standard of world maps made by the National Geographic Society. Type: compromise} -#' \item{\code{"robin"}}{Robinson (1963). Another popular projection for world maps. Type: compromise} -#' \item{\code{"eck4"}}{Eckert IV (1906). Projection useful for world maps. Area sizes are preserved, which makes it particularly useful for truthful choropleths. Type: equal-area} -#' \item{\code{"hd"}}{Hobo-Dyer (2002). Another projection useful for world maps in which area sizes are preserved. Type: equal-area} -#' \item{\code{"gall"}}{Gall (Peters) (1855). Another projection useful for world maps in which area sizes are preserved. Type: equal-area} -#' \item{\code{"merc"}}{Web Mercator. Projection in which shapes are locally preserved, a variant of the original Mercator (1569), used by Google Maps, Bing Maps, and OpenStreetMap. Areas close to the poles are inflated. Type: conformal} -#' \item{\code{"utmXX(s)"}}{Universal Transverse Mercator. Set of 60 projections where each projection is a traverse mercator optimized for a 6 degree longitude range. These ranges are called UTM zones. Zone \code{01} covers -180 to -174 degrees (West) and zone \code{60} 174 to 180 east. Replace XX in the character string with the zone number. For southern hemisphere, add \code{"s"}. So, for instance, the Netherlands is \code{"utm31"} and New Zealand is \code{"utm59s"}} -#' \item{\code{"mill"}}{Miller (1942). Projetion based on Mercator, in which poles are displayed. Type: compromise} -#' \item{\code{"eqc0"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The equator is the standard parallel. Also known as Plate Carr\'ee. Type: equidistant} -#' \item{\code{"eqc30"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The latitude of 30 is the standard parallel. Type: equidistant} -#' \item{\code{"eqc45"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The latitude of 45 is the standard parallel. Also known as Gall isographic. Type: equidistant} -#' \item{\code{"laea_Eur"}}{European Lambert Azimuthal Equal Area Projection. Similar to EPSG code 3035.} -#' \item{\code{"laea_NA"}}{North American Lambert Azimuthal Equal Area Projection. Known as SR-ORG:7314.} -#' \item{\code{"rd"}}{Rijksdriehoekstelsel. Triangulation coordinate system used in the Netherlands.} -#' }} -#' } -#' @param output the output format of the projection, one of \code{"character"}, \code{"crs"},\code{"epsg"}, or \code{"CRS"} -#' @return see \code{output} -#' @importFrom rgdal CRSargs make_EPSG checkCRSArgs -#' @import sp -#' @import sf -#' @seealso \url{http://en.wikipedia.org/wiki/List_of_map_projections} for a overview of projections. \url{http://trac.osgeo.org/proj/} for the \code{PROJ.4} project home page. An extensive list of \code{PROJ.4} codes can be created with rgdal's \code{\link[rgdal:make_EPSG]{make_EPSG}}. -#' @export -get_proj4 <- function(x, output = c("crs", "character", "epsg", "CRS")) { - output <- match.arg(output) - y <- if (is.null(x)) { - return(NULL) - } else if (is.na(x)) { - sf::st_crs() - } else if (inherits(x, "crs")) { - x - } else if (inherits(x, "CRS")) { - sf::st_crs(attr(x, "projargs")) - } else if (!is.numeric(x) && !is.character(x)) { - stop("x is not a character, crs object, CRS object, nor a number", call.=FALSE) - } else { - if (x %in% names(.proj_epsg)) { - create_crs(unname(.proj_epsg[x])) - } else if (x %in% names(.proj_sc)) { - create_crs(unname(.proj_sc[x])) - } else if (is_num_string(x)) { - sf::st_crs(x) - } else if (substr(x, 1, 3)=="utm") { - if (!(nchar(x) %in% c(5,6))) stop("\"utm\" shortcut code should be utmXX or utmXXs where XX refers to the utm zone") - sf::st_crs(paste("+proj=utm +zone=", substr(x, 4, 5), ifelse(substr(x, 6, 6)=="s", " +south", ""), " +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", sep="")) - } else { - sf::st_crs(x) - } - } - - switch(output, - character = y$proj4string, - crs = y, - epsg = y$epsg, - CRS = CRS(ifelse(is.na(y$proj4string), "", y$proj4string))) -} - -create_crs <- function(x) { - if (is.numeric(x)) { - sf::st_crs(x) - } else { - structure(list(epsg = as.integer(NA), proj4string = x), class = "crs") - } -} - -is_num_string <- function(x) { - suppressWarnings(!is.na(as.numeric(x))) -} - -.proj_epsg <- c(longlat = 4326, - latlong = 4326, - WGS84 = 4326, - NAD83 = 4269, - NAD27 = 4267, - merc = 3857, - laea_Eur = 3035, - laea_NA = 2163, - rd = 28992) - -.proj_sc <- c(wintri="+proj=wintri +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - robin="+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eck4="+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - hd="+proj=cea +lat_ts=37.5 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - gall="+proj=cea +lon_0=0 +lat_ts=45 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - mill="+proj=mill +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +R_A +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc0="+proj=eqc +lat_ts=0 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc30="+proj=eqc +lat_ts=30 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc45="+proj=eqc +lat_ts=45 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0") - -# many shapefiles of the Netherlands have one of these projections, which cause problems since the +towgs84 attribute is missing (this is automatically corrected in read_shape) -.wrong_rd_projections <- c("+proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.999908 +x_0=155000 +y_0=463000 +ellps=bessel +units=m +no_defs", - "+proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +ellps=bessel +units=m +no_defs", - "+proj=sterea +lat_0=52.156161 +lon_0=5.387639 +k=0.999908 +x_0=155000 +y_0=463000 +ellps=bessel +units=m +no_defs") diff --git a/R/is_projected.R b/R/is_projected.R deleted file mode 100644 index 64159bc..0000000 --- a/R/is_projected.R +++ /dev/null @@ -1,32 +0,0 @@ -#' Is the shape projected? -#' -#' Checks whether the shape is projected. Applicable to \code{Spatial}, \code{Raster} and \code{\link[sf:sf]{sf}} objects. In case the projection is missing, it checks whether the coordinates are within -180/180 and -90/90 (if so, it returns \code{FALSE}). -#' -#' @param x shape (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}), or projection (see \code{\link{get_proj4}} for options) -#' @return logical: \code{TRUE} if the shape is projected and \code{FALSE} otherwise. -#' @export -is_projected <- function(x) { - isP <- if (inherits(x, "Raster")) { - !couldBeLonLat(x, warnings=FALSE) - } else { - if (inherits(x, c("Spatial", "sf", "sfc"))) - prj <- get_projection(x) - else prj <- get_proj4(x) - - proj4_is_projected(prj) - } - if (is.na(isP) && !is.character(x)) isP <- !maybe_longlat(get_bb(x)$b) - isP -} - -proj4_is_projected <- function(p) { - if (is.na(p)) - as.logical(NA) - else - (length(grep("longlat", p, fixed = TRUE))==0) -} - - -maybe_longlat <- function(bb) { - (bb[1] >= -180.1 && bb[3] <= 180.1 && bb[2] >= -90.1 && bb[4] <= 90.1) -} diff --git a/R/kde2D.R b/R/kde2D.R deleted file mode 100644 index 4eea094..0000000 --- a/R/kde2D.R +++ /dev/null @@ -1,63 +0,0 @@ -kde2D <- function (x, bandwidth, gridsize = c(51L, 51L), range.x, truncate = TRUE) -{ - gcounts <- t(x[nrow(x):1,]) - gcounts[is.na(gcounts)] <- 0 - gridsize <- dim(gcounts) - n <- sum(!(gcounts==0)) - #range.x <- list(c(1, gridsize[1]), c(1, gridsize[2])) - - - if (!missing(bandwidth) && min(bandwidth) <= 0) - stop("'bandwidth' must be strictly positive") -# n <- nrow(x) - M <- gridsize - h <- bandwidth - tau <- 3.4 - if (length(h) == 1L) - h <- c(h, h) -# if (missing(range.x)) { -# range.x <- list(0, 0) -# for (id in (1L:2L)) range.x[[id]] <- c(min(x[, id]) - -# 1.5 * h[id], max(x[, id]) + 1.5 * h[id]) -# } - a <- c(range.x[[1L]][1L], range.x[[2L]][1L]) - b <- c(range.x[[1L]][2L], range.x[[2L]][2L]) - gpoints1 <- seq(a[1L], b[1L], length = M[1L]) - gpoints2 <- seq(a[2L], b[2L], length = M[2L]) -# gcounts <- linbin2D(x, gpoints1, gpoints2) - L <- numeric(2L) - kapid <- list(0, 0) - for (id in 1L:2L) { - L[id] <- min(floor(tau * h[id] * (M[id] - 1)/(b[id] - - a[id])), M[id] - 1L) - lvecid <- 0:L[id] - facid <- (b[id] - a[id])/(h[id] * (M[id] - 1L)) - z <- matrix(dnorm(lvecid * facid)/h[id]) - tot <- sum(c(z, rev(z[-1L]))) * facid * h[id] - kapid[[id]] <- z/tot - } - kapp <- kapid[[1L]] %*% (t(kapid[[2L]]))/n - if (min(L) == 0) - warning("Binning grid too coarse for current (small) bandwidth: consider increasing 'gridsize'", call. = FALSE) - P <- 2^(ceiling(log(M + L)/log(2))) - L1 <- L[1L] - L2 <- L[2L] - M1 <- M[1L] - M2 <- M[2L] - P1 <- P[1L] - P2 <- P[2L] - rp <- matrix(0, P1, P2) - rp[1L:(L1 + 1), 1L:(L2 + 1)] <- kapp - if (L1) - rp[(P1 - L1 + 1):P1, 1L:(L2 + 1)] <- kapp[(L1 + 1):2, - 1L:(L2 + 1)] - if (L2) - rp[, (P2 - L2 + 1):P2] <- rp[, (L2 + 1):2] - sp <- matrix(0, P1, P2) - sp[1L:M1, 1L:M2] <- gcounts - rp <- fft(rp) - sp <- fft(sp) - rp <- Re(fft(rp * sp, inverse = TRUE)/(P1 * P2))[1L:M1, 1L:M2] - rp <- rp * matrix(as.numeric(rp > 0), nrow(rp), ncol(rp)) - list(x1 = gpoints1, x2 = gpoints2, fhat = rp) -} \ No newline at end of file diff --git a/R/line_functions.R b/R/line_functions.R deleted file mode 100644 index e310e0a..0000000 --- a/R/line_functions.R +++ /dev/null @@ -1,189 +0,0 @@ -#' @rdname double_line -#' @param offset offset from the original lines -#' @export -offset_line <- function(shp, offset) { - isLeft <- offset<0 - double_line(shp, width=abs(offset*2), sides=ifelse(isLeft, "left", "right")) -} - - -#' Create a double line or offset line (deprecated) -#' -#' Create a double line or offset line. The double line can be useful for visualizing two-way tracks or emulating objects such as railway tracks. The offset line can be useful to prevent overlapping of spatial lines. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -#' -#' @param shp SpatialLines(DataFrame) -#' @param width width between the left and righthand side -#' @param sides character value that specifies which sides are selected: \code{"both"}, \code{"left"}, or \code{"right"}. The default is \code{"both"}. For the other two options, see also the shortcut function \code{offset_line}. -#' @name double_line -#' @rdname double_line -#' @export -#' @return A shape object, in the same format as \code{shp} -#' @import sp -#' @example ./examples/double_line.R -#' @importFrom rgeos gBuffer gIntersection -double_line <- function(shp, width, sides="both") { - .Deprecated("", package = "", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - is_sf <- inherits(shp, c("sf", "sfc")) - if (is_sf) shp <- as(shp, "Spatial") - - ns <- length(shp) - hasData <- ("data" %in% slotNames(shp)) - - # determine feature ids per line segment - linesCount <- sapply(shp@lines, function(x)length(x@Lines)) - IDs <- unlist(mapply(rep, 1:ns, linesCount)) - - # process width and sides arguments - ws <- rep(width, length.out=ns) - ws2 <- ws[IDs] - margin=max(ws)/100 - ss <- rep(sides, length.out=ns) - - # let each line segment be seperate SL(DF) - shp2 <- disaggregate(shp) - shp2s <- split(shp2, f=factor(get_IDs(shp2))) - - - # Per line segment, determine left- and right-handside part - shp7s <- mapply(FUN = function(s2, w) { - if (w==0) { - return(list(L=s2, R=s2)) - } - - s3 <- suppressWarnings(gBuffer(s2, width=w, capStyle="SQUARE")) - s4 <- as(s3, "SpatialLines") - - s5 <- suppressWarnings(gBuffer(s2,width= w+margin,capStyle="FLAT")) - - s6 <- gIntersection(s4, s5) - - s6s <- disaggregate(s6) - - co2 <- s2@lines[[1]]@Lines[[1]]@coords - - a2 <- sapply(1:(nrow(co2)-1), function(i) { - get_direction_angle(co2[c(i,i+1),]) - }) - a2 <- c(a2, a2[length(a2)]) - - dirs <- sapply(s6s@lines, function(L) { - co6 <- L@Lines[[1]]@coords - - co6 <- co6[seq(1, nrow(co6), length.out=5),] - - a6 <- apply(co6, MARGIN = 1, FUN = function(coi) { - id <- which.min(sqrt((coi[1] - co2[,1])^2 + (coi[2] - co2[,2])^2)) - angle_diff(get_direction_angle(rbind(co2[id,], coi)), a2[id]) - }) - sum(angle_diff(a6, 90, absolute = TRUE) < 90) >= 3 - }) - - id <- get_IDs(s2) - - if (any(dirs)) { - lnsL <- do.call("c", lapply(s6s@lines[dirs], function(l) l@Lines)) - slL <- SpatialLines(list(Lines(lnsL, ID=id)), proj4string = s2@proj4string) - sldfL <- SpatialLinesDataFrame(slL, s2@data) - } else { - sldfL <- NULL - } - - if (any(!dirs)) { - lnsR <- do.call("c", lapply(s6s@lines[!dirs], function(l) l@Lines)) - slR <- SpatialLines(list(Lines(lnsR, ID=id)), proj4string = s2@proj4string) - sldfR <- SpatialLinesDataFrame(slR, s2@data) - } else { - sldfR <- NULL - } - - list(L=sldfL, R=sldfR) - }, shp2s, ws2, SIMPLIFY = FALSE) - - # get non-NULL argument selection - selL <- !sapply(shp7s, function(s) is.null(s[["L"]])) - selR <- !sapply(shp7s, function(s) is.null(s[["R"]])) - - # stack them - shpL <- do.call("sbind", lapply(shp7s, "[[", "L")) - shpR <- do.call("sbind", lapply(shp7s, "[[", "R")) - - - Lns <- mapply(function(id, s) { - L <- if (s %in% c("left", "both")) { - if (!any(IDs[selL]==id)) { - NULL - } else lapply(shpL@lines[IDs[selL]==id], function(l) if (is.null(l)) NULL else l@Lines) - } else NULL - R <- if (s %in% c("right", "both")) { - if (!any(IDs[selR]==id)) { - NULL - } else lapply(shpR@lines[IDs[selR]==id], function(l) if (is.null(l)) NULL else l@Lines) - } else NULL - - if (is.null(L) && is.null(R)) { - NULL - } else Lines(do.call("c", c(L, R)),ID = id) - }, 1:ns, ss, SIMPLIFY=FALSE) - - Lns_sel <- !sapply(Lns, is.null) - - if (!any(Lns_sel)) stop("Unable to create offset lines") - - shp8 <- SpatialLines(Lns[Lns_sel], proj4string = shp@proj4string) - shp9 <- if (hasData) { - SpatialLinesDataFrame(shp8, data=shp@data[Lns_sel,], match.ID = FALSE) - } else shp8 - - if (is_sf) as(shp9, "sf") else shp9 -} - - -# get angle from the coordinates of a line (only considers endpoints) -get_direction_angle <- function(co) { - p1 <- co[1,] - p2 <- co[nrow(co),] - - a <- atan2(p2[2] - p1[2], p2[1] - p1[1]) * 180 / pi - a %% 360 -} - - -# calculate the difference between two angles -angle_diff <- function(a1, a2, absolute=FALSE) { - y <- a2 / 180 * pi - x <- a1 / 180 * pi - a <- atan2(sin(x-y), cos(x-y)) * 180 / pi - if (absolute) abs(a) else a -} - -# get the endpoints per line, as well as the angle of the head and tail -end_points <- function(shp) { - lapply(shp@lines, function(l) { - lapply(l@Lines, function(ll) { - k <- nrow(ll@coords) - co <- ll@coords[c(1, k), ] - co_head <- ll@coords[1:2, ] - co_tail <- ll@coords[(k-1):k, ] - - dir_head <- get_direction_angle(co_head) - dir_tail <- get_direction_angle(co_tail) - - if (all(co[1,]==co[2,])) { - dir_diff <- angle_diff(dir_head, dir_tail, absolute = TRUE) - opposite <- (dir_diff > 90) - - dir_diff2 <- angle_diff(dir_head, dir_tail, absolute = FALSE) + ifelse(opposite, 180, 0) - - dir_head <- (dir_head - dir_diff2/2) %% 360 - dir_tail <- (dir_head + ifelse(opposite, 180, 0)) %% 360 - } - - cbind(co, c(dir_head, dir_tail)) - }) - }) -} - - diff --git a/R/map_coloring.R b/R/map_coloring.R index 10ab725..09f70fc 100644 --- a/R/map_coloring.R +++ b/R/map_coloring.R @@ -10,6 +10,7 @@ #' @param contrast vector of two numbers that determine the range that is used for sequential and diverging palettes (applicable when \code{auto.palette.mapping=TRUE}). Both numbers should be between 0 and 1. The first number determines where the palette begins, and the second number where it ends. For sequential palettes, 0 means the brightest color, and 1 the darkest color. For diverging palettes, 0 means the middle color, and 1 both extremes. If only one number is provided, this number is interpreted as the endpoint (with 0 taken as the start). #' @return If \code{palette} is defined, a vector of colors is returned, otherwise a vector of color indices. #' @example ./examples/map_coloring.R +#' @import RColorBrewer #' @export map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palette=NULL, contrast=1) { if (inherits(x, "Spatial")) x <- as(x, "sf") @@ -27,8 +28,8 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palett palette <- substr(palette, 2, nchar(palette)) } else revPal <- function(p)p - if (palette[1] %in% rownames(brewer.pal.info)) { - if (is.na(ncols)) ncols <- brewer.pal.info[palette, "maxcolors"] + if (palette[1] %in% rownames(RColorBrewer::brewer.pal.info)) { + if (is.na(ncols)) ncols <- RColorBrewer::brewer.pal.info[palette, "maxcolors"] palette2 <- revPal(suppressWarnings(get_brewer_pal(palette, ncols, contrast, plot = FALSE))) } else { if (is.na(ncols)) ncols <- length(palette) diff --git a/R/onLoad.R b/R/onLoad.R index 6e45aa0..f3a2dde 100644 --- a/R/onLoad.R +++ b/R/onLoad.R @@ -18,17 +18,5 @@ working_internet <- function(url = "http://www.google.com") { !inherits(test, "try-error") } - .TMAPTOOLS_CACHE <- new.env(FALSE, parent=globalenv()) - .crs_longlat <- sf::st_crs(4326) -.crs_merc <- sf::st_crs(3857) - -.CRS_longlat <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0", doCheckCRSArgs = FALSE) -.CRS_merc <- CRS("+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=@null +no_defs", doCheckCRSArgs = FALSE) - -get_proj4_version <- function() { - PROJ4_version <- rgdal::getPROJ4VersionInfo() - vid <- gregexpr("PJ_VERSION: ", PROJ4_version, fixed = TRUE)[[1]][1] + 12 - as.integer(substr(PROJ4_version, vid, nchar(PROJ4_version)-1)) -} diff --git a/R/palette_explorer.R b/R/palette_explorer.R index c425b6b..cdc5d9e 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -1,5 +1,5 @@ tmap.pal.info <- local({ - br <- brewer.pal.info[, 1:2] + br <- RColorBrewer::brewer.pal.info[, 1:2] br$origin <- factor("brewer", levels = c("brewer", "viridis")) vr <- data.frame(maxcolors = rep.int(0, 5), category = factor("seq", levels = c("div", "qual", "seq")), origin = factor("viridis", levels = c("brewer", "viridis")), row.names = c("viridis", "magma", "plasma", "inferno", "cividis")) @@ -320,7 +320,7 @@ palette_explorer <- function() { #' @rdname palette_explorer #' @export tmap.pal.info <- local({ - br <- brewer.pal.info + br <- RColorBrewer::brewer.pal.info br$origin <- factor("brewer", levels = c("brewer", "viridis")) vr <- data.frame(maxcolors = rep.int(Inf, 5), category = factor("seq", levels = c("div", "qual", "seq")), origin = factor("viridis", levels = c("brewer", "viridis")), colorblind = c(FALSE, FALSE, FALSE, FALSE, TRUE), row.names = c("viridis", "magma", "plasma", "inferno", "cividis")) diff --git a/R/pkg.R b/R/pkg.R index 781f9ef..9b59d87 100644 --- a/R/pkg.R +++ b/R/pkg.R @@ -11,16 +11,6 @@ #' \code{\link{bb}}\tab Create, extract or modify a bounding box \cr #' \code{\link{bb_poly}}\tab Convert bounding box to a polygon \cr #' \code{\link{get_asp_ratio}}\tab Get the aspect ratio of a shape object \cr -#' \code{\link{get_IDs}}\tab Get ID values of a shape object \cr -#' \code{\link{is_projected}}\tab Check if the map is projected \cr -#' \code{\link{get_projection}}\tab Get the map projection \cr -#' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr -#' } -#' -#' @section Tool functions (data): -#' \tabular{ll}{ -#' \code{\link{append_data}}\tab Append a data frame to a shape object \cr -#' \code{\link{calc_densities}}\tab Calculate density values \cr #' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr #' } #' @@ -34,16 +24,8 @@ #' #' @section Spatial transformation functions: #' \tabular{ll}{ -#' \code{\link{aggregate_map}}\tab Aggregate the units of a map \cr #' \code{\link{crop_shape}}\tab Crop shape objects \cr -#' \code{\link{points_to_raster}}\tab Bin spatial points to a raster \cr -#' \code{\link{poly_to_raster}}\tab Convert polygons to a raster \cr -#' \code{\link{sbind}}\tab Bind shape objects \cr -#' \code{\link{sample_dots}}\tab Sample dots from polygons \cr -#' \code{\link{set_projection}}\tab Set the map projection \cr #' \code{\link{simplify_shape}}\tab Simplify a shape \cr -#' \code{\link{smooth_map}}\tab Create a smooth map using a kernel density estimator \cr -#' \code{\link{smooth_raster_cover}}\tab Create a smooth cover from a raster object \cr #' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr #' } #' @@ -52,9 +34,7 @@ #' \code{\link{geocode_OSM}}\tab Get a location from an address description \cr #' \code{\link{read_GPX}}\tab Read a GPX file \cr #' \code{\link{read_osm}}\tab Read Open Street Map data \cr -#' \code{\link{read_shape}}\tab Read a shape object \cr #' \code{\link{rev_geocode_OSM}}\tab Get an address description from a location \cr -#' \code{\link{write_shape}}\tab Write a shape object \cr #' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr #' } #' @@ -67,17 +47,6 @@ #' @concept spatial data NULL -#' Deprecated functions in \code{tmaptools} -#' -#' These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} -#' -#' \code{\link{append_data}}, \code{\link{aggregate_map}}, \code{\link{double_line}}, \code{\link{points_to_raster}}, \code{\link{poly_to_raster}}, \code{\link{sample_dots}}, \code{\link{sbind}}, \code{\link{smooth_map}}, \code{\link{smooth_raster_cover}}, \code{\link{read_shape}}, \code{\link{write_shape}} -#' -#' @docType package -#' @name tmaptools-deprecated -#' @rdname tmaptools-deprecated -NULL - #' Pipe operator #' #' The pipe operator from magrittr, \code{\%>\%}, can also be used in functions from \code{tmaptools}. @@ -88,5 +57,4 @@ NULL #' @export #' @param lhs Left-hand side #' @param rhs Right-hand side -#' @example ./examples/pipe.R NULL diff --git a/R/projection_units.R b/R/projection_units.R deleted file mode 100644 index 705a82e..0000000 --- a/R/projection_units.R +++ /dev/null @@ -1,72 +0,0 @@ -#' #' Get or translate units of a projection -#' #' -#' #' Get the units from a projection (CRS) or a shape and determine the multiplier to transpose it in other units. -#' #' -#' #' @importFrom geosphere distGeo -#' #' @import sp -#' #' @export -#' #' @param x A projection (see \code{\link{get_proj4}}) or a shape (from class \code{\link[sf:sf]{sf}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sp:sp]{sp}}). -#' #' @param target target unit, one of: \code{"m"}, \code{"km"}, \code{"mi"}, and \code{"ft"}. -#' #' @param orig units by the \code{x} is defined. Only needed if this information is missing from \code{x} and \code{x} is projected. Options: \code{"m"}, \code{"km"}, \code{"mi"}, and \code{"ft"}. -#' #' @param to multiplier used as follows: \code{orig * to = target}. Only needed when \code{orig} or \code{target} is unknown. For instance, if \code{target} is set to \code{"hm"} (hectameter), and \code{orig} is \code{"m"}, then \code{to} should be 100, meaning 1 hectameter equals 100 meters. -#' #' @param latitude latitude. Needed if the projection coordinates are in latitude longitude units. In that case the \code{orig} will be defined as longitude coordinates at latitude \code{latitude}. -#' #' @param show.warnings should warnings be shown? -#' #' @return list with the following items, \code{orig}, \code{target}, and \code{to} either according the specified argument, or determined determined. The value is \code{NA} for items that cannot be determined. The final item is \code{projected}, which is determined using \code{\link{is_projected}} -#' #' @seealso \code{\link{approx_distances}} for distances between two points and \code{\link{approx_areas}} for areas. -#' #' @example ./examples/projection_units.R -#' projection_units <-function(x=NA, target="m", orig=NA, to=NA, latitude=0, show.warnings=TRUE) { -#' if (target=="metric") target <- "km" -#' if (target=="imperial") target <- "mi" -#' -#' -#' # get projection (if available) -#' if (inherits(x, c("Spatial", "Raster"))) { -#' projection <- get_projection(x) -#' } else if (inherits(x, c("sf", "sfc"))) { -#' projection <- get_projection(x) -#' #units <- -#' } else { -#' projection <- get_proj4(x) -#' } -#' -#' isprj <- (length(grep("longlat", projection, fixed=TRUE))==0) -#' -#' -#' # subtract unit -#' if (is.na(orig)) { -#' pat <- '^.*\\+units ?= ?(\\S*)(.*)$' -#' orig <- sub(pat, '\\1', projection[grepl(pat, projection)]) -#' if (length(orig)==0) orig <- NA -#' } -#' -#' # insufficient info -#' if (!isprj) { -#' orig <- paste("long@lat", round(latitude), sep="") -#' if (!target %in% names(to_m)) { -#' if (show.warnings) warning("Unknown target unit") -#' return(list(unit=orig, target=target, to=NA, projected=isprj)) -#' } else { -#' to <- unname(geosphere::distGeo(c(0, latitude), c(1, latitude)) / to_m[target]) -#' return(list(unit=orig, target=target, to=to, projected=isprj)) -#' } -#' } else { -#' if (!is.na(to)) { -#' return(list(unit=orig, target=target, to=to, projected=isprj)) -#' } else if (is.na(orig)) { -#' return(list(unit=NA, target=target, to=NA, projected=isprj)) -#' } else if (!(orig %in% names(to_m))) { -#' if (show.warnings) warning("Unknown original unit") -#' return(list(unit=orig, target=target, to=NA, projected=isprj)) -#' } else if (!target %in% names(to_m)) { -#' if (show.warnings) warning("Unknown target unit") -#' return(list(unit=orig, target=target, to=NA, projected=isprj)) -#' } else { -#' to <- unname(to_m[orig] / to_m[target]) -#' return(list(unit=orig, target=target, to=to, projected=isprj)) -#' } -#' } -#' } -#' -#' # conversion vector (for now assume metric and imperial are in km and mi, check later) -#' to_m <- c(m=1, km=1000, mi=1609.344, miles=1609.344, ft=0.304800609601219, 'us-ft'=0.304800609601219, metric=1000, imperial=1609.344,NA) -#' diff --git a/R/read_GPX.R b/R/read_GPX.R index 5eb7102..cc931d5 100644 --- a/R/read_GPX.R +++ b/R/read_GPX.R @@ -6,33 +6,25 @@ #' #' @param file a GPX filename (including directory) #' @param layers vector of GPX layers. Possible options are \code{"waypoints"}, \code{"tracks"}, \code{"routes"}, \code{"track_points"}, \code{"route_points"}. By dedault, all those layers are read. -#' @param as.sf should \code{\link[sf:sf]{sf}} objects be returned? By default \code{TRUE} -#' @return for each defiend layer, a shape is returned (only if the layer has any features). If only one layer is defined, the corresponding shape is returned. If more than one layer is defined, a list of shape objects, one for each layer, is returned. -#' @importFrom rgdal readOGR ogrInfo +#' @param remove.empty.layers should empty layers (i.e. with 0 features) be removed from the list? +#' @param as.sf not used anymore +#' @return a list of sf objects, one for each layer #' @export -#' @example ./examples/read_GPX.R -read_GPX <- function(file, layers=c("waypoints", "tracks", "routes", "track_points", "route_points"), as.sf=TRUE) { - if (!all(layers %in% c("waypoints", "tracks", "routes", "track_points", "route_points"))) stop("Incorrect layer(s)", call. = FALSE) +read_GPX <- function(file, layers=c("waypoints", "routes", "tracks", "route_points", "track_points"), remove.empty.layers = TRUE, as.sf = TRUE) { + if (!all(layers %in% c("waypoints", "routes", "tracks", "route_points", "track_points"))) stop("Incorrect layer(s)", call. = FALSE) - # check if features exist per layer - suppressWarnings(hasF <- sapply(layers, function(l) { - ogrInfo(dsn = file, layer=l)$have_features - })) + layers_data <- sf::st_layers(file) - if (!any(hasF)) stop("None of the layer(s) has any features.", call. = FALSE) + if (!all(layers %in% layers_data$name)) stop("layers not found in GPX file") - res <- lapply(layers[hasF], function(l) { - readOGR(dsn = file, layer=l, verbose=FALSE) - }) - names(res) <- layers[hasF] + res <- lapply(layers, function(l) { + sf::st_read(file, layer = l, quiet = TRUE) + }) + names(res) <- layers - if (as.sf) res <- lapply(res, function(r) { - as(r, "sf") - }) + if (remove.empty.layers) { + res <- res[layers_data$features[match(layers, layers_data$name)] > 0] + } - if (sum(hasF)==1) { - res[[1]] - } else { - res - } + res } diff --git a/R/read_osm.R b/R/read_osm.R index 9e8ce79..466d549 100644 --- a/R/read_osm.R +++ b/R/read_osm.R @@ -14,7 +14,6 @@ #' @param ... arguments passed on to \code{\link{bb}}. #' @name read_osm #' @rdname read_osm -#' @import sp #' @importFrom raster raster #' @export #' @example ./examples/read_osm.R @@ -46,14 +45,100 @@ read_osm <- function(x, zoom=NULL, type="osm", minNumTiles=NULL, mergeTiles=NULL optionalArgs <- list(zoom=zoom, type=type, minNumTiles=minNumTiles, mergeTiles=mergeTiles) optionalArgs <- optionalArgs[!sapply(optionalArgs, is.null)] om <- suppressWarnings({do.call("openmap", args = c(list(upperLeft=x[c(4,1)], lowerRight=x[c(2,3)]), optionalArgs))}) + omr <- raster::raster(om) - if (use.colortable) { - tab <- raster_colors(raster::values(omr), use.colortable = TRUE) - omr <- raster::raster(omr) - omr <- raster::setValues(omr, as.integer(tab) - 1L) - raster::colortable(omr) <- levels(tab) - } +# omr2 <- raster::raster(om) +# +# +# plot(omr2) +# +# +# all(omr2$layer.1[,] == cols[1,]) +# all(omr2$layer.2[,] == cols[2,]) +# +# cols <- col2rgb(om$tiles[[1]]$colorData) +# dimy <- om$tiles[[1]]$xres +# dimx <- om$tiles[[1]]$yres +# +# bbox <- unlist(om$tiles[[1]]$bbox)[c(1,3,4,2)] +# names(bbox) <- c("xmin", "xmax", "ymin", "ymax") +# +# bbx <- st_bbox(bbox, crs = sf::st_crs(attr((om$tiles[[1]]$projection), "projargs"))) +# +# +# stars::st_as_stars() +# +# red <- matrix(cols[1,], ncol = dimx, byrow = FALSE) +# dim(red) <- c(y = dimy, x = dimx) +# +# green <- matrix(cols[1,], ncol = dimx, byrow = FALSE) +# dim(green) <- c(y = dimy, x = dimx) +# +# blue <- matrix(cols[1,], ncol = dimx, byrow = FALSE) +# dim(blue) <- c(y = dimy, x = dimx) +# +# omr3 <- stars::st_as_stars(omr2) +# plot(omr3) +# +# +# a <- array(c(red, green, blue), dim = c(dim(red), 3)) +# dim(a) <- c(y = unname(nrow(red)), x = unname(ncol(red)), band = 3) +# +# omr4 <- stars::st_as_stars(list(a)) +# omr5 <- stars::st_as_stars(bbx, nx = dimx, ny = dimy) +# +# attr(omr4, "dimensions")[1:2] <- attr(omr5, "dimensions") +# +# attr(attr(omr4, "dimensions"), "raster") <- attr(attr(omr5, "dimensions"), "raster") +# +# +# plot(omr4) +# +# , dimensions = attr(stars::st_as_stars(bbx, nx = dimx, ny = dimy), "dimensions")) +# +# plot(omr4) +# +# plot(omr3) +# +# +# +# omr <- st_dimensions(stars::st_as_stars(bbx, nx = dimx, ny = dimy)) +# #attr(omr, "dimensions")[[2]]$delta = -1 +# +# plot(omr) +# +# omr <- st_as_stars(red) +# +# attr(omr, "dimensions") <- attr(omr3, "dimensions") +# +# plot(omr) +# +# +# +# st_dimensions(omr) +# +# stars::r +# +# str(attr(st_dimensions(omr), "raster")) +# +# plot(omr) +# +# m = matrix(1:6, ncol = 2) +# dim(m) = c(x = 3, y = 2) +# omr <- stars::st_as_stars(bbx, nx = 3, ny = 2, values = m) +# plot(omr) +# +# +# omr <- stars::st_as_stars(bbx) + + + # if (use.colortable) { + # tab <- raster_colors(raster::values(omr), use.colortable = TRUE) + # omr <- raster::raster(omr) + # omr <- raster::setValues(omr, as.integer(tab) - 1L) + # raster::colortable(omr) <- levels(tab) + # } attr(omr, "leaflet.provider") <- unname(OSM2LP[type]) attr(omr, "is.OSM") <- TRUE diff --git a/R/read_shape.R b/R/read_shape.R deleted file mode 100644 index ac9293c..0000000 --- a/R/read_shape.R +++ /dev/null @@ -1,81 +0,0 @@ -#' Read shape file (deprecated) -#' -#' Read an ESRI shape file. Optionally, set the current projection if it is missing. -#' -#' This function is a convenient wrapper of rgdal's \code{\link[rgdal:readOGR]{readOGR}}. It is possible to set the current projection, if it is undefined in the shape file. If a reprojection is required, use \code{\link{set_projection}}. -#' -#' For the Netherlands: often, the Dutch Rijksdriehoekstelsel (Dutch National Grid) projection is provided in the shape file without proper datum shift parameters to wgs84. This functions automatically adds these parameters. See \url{http://www.qgis.nl/2011/12/05/epsg28992-of-rijksdriehoekstelsel-verschuiving/} (in Dutch) for details. -#' -#' @param file a shape file name (including directory) -#' @param current.projection the current projection of the shape object, if it is missing in the shape file. See \code{\link{get_proj4}} for options. Use \code{\link{set_projection}} to reproject the shape object. -#' @param as.sf should the shape be returned as an \code{\link[sf:sf]{sf}} object? -#' @param ... other parameters, such as \code{stringsAsFactors}, are passed on to \code{\link[rgdal:readOGR]{readOGR}} -#' @return shape object from class \code{\link[sp:Spatial]{Spatial}} or \code{\link[sf:sf]{sf}} if \code{as.sf = TRUE} -#' @importFrom rgdal readOGR -#' @import sp -#' @export -read_shape <- function(file, current.projection=NULL, as.sf=TRUE, ...){ - .Deprecated("st_read", package = "sf", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - # determine region ID - if (file.exists(file)) { - fullfilename <- file - } else stop("unknown filename", call. = FALSE) - - dir <- dirname(fullfilename) - base <- basename(fullfilename) - if (substr(base, nchar(base)-3, nchar(base))==".shp") - base <- substr(base, 1, nchar(base)-4) - - shp <- readOGR(dir, base, verbose=FALSE, ...) - - prj <- proj4string(shp) - - if (is.na(prj)) { - if (missing(current.projection)) { - warning("Current projection missing. Set the parameter current.project, or use set_projection", call. = FALSE) - } else { - shp <- set_projection(shp, current.projection=current.projection) - } - } else { - if (!missing(current.projection)) { - warning("Projection already specified in shape file. Use set_projection for reprojection.", call. = FALSE) - } - - ## rd projection correction: add towgs84 parameter to frequently used rd projection strings - if (prj %in% .wrong_rd_projections) { - warning("rd projection recognized, but witout +towgs84 attribute. Shape has been converted to EPSG:28992") - shp <- suppressWarnings(set_projection(shp, current.projection="rd", overwrite.current.projection=TRUE)) - } - } - if (as.sf) as(shp, "sf") else shp -} - - - - -#' Write shape file (deprecated) -#' -#' Write a shape object to an ESRI shape file. -#' -#' This function is a convenient wrapper of rgdal's \code{\link[rgdal:writeOGR]{writeOGR}}. -#' -#' @param shp a shape object -#' @param file file name (including directory) -#' @import sp -#' @importFrom rgdal writeOGR -#' @export -write_shape <- function(shp, file) { - .Deprecated("st_write", package = "sf", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - shpname <- deparse(substitute(shp)) - dir <- dirname(file) - base <- basename(file) - if (!file.exists(dir)) stop("unknown directory", call. = FALSE) - - if (substr(base, nchar(base)-3, nchar(base))==".shp") - base <- substr(base, 1, nchar(base)-4) - if (inherits(shp, c("sf", "sfc"))) shp <- as(shp, "Spatial") - if (!inherits(shp, "Spatial")) stop("shpname is not a Spatial object", call. = FALSE) - writeOGR(shp, dir, base, driver = "ESRI Shapefile", overwrite_layer=TRUE) -} diff --git a/R/sample_dots.R b/R/sample_dots.R deleted file mode 100644 index b80ef88..0000000 --- a/R/sample_dots.R +++ /dev/null @@ -1,223 +0,0 @@ -#' Sample dots from spatial polygons (deprecated) -#' -#' Sample dots from spatial polygons according to a spatial distribution of a population. The population may consist of classes. The output, an sf object containing spatial points, can be used to create a dot map (see \code{\link[tmap:tm_dots]{tm_dots}}), where the dots are colored according to the classes. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, \code{\link[sf:st_sample]{st_sample}} can be used. -#' -#' @param shp A shape object, more specifically, a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygonsDataFrame}} or an \code{\link[sf:sf]{sf}} object that can be coerced as such. -#' @param vars Names of one or more variables that are contained in \code{shp}. If \code{vars} is not provided, the dots are sampled uniformly. If \code{vars} consists of one variable name, the dots are sampled according to the distribution of the corresponding variable. If \code{vars} consist of more than one variable names, then the dots are sampled according to the distributions of those variables. A categorical variable is added that contains the distrubtion classes (see \code{var.name}). -#' @param convert2density Should the variables be converted to density values? Density values are used for the sampling algorithm, so use \code{TRUE} when the values are absolute counts. -#' @param nrow Number of grid rows -#' @param ncol Number of grid colums -#' @param N Number of grid points -#' @param npop Population total. If \code{NA}, it is recontructed from the data. If density values are specified, the population total is approximated using the polygon areas (see also \code{target}, \code{orig} and \code{to}). -#' @param n Number of sampled dots -#' @param w Number of population units per dot. It is the population total divided by \code{n}. If specified, \code{n} is calculated accordingly. -#' @param shp.id Name of the variable of \code{shp} that contains the polygon identifying numbers or names. -#' @param var.name Name of the variable that will be created to store the classes. The classes are defined by \code{vars}, and the labels can be configured with \code{var.labels}. -#' @param var.labels Labels of the classes (see \code{var.name}). -#' @param target target unit, see \code{\link{approx_areas}} -#' @param randomize should the order of sampled dots be randomized? The dots are sampled class-wise (specified by \code{vars}). If this order is not randomized (so if \code{randomize=FALSE}), then the dots from the last class will be drawn on top, which may introduce a perception bias. By default \code{randomize=TRUE}, so the sampled dots are randomized to prevent this bias. -#' @param output format of the output: use \code{"points"} for spatial points, and \code{"grid"} for a spatial grid. -#' @param orig not used anymore as of version 2.0 -#' @param to not used anymore as of version 2.0 -#' @param ... other arguments passed on to \code{\link{calc_densities}} and \code{\link{approx_areas}} -#' @export -#' @return A shape object, in the same format as \code{shp} -#' @example ./examples/sample_dots.R -#' @importFrom raster raster extent rasterize couldBeLonLat crop -sample_dots <- function(shp, vars=NULL, convert2density=FALSE, nrow=NA, ncol=NA, N=250000, npop=NA, n=10000, w=NA, shp.id=NULL, var.name="class", var.labels=vars, target="metric", randomize=TRUE, output = c("points", "grid"), orig=NULL, to=NULL, ...) { - - .Deprecated("st_sample", package = "sf", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - args <- list(...) - - if (!missing(orig) || !missing(to)) warning("The arguments orig and to are not used anymore as of tmaptools version 2.0") - - is_sf <- inherits(shp, c("sf", "sfc")) - if (is_sf) shp <- as(shp, "Spatial") - - bbx <- shp@bbox - asp <- get_asp_ratio(shp) - np <- length(shp) - prj <- shp@proj4string - - projected <- is_projected(shp) - - k <- length(vars) - - ## process shape data - message("Please wait...") - data <- shp@data[, vars, drop=FALSE] - data <- as.data.frame(lapply(data, function(d) { - if (inherits(d, "units")) d <- as.numeric(d) - if (any(is.na(d))) { - message("Shape data contains missing values. Replaced with 0.") - d[is.na(d)] <- 0 - } - if (any(is.nan(d)) || any(is.infinite(d)) || any(d<0)) stop("Shape data contains NaN, infinite, or negative values") - d - })) - - ## find total population number, and convert data to density values - if (convert2density) { - if (!projected) warning("shp should be projected when convert2density=TRUE, for otherwise the sampling method is unreliable.", call. = FALSE) - - if (is.na(npop)) npop <- sum(data) - - # calculate densities - dens_args <- args[names(args) %in% c("total.area", "suffix")] - dens_args$suffix <- "" # overwrite suffix (to maintain vars) - data <- do.call("calc_densities", args = c(list(shp=shp, var=vars, target=target, drop=FALSE), dens_args)) - data[is.na(data)] <- 0 - } else { - # calculate absolute values - #if (!("total.area" %in% names(args)) && !projected) warning("unable to determine population total, unless total.area is specified.", call. = FALSE) - if (is.na(npop)) { - area_approx_args <- args[names(args) == "total.area"] - areas <- as.vector(do.call("approx_areas", args = c(list(shp=shp, target=target), area_approx_args))) - - npop <- sum(rowSums(data) * areas) - } - } - - # append aux variables - data$TOTAL__VARS <- rowSums(data) - data$ID__POLY <- 1:np - - ## align npop, n, and w - if (is.na(w)) { - w <- round(npop / n) - } else { - n <- round(npop / w) - } - - ## determine grid size - if (is.na(nrow) || is.na(ncol)) { - nrow <- round(sqrt(N/asp)) - ncol <- round(N / nrow) - } - N <- nrow * ncol - - ## rasterize (SLOW...) - r <- raster(extent(bbx), nrows=nrow, ncols=ncol, crs=prj) - r2 <- suppressWarnings({ # may have warnings about deprecated embedding lists with S4 - rasterize(shp, r, field=data$ID__POLY) #raster with poly id's - }) - r2@data@names <- "ID__POLY" - g <- as(r2, "SpatialGridDataFrame") - - - ## append data to raster - suppressMessages({ - g <- append_data(g, data=data, key.shp = "ID__POLY", key.data="ID__POLY", ignore.na=TRUE) - }) - - ## calculate data distributions - sm <- sum(g$TOTAL__VARS, na.rm=TRUE) - - # find number of grid points (N2) in region - notNA <- which(!is.na(g$ID__POLY)) - N2 <- length(notNA) - - ## calculate distributions (which sum up to 1) - distr <- g@data[notNA, vars, drop=FALSE] / sm - - ## for each grid cell with overlapping data distributions, sample a data point, and sum the probabilities - distr2 <- assign_rowsum_to_sampled_value(distr) - - # calculate number of points per class - sizes <- round(colSums(distr2) * n) - - # correct possible difference due to rounding - if (sum(sizes)!=n) sizes[1] <- n - sum(sizes[-1]) - - # check if n is not too large - mx_per_class <- apply(distr2, 2, function(i)sum(i!=0)) - if (any(sizes>mx_per_class)) { - rescale <- min(mx_per_class/sizes) - sizes <- floor(sizes * rescale) - n <- sum(sizes) - w <- round(npop / n) - warning("Too many dots. Number of dots downsized.", call. = FALSE) - } - - # do the sampling (could be slow...) - samples <- mapply(function(x, size) { - sample.int(n=N2, size= size, replace=FALSE, prob=x) - }, as.data.frame(distr2), sizes, SIMPLIFY=FALSE) - sam <- unlist(samples) - stopifnot(n == length(sam)) - - message("Grid size: ", nrow, " by ", ncol, " (", N, ")") - message("Number of dots = ", n) - - - if (projected || (!convert2density && ("total.area" %in% names(args)))) { - message("Population size = ", npop) - message("One dot represents ", w, " population units") - } - - output <- match.arg(output) - - if (output=="grid") { - g[[var.name]] <- NA - g[[var.name]][notNA[sam]] <- unlist(mapply(rep, vars, sapply(samples, length))) - g[[var.name]] <- factor(g[[var.name]], levels=vars, labels=var.labels) - - # append ID variable - if (!missing(shp.id)) { - g[[shp.id]] <- shp[[shp.id]][g$ID__POLY] - g@data[, c("ID__POLY", "ID__POLY.data", "TOTAL__VARS", vars)] <- list() - } - g - } else { - # convert to SPointsDF - p <- as(g, "SpatialPointsDataFrame") - p2 <- p[sam, ] - - if (k > 1) { - p2[[var.name]] <- factor(unlist(mapply(rep, vars, sapply(samples, length))), levels=vars, labels=var.labels) - } - - # append ID variable - if (!missing(shp.id)) p2[[shp.id]] <- shp[[shp.id]][p2$ID__POLY] - - # clean data - if (k<= 1) { - p2 <- as(p2, "SpatialPoints") - } else { - p2@data[, c("ID__POLY", "ID__POLY.data", "TOTAL__VARS", vars)] <- list() - } - - # shuffle points to prevent overplotting bias - p3 <- if (randomize) { - p2[sample.int(n), ] - } else p2 - } - - if (is_sf) as(p3, "sf") else p3 -} - -# For each row in matrix m, a value is sampled based on the values of that row. -# The corresponding row in the new matrix m2 will have the rowsum on that position, and zeros elsewhere -# Why used? Say a grid point has positive population density values for two out of three classes, say .01 and .03. -# The row in m is [0 .01 .03]. However, the point draw at the corresponding grid cell can have only one color. -# So, one value per row is sampled with the row values taken as probabilites. So 3/4 probability that the -# corresponding row in m2 is [0 0 .04] and 1/4 probability that it is [0 .04 0]. -# Only if the positive value in the m2 row is sampled later on, a dot will be colored according to the -# corresponding class. -assign_rowsum_to_sampled_value <- function(m) { - nr <- nrow(m) - nc <- ncol(m) - - rnd <- matrix(runif(nr*nc), nrow=nr, ncol=nc) - rnd2 <- m * rnd - - rnd_max <- apply(rnd2, 1, which.max) - ind <- nr*(rnd_max-1) + (1:nr) - - m2 <- matrix(0, nrow=nr, ncol=nc) - m2[ind] <- rowSums(m) - m2 -} diff --git a/R/sbind.R b/R/sbind.R deleted file mode 100644 index 15b9d09..0000000 --- a/R/sbind.R +++ /dev/null @@ -1,68 +0,0 @@ -#' Combine shape objects (from sp) (deprecated) -#' -#' Combine shape objects from sp into one shape object. It works analogous to \code{\link{rbind}}. -#' -#' @param ... shape objects. Each shape object is one of -#' \enumerate{ -#' \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} -#' \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} -#' \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -#' } -#' @return shape object -#' @import sp -sbind <- function(...) { - .Deprecated("", package = "", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - xlist <- list(...) - xlist <- xlist[!sapply(xlist, is.null)] - - k <- length(xlist) - x <- xlist[[1]] - if (!length(xlist)) stop("No shape objects specified.") - if (!all(sapply(xlist, class)==class(x))) stop("Objects have inconsistent classes") - - ids <- make.unique(unlist(lapply(xlist, get_IDs)), sep="_") - - if (inherits(x, "SpatialPoints")) { - crds <- lapply(xlist, slot, "coords") - coords <- unname(do.call("rbind", crds)) - shp <- SpatialPoints(coords, proj4string = x@proj4string) - } else if (inherits(x, "SpatialPolygons")) { - polys <- lapply(xlist, slot, "polygons") - polygons <- unname(do.call("c", polys)) - plotOrders <- lapply(xlist, slot, "plotOrder") - add <- cumsum(c(0, sapply(plotOrders, length)[-k])) - plotOrder <- as.integer(unlist(mapply("+", plotOrders, add, SIMPLIFY = FALSE))) - polygons <- mapply(function(p, id){ - p@ID <- id - p - }, polygons, ids, SIMPLIFY=FALSE) - shp <- SpatialPolygons(polygons, pO = plotOrder, - proj4string = x@proj4string) - } else if (inherits(x, "SpatialLines")) { - lns <- lapply(xlist, slot, "lines") - lines <- unname(do.call("c", lns)) - lines <- mapply(function(l, id){ - l@ID <- id - l - }, lines, ids, SIMPLIFY=FALSE) - shp <- SpatialLines(lines, proj4string = x@proj4string) - } else stop("Only spatial polygons, points, and lines are accepted.") - - if ("data" %in% slotNames(x)) { - dfs <- lapply(xlist, slot, "data") - if (!all(sapply(dfs[-1], function(d)identical(names(d), names(dfs[[1]]))))) { - stop("Inconsistent data columns") - } - data <- do.call("rbind", dfs) - - if (inherits(x, "SpatialPolygonsDataFrame")) { - shp <- SpatialPolygonsDataFrame(shp, data = data, match.ID = FALSE) - } else if (inherits(x, "SpatialPointsDataFrame")) { - shp <- SpatialPointsDataFrame(shp, data = data, match.ID = FALSE) - } else if (inherits(x, "SpatialLinesDataFrame")) { - shp <- SpatialLinesDataFrame(shp, data = data, match.ID = FALSE) - } - } - shp -} diff --git a/R/set_projection.R b/R/set_projection.R index 28d0ef1..bc2e378 100644 --- a/R/set_projection.R +++ b/R/set_projection.R @@ -1,142 +1,3 @@ -#' Set and get the map projection -#' -#' The function \code{set_projection} sets the projection of a shape file. It is -#' a convenient wrapper of \code{\link[sf:st_transform]{st_transform}} (or \code{\link[lwgeom:st_transform_proj]{st_transform_proj}}, see details) and -#' \code{\link[raster:projectRaster]{projectRaster}} with shortcuts for commonly -#' used projections. The projection can also be set directly in the plot call -#' with \code{\link[tmap:tm_shape]{tm_shape}}. This function is also used to set the current -#' projection information if this is missing. The function \code{get_projection} -#' is used to get the projection information. -#' -#' For \code{\link[sf:sf]{sf}} objects, \code{set_projection} first tries to use \code{\link[sf:st_transform]{sf::st_transform}}, which uses the GDAL API. For some projections, most notably Winkel Tripel (\code{"wintri"}), is doesn't work. In these cases, \code{set_projection} will use \code{\link[lwgeom:st_transform_proj]{lwgeom::st_transform_proj}}, which uses the PROJ.4 API. -#' -#' For raster objects, the projection method is based on the type of data. For numeric layers, the bilinear method is used, and for categorical layers the nearest neighbor. See \code{\link[raster:projectRaster]{projectRaster}} for details. -#' -#' @param shp shape object, which is an object from a class defined by the \code{\link[sf:sf]{sf}}, \code{\link[sp:sp]{sp}}, or \code{\link[raster:raster-package]{raster}} package. -#' @param projection new projection. See \code{\link{get_proj4}} for options. This argument is only used to transform the \code{shp}. Use \code{current.projection} to specify the current projection of \code{shp}. -#' @param current.projection the current projection of \code{shp}. See \code{\link{get_proj4}} for possible options. Only use this if the current projection is missing or wrong. -#' @param overwrite.current.projection logical that determines whether the current projection is overwritten if it already has a projection that is different. -#' @param output output format of the projection. One of \code{"character"}, \code{"crs"} (from \code{sf} package), \code{"epsg"} or \code{"CRS"} (from \code{sp}/\code{rgdal} package) -#' @param guess.longlat if \code{TRUE}, it checks if the coordinates are within -180/180 and -90/90, and if so, it returns the WGS84 longlat projection (which is \code{get_proj4("longlat")}). -#' @name set_projection -#' @rdname set_projection -#' @import sp -#' @importFrom raster projectRaster -#' @importFrom rgdal getPROJ4VersionInfo -#' @return \code{set_projection} returns a (transformed) shape object with updated projection information. \code{get_projection} returns the \code{PROJ.4} character string of \code{shp}. -#' @export -set_projection <- function(shp, projection=NA, current.projection=NA, overwrite.current.projection=FALSE) { - shp.name <- deparse(substitute(shp)) - - cls <- class(shp) - is_sp <- inherits(shp, "Spatial") - is_sp_raster <- inherits(shp, c("SpatialGrid", "SpatialPixels")) - if (is_sp) shp <- (if (is_sp_raster) brick(shp) else as(shp, "sf")) - - shp.crs <- get_projection(shp, output="crs") - current.crs <- get_proj4(current.projection, output = "crs") - proj.crs <- get_proj4(projection, output = "crs") - - if (is.na(shp.crs)) { - if (is.na(current.crs)) { - stop("Currect projection of shape object unknown. Please specify the argument current.projection. The value \"longlat\", which stands for Longitude-latitude (WGS84), is most commonly used.") - } else { - if (inherits(shp, "sf")) { - st_crs(shp) <- current.crs - } else { - shp@crs <- get_proj4(current.crs, output = "CRS") - } - #current.projection <- current.proj4 - } - } else { - if (!is.na(current.crs)) { - if (identical(current.crs, shp.crs)) { - warning("Current projection of ", shp.name, " already known.", call. = FALSE) - } else { - if (overwrite.current.projection) { - warning("Current projection of ", shp.name, " differs from ", current.crs$proj4string, ", but is overwritten.", call. = FALSE) - if (inherits(shp, "sf")) { - st_crs(shp) <- current.crs - } else { - shp@crs <- get_proj4(current.crs, output = "CRS") - } - - } else { - stop(shp.name, " already has projection: ", shp.crs$proj4string, ". This is different from the specified current projection ", current.crs$proj4string, ". If the specified projection is correct, use overwrite.current.projection=TRUE.", call. = FALSE) - } - } - } else { - current.crs <- shp.crs - } - } - - - if (!is.na(proj.crs)) { - PROJ4_version_nr <- get_proj4_version() - - if (length(grep("+proj=wintri", current.crs$proj4string, fixed = TRUE)) && PROJ4_version_nr < 491) { - stop("Unable to reproject a shape from the Winkel Tripel projection with PROJ.4 version < 4.9.1") - } - - - if (inherits(shp, "Raster")) { - proj.CRS <- get_proj4(proj.crs, output = "CRS") - - #raster_data <- get_raster_data(shp) - has_color_table <- (length(colortable(shp))>0) - - # get factor levels (to be restored later) - lvls <- get_raster_levels(shp, 1:nlayers(shp)) - # override factor levels with colortable values - if (has_color_table) { - lvls <- list(colortable(shp)) -# raster_data <- data.frame(PIXEL__COLOR=getValues(shp[[1]])+1L) - } - isnum <- sapply(lvls, is.null) - new_ext <- suppressWarnings(projectExtent(shp, crs = proj.CRS)) - if (any(isnum) && !all(isnum)) { - shp_num <- raster::subset(shp, subset=which(isnum)) - shp_cat <- raster::subset(shp, subset=which(!isnum)) - shp_num2 <- suppressWarnings(projectRaster(shp_num, to=new_ext, crs=proj.CRS, method="bilinear")) - shp_cat2 <- suppressWarnings(projectRaster(shp_cat, to=new_ext, crs=proj.CRS, method="ngb")) - - # restore order - o <- order(c(which(isnum), which(!isnum))) - rlayers <- c(lapply(1:nlayers(shp_num), function(i) raster(shp_num2, layer=i)), - lapply(1:nlayers(shp_cat), function(i) raster(shp_cat2, layer=i)))[o] - shp <- do.call("brick", rlayers) - } else if (all(isnum)) { - shp <- suppressWarnings(projectRaster(shp, to=new_ext, crs=proj.CRS, method="bilinear")) - } else { - shp <- suppressWarnings(projectRaster(shp, to=new_ext, crs=proj.CRS, method="ngb")) - } - - # new_raster_data <- as.data.frame(mapply(function(d, l) { - # if (!is.null(l) && !is.factor(d)) factor(d, levels=1:length(l), labels=l) else d - # }, get_raster_data(shp), lvls, SIMPLIFY=FALSE)) - - if (any(!isnum)) shp <- set_raster_levels(shp, lvls) - # shp@data@isfactor <- !isnum - # dfs <- mapply(function(nm, lv) { - # df <- data.frame(ID=1:length(lv), levels=factor(lv, levels=lv)) - # if (cls=="RasterBrick") names(df)[2] <- nm - # df - # }, names(which(!isnum)), lvls[!isnum], SIMPLIFY=FALSE) - # shp@data@attributes <- dfs - } else { - shp <- st_transform2(shp, proj.crs) - } - if (is_sp_raster) { - shp <- as(shp, cls) - names(shp) <- names(isnum) - } - } - - shp - - #if (is_sp && !is_sp_raster) as(shp, cls) else shp -} - st_transform2 <- function(x, crs, ...) { args <- list(...) y <- tryCatch(do.call(sf::st_transform, c(list(x=x, crs=crs), args)), @@ -150,35 +11,3 @@ st_transform2 <- function(x, crs, ...) { } y } - - - - - - -#' @name get_projection -#' @rdname set_projection -#' @export -get_projection <- function(shp, guess.longlat=FALSE, - output = c("character", "crs", "epsg", "CRS")) { - p <- if (inherits(shp, c("sf", "sfc", "stars"))) { - st_crs(shp) - } else if (inherits(shp, "Spatial")) { - st_crs(attr(attr(shp, "proj4string"), "projargs")) - } else if (inherits(shp, "Raster")) { - st_crs(attr(attr(shp, "crs"), "projargs")) - } else { - stop("shp is neither a sf, sp, raster, nor a stars object") - } - - output <- match.arg(output) - - switch(output, - character = p$proj4string, - crs = p, - epsg = p$epsg, - CRS = CRS(ifelse(is.na(p$proj4string), "", p$proj4string)) - ) -} - - diff --git a/R/sf_stars_functions.R b/R/sf_stars_functions.R new file mode 100644 index 0000000..88532bc --- /dev/null +++ b/R/sf_stars_functions.R @@ -0,0 +1,11 @@ +to_sf_stars <- function(x) { + if (inherits(x, c("sf", "sfc", "stars"))) { + x + } else if (inherits(x, c("Raster", "SpatialGrid", "SpatialPixels"))) { + stars::st_as_stars(x) + } else if (inherits(x, "sp")) { + as(x, "sf") + } else { + stop("unknown spatial object", call. = FALSE) + } +} diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 5d6cbd7..8b758e3 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -4,7 +4,7 @@ #' #' This function is a wrapper of \code{\link[rmapshaper:ms_simplify]{ms_simplify}}. In addition, the data is preserved. Also \code{\link[sf:sf]{sf}} objects are supported. #' -#' @param shp a \code{\link[sp:SpatialPolygons]{SpatialPolygons(DataFrame)}} or a \code{\link[sp:SpatialLines]{SpatialLines(DataFrame)}}, or an \code{\link[sf:sf]{sf}} object that can be coerced to one of them. +#' @param shp an \code{\link[sf:sf]{sf}} object. #' @param fact simplification factor, number between 0 and 1 (default is 0.1) #' @param keep.units d #' @param keep.subunits d @@ -16,14 +16,6 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS if (!requireNamespace("rmapshaper", quietly = TRUE)) { stop("rmapshaper package is needed for simplify_shape", call. = FALSE) } else { - is_sp <- inherits(shp, "Spatial") - - if (is_sp) shp <- as(shp, "sf") - #if (!inherits(shp, c("SpatialLines", "SpatialPolygons"))) stop("shp is not a SpatialPolygons or SpatialLines object") - - #hasData <- "data" %in% names(attributes(shp)) - - # shape names are stored, because ms_simplify does not differentiate between upper- and lowercase sfcol <- attr(shp, "sf_column") dataNames <- setdiff(names(shp), sfcol) @@ -31,16 +23,28 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS dataNames_new <- paste(dataNames, 1L:length(dataNames), sep ="__") names(shp)[match(dataNames, names(shp))] <- dataNames_new + + unitCols <- which(sapply(shp, inherits, "units")) + if (length(unitCols) > 0) { + units <- lapply(sf::st_drop_geometry(shp[, unitCols]), attr, "units") + shp[, unitCols] <- lapply(sf::st_drop_geometry(shp[, unitCols]), as.numeric) + } + shp$UNIT__NR <- 1L:nrow(shp) keep_shapes <- keep.units explode <- keep_shapes && keep.subunits x <- suppressWarnings(rmapshaper::ms_simplify(shp, keep=fact, keep_shapes=keep_shapes, explode=explode, ...)) - if (explode) x <- aggregate_map(x, by="UNIT__NR", agg.fun = first) + + if (explode) x <- aggregate(x, by = list(x$UNIT__NR), FUN = function(x)x[1]) x[, c("rmapshaperid", "UNIT__NR")] <- list() names(x)[match(dataNames_new, names(x))] <- dataNames + if (length(unitCols) > 0) { + shp[, unitCols] <- mapply(units::as_units, sf::st_drop_geometry(shp[, unitCols]), units, SIMPLIFY = FALSE) + } + if (!all(sf::st_is_valid(x))) { if (!requireNamespace("lwgeom", quietly = TRUE)) { stop("simplified shape is not valid and needs to be fixed; please install the lwgeom package and rerun this function", call. = FALSE) diff --git a/R/smooth_map.R b/R/smooth_map.R deleted file mode 100644 index 5353460..0000000 --- a/R/smooth_map.R +++ /dev/null @@ -1,454 +0,0 @@ -#' Create a smooth map (deprecated) -#' -#' Create a smooth map from a shape object. A 2D kernel density estimator is applied to the shape, which can be a spatial points, polygons, or raster object. Various format are returned: a smooth raster, contour lines, and polygons. The covered area can be specified, i.e., the area outside of it is extracted from the output. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' For the estimation of the 2D kernal density, code is borrowed from \code{\link[KernSmooth:bkde2D]{bkde2D}}. This implemention is slightly different: \code{\link[KernSmooth:bkde2D]{bkde2D}} takes point coordinates and applies linear binning, whereas in this function, the data is already binned, with values 1 if the values of \code{var} are not missing and 0 if values of \code{var} are missing. -#' -#' This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -#' -#' @param shp shape object of class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}. Spatial points, polygons, and grids are supported. Spatial lines are not. -#' @param var variable name. Not needed for \code{\link[sp:SpatialPoints]{SpatialPoints}}. If missing, the first variable name is taken. For polygons, the variable should contain densities, not absolute numbers. -#' @param nrow number of rows in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}} -#' @param ncol number of rows in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}} -#' @param N preferred number of points in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}} -#' @param unit unit specification. Needed when calculating density values. When set to \code{NA}, the densities values are based on the dimensions of the raster (defined by \code{nrow} and \code{ncol}). See also \code{unit.size}. -#' @param unit.size size of the unit in terms of coordinate units. The coordinate system of many projections is approximately in meters while thematic maps typically range many kilometers, so by default \code{unit="km"} and \code{unit.size=1000} (meaning 1 kilometer equals 1000 coordinate units). -#' @param smooth.raster logical that determines whether 2D kernel density smoothing is applied to the raster shape object. Not applicable when \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} object (since it already requires a 2D kernel density estimator). Other spatial objects are converted to a raster, which is smoothed when \code{smooth.raster=TRUE}. -#' @param nlevels preferred number of levels -#' @param style method to cut the color scale: e.g. "fixed", "equal", "pretty", "quantile", or "kmeans". See the details in \code{\link[classInt:classIntervals]{classIntervals}}. -#' @param breaks in case \code{style=="fixed"}, breaks should be specified -#' @param bandwidth single numeric value or vector of two numeric values that specifiy the bandwidth of the kernal density estimator. By default, it is 1/50th of the shortest side in units (specified with \code{unit.size}). -#' @param threshold threshold value when a 2D kernel density is applied. Density values below this threshold will be set to \code{NA}. Only applicable when \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} or \code{smooth.raster=TRUE}. -#' @param cover.type character value that specifies the type of raster cover, in other words, how the boundaries are specified. Options: \code{"original"} uses the same boundaries as \code{shp} (default for polygons), \code{"smooth"} calculates a smooth boundary based on the 2D kernal density (determined by \code{\link{smooth_raster_cover}}), \code{"rect"} uses the bounding box of \code{shp} as boundaries (default for spatial points and grids). -#' @param cover \code{\link[sp:SpatialPolygons]{SpatialPolygons}} shape that determines the covered area in which the contour lines are placed. If specified, \code{cover.type} is ignored. -#' @param cover.threshold numeric value between 0 and 1 that determines which part of the estimated 2D kernal density is returned as cover. Only applicable when \code{cover.type="smooth"}. -#' @param weight single number that specifies the weight of a single point. Only applicable if \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} object. -#' @param extracting.method Method of how coordinates are extracted from the kernel density polygons. Options are: \code{"full"} (default), \code{"grid"}, and \code{"single"}. See details. For the slowest method \code{"full"}, \code{\link[raster:extract]{extract}} is used. For \code{"grid"}, points on a grid layout are selected that intersect with the polygon. For \code{"simple"}, a simple point is generated with \code{\link[rgeos:gPointOnSurface]{gPointOnSurface}}. -#' @param buffer.width Buffer width of the iso lines to cut kernel density polygons. Should be small enough to let the polygons touch each other without space in between. However, too low values may cause geometric errors. -#' @param to.Raster not used anymore, since the "raster" output is always a \code{\link[raster:Raster-class]{RasterLayer}} as of version 2.0 -#' @return List with the following items: -#' \describe{ -#' \item{\code{"raster"}}{A smooth raster, which is either a \code{\link[sp:SpatialGridDataFrame]{SpatialGridDataFrame}} or a \code{\link[raster:Raster-class]{RasterLayer}} (see \code{to.Raster})} -#' \item{\code{"iso"}}{Contour lines, which is an \code{\link[sf:sf]{sf}} object of spatial lines.} -#' \item{\code{"polygons"}}{Kernel density polygons, which is an \code{\link[sf:sf]{sf}} object of spatial polygons} -#' \item{\code{"bbox"}}{Bounding box of the used raster} -#' \item{\code{"ncol"}}{Number of rows in the raster} -#' \item{\code{"nrow"}}{Number of columns in the raster} -#' } -#' @importFrom raster raster extent couldBeLonLat extract extend rasterToContour brick nlayers fromDisk colortable projectExtent -#' @importMethodsFrom raster as.vector -#' @importFrom rgeos gConvexHull gUnaryUnion gPointOnSurface gContains gIsValid gIntersection gArea gBuffer gDifference -#' @importFrom KernSmooth bkde2D -#' @importFrom grDevices contourLines colorRampPalette dev.off png col2rgb colors rgb -#' @importFrom methods as slot slotNames -#' @importFrom stats na.omit runif dnorm fft -#' @importFrom utils download.file head setTxtProgressBar tail txtProgressBar -#' @import RColorBrewer -#' @importFrom classInt classIntervals findCols -#' @example ./examples/smooth_map.R -#' @export -smooth_map <- function(shp, var=NULL, nrow=NA, ncol=NA, N=250000, unit="km", unit.size=1000, smooth.raster=TRUE, nlevels=5, style = ifelse(is.null(breaks), "pretty", "fixed"), breaks = NULL, bandwidth=NA, threshold=0, cover.type=NA, cover=NULL, cover.threshold=.6, weight=1, extracting.method="full", buffer.width=NA, to.Raster=NULL) { - .Deprecated("", package = "", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - if (!missing(to.Raster)) warning("to.Raster is not used anymore, since the \"raster\" output is always a raster object as of version 2.0") - - is_sf <- inherits(shp, c("sf", "sfc")) - if (is_sf) shp <- as(shp, "Spatial") - - bbx <- as.vector(bb(shp)) - prj <- get_projection(shp) -# asp <- get_asp_ratio(shp) - - pb <- txtProgressBar(style=3) - - if (!inherits(shp, c("SpatialPoints", "SpatialPolygons", "SpatialGrid", "Raster"))) { - stop("shp is not a Raster nor a SpatialPoints, -Polygons, or -Grid object") - } - - if (!inherits(shp, c("SpatialPoints"))) { - if (inherits(shp, "Spatial") && !("data" %in% slotNames(shp))) stop("No data found in shape.") - if (missing(var)) var <- names(shp)[1] - } - - - ## determine bounding box and grid size - if (inherits(shp, c("SpatialPoints", "SpatialPolygons"))) { - bbx <- as.vector(bb(bbx, ext=-1.05)) - shp@bbox <- matrix(bbx, ncol=2) - asp <- get_asp_ratio(shp) - if (is.na(nrow) || is.na(ncol)) { - nrow <- round(sqrt(N/asp)) - ncol <- round(N / nrow) - } - - } else { - #if (inherits(shp, "Raster")) shp <- as(shp, "SpatialGridDataFrame") - if (!inherits(shp, "RasterLayer")) shp <- raster(shp, layer=var) - # if (inherits(shp, "SpatialGrid")) { - # shp <- raster(shp, layer=var) - # } else { - # shp <- raster(shp, layer=var) - # } - # shp <- as(shp, "SpatialGridDataFrame") - ncol <- ncol(shp) - nrow <- nrow(shp) - - #ncol <- shp@grid@cells.dim[1] - #nrow <- shp@grid@cells.dim[2] - } - N <- nrow * ncol - - # determine cell area (needed to calculate densities) - if (!is_projected(shp) || is.na(unit)) { - warning("shp is not projected; therefore density values cannot be calculated", call. = FALSE) - cell.area <- 1 - } else { - cell.width <- (bbx[3] - bbx[1]) / (unit.size * ncol) - cell.height <- (bbx[4] - bbx[2]) / (unit.size * nrow) - cell.area <- cell.width * cell.height - } - - - - # edit bandwidth - if (is.na(bandwidth[1])) { - #bandwidth <- 3 * (bbx[,2] - bbx[,1]) / c(ncol, nrow) - short_side <- min((bbx[3:4] - bbx[1:2]) / unit.size) - bandwidth <- rep(short_side/100, 2) - } else { - # make sure bandwith is a vector of 2 - bandwidth <- rep(bandwidth, length.out=2) - } - - # create an empty grid - cover_r <- raster(extent(bbx[c(1,3,2,4)]), nrows=nrow, ncols=ncol, crs=prj) - - setTxtProgressBar(pb, .1) - - ## process cover: fill the empty grid with T/F that indicates whether grid cells are inside or not - if (is.na(cover.type)) cover.type <- ifelse(inherits(shp, "SpatialPolygons"), "original", "rect") - if (missing(cover)) { - - if (cover.type=="rect") { - cover <- as(extent(bbx[c(1,3,2,4)]), "SpatialPolygons") - if (!is.na(prj)) cover <- as(set_projection(cover, current.projection = prj), "Spatial") - cover_r[] <- TRUE - } else if (cover.type=="original") { - if (inherits(shp, "Raster")) { - warning("cover.type=\"original\" only applied to raster output") - cover <- as(extent(bbx[c(1,3,2,4)]), "SpatialPolygons") - if (!is.na(prj)) cover <- as(set_projection(cover, current.projection = prj), "Spatial") - - cover_r <- shp - - } else { - if (inherits(shp, "SpatialPoints")) { - cover <- gConvexHull(shp) - } else if (inherits(shp, "SpatialPolygons")) { - cover <- gUnaryUnion(shp) - } - cover <- checknfix_sp(cover) - cover@bbox <- matrix(bbx, ncol=2) - cover_r <- poly_to_raster(cover, nrow = nrow, ncol = ncol) - } - } else if (cover.type=="smooth") { - if (!inherits(shp, "Raster")) stop("Raster shape required when cover.type=\"smooth\"") - cover_list <- smooth_raster_cover(shp, var=var, bandwidth = bandwidth*unit.size, threshold = cover.threshold, output=c("raster", "polygons")) - cover_r <- cover_list$raster - cover_r[!cover_r[]] <- NA - cover <- as(cover_list$polygons, "Spatial") - } - } else { - if (inherits(cover, c("sf", "sfc"))) cover <- as(cover, "Spatial") - - cover <- gUnaryUnion(cover) - cover <- spTransform(cover, CRS(prj)) - - cover <- checknfix_sp(cover) - - cover_r <- poly_to_raster(cover, nrow = nrow, ncol = ncol) - bbc <- as.vector(bb(cover)) - bbx[1:2] <- pmin(bbx[1:2], bbc[1:2]) - bbx[3:4] <- pmin(bbx[3:4], bbc[3:4]) - } - setTxtProgressBar(pb, .3) - - - if (inherits(shp, "SpatialPoints")) { - # for spatial points, use the 2d binned kernel density estimator from KernSmooth - co <- coordinates(shp) - x <- bkde2D(co, bandwidth=bandwidth*unit.size, gridsize=c(ncol, nrow), range.x=list(bbx[c(1,3)], bbx[c(2,4)])) - - var <- "count" - } else { - # otherwise, the shape is converted to a raster (if it isn't already) - if (inherits(shp, "SpatialPolygons")){ - shp@data <- shp@data[,var, drop=FALSE] - shp <- poly_to_raster(shp, nrow = nrow, ncol=ncol, copy.data = TRUE) - } - # get raster with selected variable - # shpr <- raster(shp, layer=var) - # browser() - - if (smooth.raster) { - # apply 2d kernel density estimator, similar to bkde2D, but without binning (since this is already binned data) - m <- as.matrix(shp) - x <- kde2D(m, bandwidth = bandwidth*unit.size, gridsize=c(ncol, nrow), range.x=list(bbx[c(1,3)], bbx[c(2,4)])) - - } else { - # copy raster (without 2d kernel density) and deterine levels - r <- shp - lvls <- num2breaks(as.vector(r[]), n=nlevels, style=style, breaks=breaks)$brks - } - } - setTxtProgressBar(pb, .5) - - - apply2kde <- inherits(shp, "SpatialPoints") || smooth.raster - - if (apply2kde) { - # fill raster values - r <- raster(extent(bbx[c(1,3,2,4)]), nrows=nrow, ncols=ncol, crs=prj) - r[] <- as.vector(x$fhat[, ncol(x$fhat):1]) - names(r) <- var - - # apply cover - r[is.na(cover_r[])] <- NA - - # normalize r and x$fhat - if (inherits(shp, "SpatialPoints")) { - norm_weight <- length(shp) * weight / sum(r[], na.rm=TRUE) / cell.area - } else { - norm_weight <- sum(shp[], na.rm=TRUE) / sum(r[], na.rm=TRUE) - } - r[] <- r[] * norm_weight #/ cell.area - x$fhat <- x$fhat * norm_weight #/ cell.area - - #x$fhat[x$fhat < threshold] <- NA -#browser() - - lvls <- num2breaks(as.vector(x$fhat), n=nlevels, style=style, breaks=breaks)$brks - #brks <- fancy_breaks(lvls, intervals=TRUE) - - # check if threshold can be applied (i.e. if values < threshold => NA) - thresLevel <- (lvls[1]==0 && lvls[2] > threshold && threshold != 0) - if (thresLevel) { - lvls_orig <- lvls - lvls <- c(lvls[1], threshold, lvls[-1]) - } - - cl <- contourLines(x$x1, x$x2, x$fhat, levels=lvls) - if (length(cl) < 1L) { - warning("No iso lines found") - cl2 <- NULL - } else { - if (length(cl) > 10000) stop(paste("Number of iso lines over 10000:", length(cl))) - cl2 <- contour_lines_to_SLDF(cl, proj4string = CRS(prj)) - if (thresLevel) levels(cl2$level) <- c(0, levels(cl2$level)[-1]) - } - - #cl2$levelNR <- as.numeric(as.character(cl2$level)) - } else { - # no 2d kernel density has been applied. Instead contour lines are found from the original raster - thresLevel <- FALSE - - bbr <- as.vector(bb(r)) - - # extend raster to prevent bleeding (due to isolines that do not reach the boundary) - rxtra <- (floor(nrow(r) / 10) + 1) * 2 - cxtra <- (floor(ncol(r) / 10) + 1) * 2 - bbr2 <- as.vector(bb(bbr, width=(ncol(r)+cxtra)/ncol(r), - height=(nrow(r)+rxtra)/nrow(r), - relative=TRUE)) - - r2 <- extend(r, extent(bbr2[c(1,3,2,4)])) - r2[1:(rxtra/2),(cxtra/2+1):(ncol(r2)-cxtra/2)] <- r[1,] - r2[(nrow(r2)-(rxtra/2)+1):nrow(r2),(cxtra/2+1):(ncol(r2)-cxtra/2)] <- r[nrow(r),] - - r2[,1:(cxtra/2)] <- r2[,cxtra/2+1] - r2[,(ncol(r2)-cxtra/2+1):ncol(r2)] <- r2[,ncol(r2)-cxtra/2] - - cl2 <- rasterToContour(r2, maxpixels = length(r2), levels=lvls) - } - setTxtProgressBar(pb, .7) - - - - # make sure lines are inside poly - cp <- suppressWarnings(lines2polygons(ply = cover, lns = cl2, rst = r, lvls=lvls, extracting.method="full", buffer.width = buffer.width)) - if (thresLevel) { - ids <- as.integer(cp$level) - ids[ids==1] <- NA - ids <- ids - 1L - cp$level <- factor(ids, levels=1:(length(lvls_orig)-1), labels=fancy_breaks(lvls_orig, intervals=TRUE), ordered = TRUE) - } - - - cp <- as(cp, "sf") - - attr(cp, "kernel_density") <- TRUE - - setTxtProgressBar(pb, .9) - - if (!is.null(cl2)) { - lns <- SpatialLinesDataFrame(suppressWarnings(gIntersection(cover, cl2, byid = TRUE)), data=cl2@data, match.ID = FALSE) - lns <- as(lns, "sf") - attr(lns, "isolines") <- TRUE - } else { - lns <- NULL - } - - setTxtProgressBar(pb, 1) - - if (apply2kde && thresLevel) r[][r[]= threshold, drop=FALSE) - - # RasterLayer - RL <- raster(SG, layer="cover") - - if (length(output)==1) { - switch(output, - lines=SL, - polygons=SP, - raster=RL) - } else { - names(output) <- output - lapply(output, function(out) { - switch(out, - lines=SL, - polygons=SP, - raster=RL) - }) - } -} diff --git a/R/to_raster.R b/R/to_raster.R deleted file mode 100644 index c58e438..0000000 --- a/R/to_raster.R +++ /dev/null @@ -1,186 +0,0 @@ -#' Bin spatial points to a raster (deprecated) -#' -#' Bin spatial points to a raster. For each raster cell, the number of points are counted. Optionally, a factor variable can be specified by which the points are counts are split. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -#' -#' This function is a wrapper around \code{\link[raster:rasterize]{rasterize}}. -#' -#' This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -#' -#' @param shp shape object. a \code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}, a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}, or an \code{\link[sf:sf]{sf}} object that can be coerced as such. -#' @param nrow number of raster rows. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}. -#' @param ncol number of raster columns. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}. -#' @param N preferred number of raster cells. -#' @param by name of a data variable which should be a factor. The points are split and counted according to the levels of this factor. -#' @param to.Raster not used anymore, since the output is always a \code{\link[raster:Raster-class]{raster}} as of version 2.0 -#' @return a \code{RasterBrick} is returned when \code{by} is specified, and a \code{RasterLayer} when \code{by} is unspecified. -#' @export -#' @importFrom raster raster extent rasterize -#' @example ./examples/points_to_raster.R -#' @seealso \code{\link{poly_to_raster}} -points_to_raster <- function(shp, nrow=NA, ncol=NA, N=250000, by=NULL, to.Raster=NULL) { - - .Deprecated("rasterize", package = "raster", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - - if (!missing(to.Raster)) warning("to.Raster is not used anymore, since the output is always a raster object as of version 2.0") - - - if (inherits(shp, c("sf", "sfc"))) shp <- as(shp, "Spatial") - - if (!inherits(shp, "SpatialPoints")) stop("shp should be a SpatialPoints/Pixels(DataFrame)") - - if (inherits(shp, "SpatialPointsDataFrame") && length(names(shp)) == 0) { - shp <- as(shp, "SpatialPoints") - } - - - # get shp metadata - bbx <- bb(shp) - prj <- shp@proj4string - np <- length(shp) - asp <- get_asp_ratio(shp) - hasData <- "data" %in% names(attributes(shp)) - - # convert to points if necessary - if (inherits(shp, "SpatialPixels")) { - shp <- as(shp, ifelse(hasData, "SpatialPointsDataFrame", "SpatialPoints")) - } - - # determine grid size - if (is.na(nrow) || is.na(ncol)) { - nrow <- round(sqrt(N/asp)) - ncol <- round(N / nrow) - } - N <- nrow * ncol - - # create empty raster - r <- raster(extent(bbx[c(1,3,2,4)]), nrows=nrow, ncols=ncol, crs=prj) - - # process by variable - if (missing(by)) { - var <- factor(rep(1L, np), labels="count") - } else { - var <- shp[[by]] - if (!is.factor(var)) stop("by variable is not a factor") - } - lvls <- make.names(levels(var)) - names(lvls) <- lvls - levels(var) <- lvls - - shps <- split_shape(shp, f=var) - - res <- as.data.frame(lapply(shps, function(s) { - if ("data" %in% names(attributes(s))) { - s$ones <- 1 - } else s <- SpatialPointsDataFrame(s, data=data.frame(ones=rep(1, length(s))), match.ID=FALSE) - rst <- suppressWarnings({ # may have warnings about deprecated embedding lists with S4 - rasterize(s, r, field="ones", fun='count') - }) - rst@data@values - })) - rshp <- SpatialGridDataFrame(as(r, "SpatialGrid"), data=res) - - # return Raster object or SGDF - if (ncol(rshp@data)==1) { - as(rshp, "RasterLayer") - } else { - as(rshp, "RasterBrick") - } -} - -#' Convert spatial polygons to a raster (deprecated) -#' -#' Convert spatial polygons to a raster. The value of each raster cell will be the polygon ID number. Alternatively, if \code{copy.data}, the polygon data is appended to each raster cell. -#' -#' @param shp shape object. A \code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}, a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}, or an \code{sf} object that can be coerced as such. -#' @param r \code{\link[raster:raster]{Raster}} object. If not specified, it will be created from the bounding box of \code{shp} and the arguments \code{N}, \code{nrow}, and \code{ncol}. -#' @param nrow number of raster rows. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}. -#' @param ncol number of raster columns. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}. -#' @param N preferred number of raster cells. -#' @param use.cover logical; should the cover method be used? This method determines per raster cell which polygon has the highest cover fraction. This method is better, but very slow, since N times the number of polygons combinations are processed (using the \code{getCover} argument of \code{\link[raster:rasterize]{rasterize}}). By default, when a raster cell is covered by multiple polygons, the last polygon is taken (see \code{fun} argment of \code{\link[raster:rasterize]{rasterize}})) -#' @param copy.data should the polygon data be appended to the raster? Only recommended when \code{N} is small. -#' @param to.Raster not used anymore, since the "raster" output is always a \code{\link[raster:Raster-class]{RasterLayer}} as of version 2.0 -#' @param ... arguments passed on to \code{\link[raster:rasterize]{rasterize}} -#' @return a \code{RasterBrick} is returned when \code{by} is specified, and a \code{RasterLayer} when \code{by} is unspecified -#' @export -#' @importFrom raster raster extent rasterize getValues -#' @example ./examples/poly_to_raster.R -#' @seealso \code{\link{points_to_raster}} -poly_to_raster <- function(shp, r=NULL, nrow=NA, ncol=NA, N=250000, use.cover=FALSE, copy.data=FALSE, to.Raster=NULL, ...) { - .Deprecated("rasterize", package = "raster", msg = "This function is deprecated and has been migrated to github.com/mtennekes/oldtmaptools") - - if (!missing(to.Raster)) warning("to.Raster is not used anymore, since the output is always a raster object as of version 2.0") - - if (inherits(shp, c("sf", "sfc"))) shp <- as(shp, "Spatial") - - if (!inherits(shp, "SpatialPolygons")) stop("shp should be a SpatialPolygons(DataFrame)") - - np <- length(shp) - hasData <- "data" %in% names(attributes(shp)) - - if (missing(r)) { - # get shp metadata - bbx <- bb(shp, output = "matrix") - asp <- get_asp_ratio(shp) - # determine grid size - if (is.na(nrow) || is.na(ncol)) { - nrow <- round(sqrt(N/asp)) - ncol <- round(N / nrow) - } - N <- nrow * ncol - # create empty raster - r <- raster(extent(bbx), nrows=nrow, ncols=ncol) - } - - # add ID data variable - if (!hasData) { - shp <- SpatialPolygonsDataFrame(shp, data=data.frame(ID__UNITS = 1:np), match.ID=FALSE) - } else { - shp$ID__UNITS <- 1:np - } - - # get shape data (including ID variable) - d <- shp@data - - # create raster of ID values - if (use.cover) { - res <- do.call("cbind", lapply(1:np, function(i) { - s <- shp[i, ] - rst <- suppressWarnings({ # may have warnings about deprecated embedding lists with S4 - rasterize(s, r, field="ID__UNITS", getCover=TRUE, ...) - }) - raster::getValues(rst) - })) - IDs <- apply(res, MARGIN=1, which.max) - } else { - rst <- suppressWarnings({ # may have warnings about deprecated embedding lists with S4 - rasterize(shp, r, field="ID__UNITS", getCover=FALSE, ...) - }) - if (copy.data) IDs <- getValues(rst) - } - - rst@crs@projargs <- shp@proj4string@projargs - - if (!copy.data) { - return(rst) - } - - - # convert to SGDF and append data - rshp <- as(rst, "SpatialGridDataFrame") - rshp@data <- d[match(IDs, d$ID__UNITS),,drop=FALSE] - - # remove temp variable, or rename it to ID - if (hasData) { - rshp$ID__UNITS <- NULL - } else { - names(rshp) <- "ID" - } - - # return Raster object or SGDF - if (ncol(rshp@data)==1) { - as(rshp, "RasterLayer") - } else { - as(rshp, "RasterBrick") - } -} diff --git a/examples/aggregate_map.R b/examples/aggregate_map.R deleted file mode 100644 index ffc1bde..0000000 --- a/examples/aggregate_map.R +++ /dev/null @@ -1,42 +0,0 @@ -\dontrun{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { - data(land) - - # original map - qtm(land, raster="cover_cls") - - # map decreased by factor 4 for each dimension - land4 <- aggregate_map(land, fact=4, agg.fun="modal") - qtm(land4, raster="cover_cls") - - # map decreased by factor 8, where the variable trees is - # aggregated with mean, min, and max - land_trees <- aggregate_map(land, fact=8, - agg.fun=list(trees="mean", trees="min", trees="max")) - - tm_shape(land_trees) + - tm_raster(c("trees.1", "trees.2", "trees.3"), title="Trees (%)") + - tm_facets(free.scales=FALSE) + - tm_layout(panel.labels = c("mean", "min", "max")) - - data(NLD_muni, NLD_prov) - - # aggregate Dutch municipalities to provinces - NLD_prov2 <- aggregate_map(NLD_muni, by="province", - agg.fun = list(population="sum", origin_native="mean", origin_west="mean", - origin_non_west="mean", name="modal"), weights = "population") - - # see original provinces data - as.data.frame(NLD_prov)[, c("name", "population", "origin_native", - "origin_west", "origin_non_west")] - - # see aggregates data (the last column corresponds to the most populated municipalities) - sf::st_set_geometry(NLD_prov2, NULL) - - # largest municipalities in area per province - NLD_largest_muni <- aggregate_map(NLD_muni, by="province", - agg.fun = list(name="modal"), weights = "AREA") - - sf::st_set_geometry(NLD_largest_muni, NULL) -} -} diff --git a/examples/append_data.R b/examples/append_data.R deleted file mode 100644 index 358711d..0000000 --- a/examples/append_data.R +++ /dev/null @@ -1,30 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(World) - - f <- tempfile() - download.file("http://kejser.org/wp-content/uploads/2014/06/Country.csv", destfile = f) - domain_codes <- read.table(f, header=TRUE, sep="|") - unlink(f) - - domain_codes <- subset(domain_codes, select = c("Alpha3Code", "TopLevelDomain")) - domain_codes$Alpha3Code <- toupper(domain_codes$Alpha3Code) - - World <- append_data(World, domain_codes, key.shp = "iso_a3", key.data = "Alpha3Code", - ignore.na = TRUE) - - # codes in the data, but not in Europe: - oc <- over_coverage() - oc$value - - # Countries without appended data: - uc <- under_coverage() - - current_mode <- tmap_mode("view") - qtm(World[uc$id,], text="name") - - # plot the result - qtm(World, text="TopLevelDomain") - tmap_mode(current_mode) -} -} diff --git a/examples/approx_areas.R b/examples/approx_areas.R index 2636311..bceb72a 100644 --- a/examples/approx_areas.R +++ b/examples/approx_areas.R @@ -28,5 +28,5 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { approx_areas(NLD_muni, target = "mi mi") %>% summary_areas() # area of the polygons when unprojected - approx_areas(NLD_muni %>% set_projection(projection="longlat")) %>% summary_areas() + approx_areas(NLD_muni %>% sf::st_transform(crs = 4326)) %>% summary_areas() } diff --git a/examples/approx_distances.R b/examples/approx_distances.R index 5e51fe1..87e9390 100644 --- a/examples/approx_distances.R +++ b/examples/approx_distances.R @@ -8,10 +8,10 @@ if (require(tmap)) { # Distance between Maastricht and Groningen p_maastricht <- geocode_OSM("Maastricht")$coords p_groningen <- geocode_OSM("Groningen")$coords - approx_distances(p_maastricht, p_groningen, projection = "longlat", target = "km") + approx_distances(p_maastricht, p_groningen, projection = 4326, target = "km") # Check distances in several projections - sapply(c("eck4", "utm31", "laea_Eur", "rd", "longlat"), function(projection) { + sapply(c(3035, 28992, 4326), function(projection) { p_maastricht <- geocode_OSM("Maastricht", projection = projection)$coords p_groningen <- geocode_OSM("Groningen", projection = projection)$coords approx_distances(p_maastricht, p_groningen, projection = projection) diff --git a/examples/bb.R b/examples/bb.R index d30fd31..970b078 100644 --- a/examples/bb.R +++ b/examples/bb.R @@ -11,7 +11,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { bb(NLD_muni, ext=1.10) ## convert to longlat - bb(NLD_muni, projection="longlat") + bb(NLD_muni, projection=4326) ## change existing bounding box bb(NLD_muni, ext=1.5) diff --git a/examples/calc_densities.R b/examples/calc_densities.R index c4d0d3b..d5a9309 100644 --- a/examples/calc_densities.R +++ b/examples/calc_densities.R @@ -3,7 +3,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, target = "km km", var = c("pop_men", "pop_women")) - NLD_muni <- append_data(NLD_muni, NLD_muni_pop_per_km2, fixed=TRUE) + NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + tm_polygons(c("pop_women_km^2", "pop_women_km^2"), diff --git a/examples/crop_shape.R b/examples/crop_shape.R index 480ea6b..6e284bd 100644 --- a/examples/crop_shape.R +++ b/examples/crop_shape.R @@ -1,9 +1,9 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { data(World, NLD_muni, land, metro) - land_NLD <- crop_shape(land, NLD_muni) + #land_NLD <- crop_shape(land, NLD_muni) - qtm(land_NLD, raster="trees", style="natural") + #qtm(land_NLD, raster="trees", style="natural") metro_Europe <- crop_shape(metro, World[World$continent == "Europe", ], polygon = TRUE) diff --git a/examples/double_line.R b/examples/double_line.R deleted file mode 100644 index 8f6b25e..0000000 --- a/examples/double_line.R +++ /dev/null @@ -1,32 +0,0 @@ -\dontrun{ -if (require(tmap)) { -### Demo to visualise the route of the Amstel Gold Race, a professional cycling race - tmpdir <- tempdir() - tmpfile <- tempfile() - download.file("http://www.gpstracks.nl/routes-fiets/f-limburg-amstel-gold-race-2014.zip", - tmpfile, mode="wb") - unzip(tmpfile, exdir=tmpdir) - - # read GPX file - AGR <- read_GPX(file.path(tmpdir, "f-limburg-amstel-gold-race-2014.gpx")) - - # read OSM of Zuid-Limburg - Limburg_OSM <- read_osm(AGR$tracks, ext=1.05) - - # change route part names - levels(AGR$tracks$name) <- paste(c("First", "Second", "Third", "Final"), "loop") - AGR$tracks_offset2 <- offset_line(AGR$tracks, offset=c(.0005,0,-.0005,-.001)) - - tm_shape(Limburg_OSM) + - tm_raster(saturation=.25) + - tm_shape(AGR$tracks_offset2) + - tm_lines(col = "name", lwd = 4, title.col="Amstel Gold Race", palette="Dark2") + - tm_shape(AGR$waypoints) + - tm_bubbles(size=.1, col="gold", border.col = "black") + - tm_text("name", size = .75, bg.color="white", bg.alpha=.25, auto.placement = .25) + - tm_legend(position=c("right", "top"), frame=TRUE, bg.color = "gold") + - tm_view(basemaps = "Esri.WorldTopoMap") - - # TIP: also run the plot in viewing mode, enabled with tmap_mode("view") -} -} diff --git a/examples/geocode_OSM.R b/examples/geocode_OSM.R index 631b859..aa613e7 100644 --- a/examples/geocode_OSM.R +++ b/examples/geocode_OSM.R @@ -2,7 +2,7 @@ if (require(tmap)) { geocode_OSM("India") geocode_OSM("CBS Weg 1, Heerlen") - geocode_OSM("CBS Weg 1, Heerlen", projection = "rd") + geocode_OSM("CBS Weg 1, Heerlen", projection = 28992) data(metro) @@ -10,8 +10,7 @@ if (require(tmap)) { five_cities <- metro[sample(length(metro), 5), ] # obtain geocode locations from their long names - five_cities_geocode <- geocode_OSM(five_cities$name_long) - sp::coordinates(five_cities_geocode) <- ~lon+lat + five_cities_geocode <- geocode_OSM(five_cities$name_long, as.sf = TRUE) # change to interactive mode current.mode <- tmap_mode("view") diff --git a/examples/pipe.R b/examples/pipe.R deleted file mode 100644 index ec96a73..0000000 --- a/examples/pipe.R +++ /dev/null @@ -1,14 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(land, World) - - current.mode <- tmap_mode("view") - - land %>% - crop_shape(World[World$name=="China",], polygon = TRUE) %>% - tm_shape() + - tm_raster("cover_cls") - - tmap_mode(current.mode) -} -} diff --git a/examples/points_to_raster.R b/examples/points_to_raster.R deleted file mode 100644 index 9df8186..0000000 --- a/examples/points_to_raster.R +++ /dev/null @@ -1,22 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(NLD_muni, NLD_prov) - - # sample points (each point represents 1000 people) - NLD_muni_points <- sample_dots(NLD_muni, vars = "population", - w=1000, convert2density = TRUE) - - # dot map - tm_shape(NLD_muni_points) + tm_dots() - - # convert points to raster - NLD_rst <- points_to_raster(NLD_muni_points, N = 1e4) - - # plot raster - tm_shape(NLD_rst) + - tm_raster() + - tm_shape(NLD_prov) + - tm_borders() + - tm_format("NLD") + tm_style("grey") -} -} diff --git a/examples/poly_to_raster.R b/examples/poly_to_raster.R deleted file mode 100644 index b8d8fbf..0000000 --- a/examples/poly_to_raster.R +++ /dev/null @@ -1,12 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(NLD_muni) - - # choropleth of 65+ population percentages - qtm(NLD_muni, fill="pop_65plus", format="NLD") - - # rasterized version - NLD_rst <- poly_to_raster(NLD_muni, copy.data = TRUE) - qtm(NLD_rst, raster="pop_65plus", format="NLD") -} -} diff --git a/examples/projection_units.R b/examples/projection_units.R deleted file mode 100644 index 6eed72f..0000000 --- a/examples/projection_units.R +++ /dev/null @@ -1,10 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(World, land) - projection_units(World, target = "mi") - - projection_units(land) - projection_units(land, latitude = 45) - projection_units(land, latitude = 89) -} -} diff --git a/examples/read_GPX.R b/examples/read_GPX.R deleted file mode 100644 index 32e336d..0000000 --- a/examples/read_GPX.R +++ /dev/null @@ -1,30 +0,0 @@ -\dontrun{ -if (require(tmap)) { -### Demo to visualise the route of the Amstel Gold Race, a professional cycling race - tmpdir <- tempdir() - tmpfile <- tempfile() - download.file("http://www.gpstracks.nl/routes-fiets/f-limburg-amstel-gold-race-2014.zip", - tmpfile, mode="wb") - unzip(tmpfile, exdir=tmpdir) - - # read GPX file - AGR <- read_GPX(file.path(tmpdir, "f-limburg-amstel-gold-race-2014.gpx")) - - # read OSM of Zuid-Limburg - Limburg_OSM <- read_osm(AGR$tracks, ext=1.05) - - # change route part names - levels(AGR$tracks$name) <- paste(c("First", "Second", "Third", "Final"), "loop") - AGR$tracks_offset2 <- offset_line(AGR$tracks, offset=c(.0005,0,-.0005,-.001)) - - tm_shape(Limburg_OSM) + - tm_raster(saturation=.25) + - tm_shape(AGR$tracks_offset2) + - tm_lines(col = "name", lwd = 4, title.col="Amstel Gold Race", palette="Dark2") + - tm_shape(AGR$waypoints) + - tm_bubbles(size=.1, col="gold", border.col = "black") + - tm_text("name", size = .75, bg.color="white", bg.alpha=.25, auto.placement = .25) + - tm_legend(position=c("right", "top"), frame=TRUE, bg.color = "gold") + - tm_view(basemaps = "Esri.WorldTopoMap") -} -} diff --git a/examples/rev_geocode_OSM.R b/examples/rev_geocode_OSM.R index 0fb85b3..1008238 100644 --- a/examples/rev_geocode_OSM.R +++ b/examples/rev_geocode_OSM.R @@ -8,7 +8,7 @@ if (require(tmap)) { # obtain reverse geocode address information addresses <- rev_geocode_OSM(five_cities, zoom = 6) - five_cities <- append_data(five_cities, addresses, fixed.order = TRUE) + five_cities <- sf::st_sf(data.frame(five_cities, addresses)) # change to interactive mode current.mode <- tmap_mode("view") diff --git a/examples/sample_dots.R b/examples/sample_dots.R deleted file mode 100644 index 54cd836..0000000 --- a/examples/sample_dots.R +++ /dev/null @@ -1,9 +0,0 @@ -\dontrun{ -if (require(tmap)) { - data(World) - World_dots <- sample_dots(World, vars="pop_est_dens", nrow=200, ncol=400, w=1e6) - - tm_shape(World_dots) + tm_dots(size = .02, jitter=.1) + - tm_layout("One dot represents one million people", title.position = c("right", "bottom")) -} -} diff --git a/examples/simplify_shape.R b/examples/simplify_shape.R index bd0afeb..f98b0a0 100644 --- a/examples/simplify_shape.R +++ b/examples/simplify_shape.R @@ -19,3 +19,4 @@ if (require(tmap)) { tmap_arrange(tm5, tm6, tm7) } } + diff --git a/examples/smooth_map.R b/examples/smooth_map.R deleted file mode 100644 index d3b4780..0000000 --- a/examples/smooth_map.R +++ /dev/null @@ -1,108 +0,0 @@ -\dontrun{ -if (require(tmap)) { - # set mode to plotting mode - current.mode <- tmap_mode("plot") - - #################################### - ## Already smoothed raster - #################################### - vol <- raster::raster(t(volcano[, ncol(volcano):1]), xmn=0, xmx=870, ymn=0, ymx=610) - vol_smooth <- smooth_map(vol, smooth.raster = FALSE, nlevels = 10) - - tm_shape(vol_smooth$polygons) + - tm_fill("level", palette=terrain.colors(11), title="Elevation") + - tm_shape(vol_smooth$iso) + - tm_iso(col = "black", size = .7, fontcolor="black") + - tm_layout("Maunga Whau volcano (Auckland)", title.position=c("left", "bottom"), - inner.margins=0) + - tm_legend(width=.13, position=c("right", "top"), bg.color="gray80", frame = TRUE) - - - #################################### - ## Smooth polygons - #################################### - data(NLD_muni) - - NLD_muni$population_dens <- as.vector(calc_densities(NLD_muni, "population")) - - qtm(NLD_muni, fill="population_dens") - - NLD_smooth <- smooth_map(NLD_muni, var = "population_dens") - - qtm(NLD_smooth$raster, style="grey") - qtm(NLD_smooth$polygons, format="NLD") - - #################################### - ## Smooth points - #################################### - - # Approximate world population density as spatial points, one for each 1 million people, - # in the following way. Each metropolitan area of x million people will be represented - # by x dots. The remaining population per country will be represented by dots that are - # sampled across the country. - create_dot_per_1mln_people <- function() { - data(World, metro) - metro_eck <- set_projection(metro, projection = "eck4") - - # aggregate metropolitan population per country - metro_per_country <- tapply(metro_eck$pop2010, INDEX = list(metro_eck$iso_a3), FUN=sum) - metro_per_country_in_World <- metro_per_country[names(metro_per_country) %in% World$iso_a3] - - # assign to World shape - World$pop_metro <- 0 - World$pop_metro[match(names(metro_per_country_in_World), World$iso_a3)] <- - metro_per_country_in_World - - # define population density other than metropolitan areas - World$pop_est_dens_non_metro <- (World$pop_est - World$pop_metro) / World$area - - # generate dots for metropolitan areas (1 dot = 1mln people) - repeats <- pmax(1, metro_eck$pop2010 %/% 1e6) - ids <- unlist(mapply(rep, 1:nrow(metro_eck), repeats, SIMPLIFY = FALSE)) - - metro_dots <- metro_eck[ids, ] - - - # sample population dots from non-metropolitan areas (1 dot = 1mln people) - World_pop <- sample_dots(World, vars="pop_est_dens_non_metro", w = 1e6, - npop = 7.3e9 - nrow(metro_dots)*1e6) - - # combine - - c(st_geometry(World_pop), st_geometry(metro_dots)) - } - - World_1mln_dots <- create_dot_per_1mln_people() - - - # dot map - tm_shape(World_1mln_dots) + tm_dots() - - # create smooth map - World_list <- smooth_map(World_1mln_dots, cover = World, weight=1e6) - - # plot smooth raster map - qtm(World_list$raster, style="grey") - - # plot smooth raster map - qtm(World, bbox="India") + qtm(World_list$iso) - - # plot kernel density map - qtm(World_list$polygons, style="grey", format="World") - - #################################### - ## Smooth raster - #################################### - data(land) - - land_smooth <- smooth_map(land, var="trees", cover.type = "smooth") - - qtm(land, raster="trees") - qtm(land_smooth$raster) - qtm(land_smooth$polygons, format="World", style="grey") - - # reset current mode - tmap_mode(current.mode) -} -} - diff --git a/man/aggregate_map.Rd b/man/aggregate_map.Rd deleted file mode 100644 index e1d0d1e..0000000 --- a/man/aggregate_map.Rd +++ /dev/null @@ -1,97 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/aggregate_map.R -\name{aggregate_map} -\alias{aggregate_map} -\title{Aggregate map (deprecated)} -\usage{ -aggregate_map(shp, by = NULL, fact = NULL, agg.fun = NULL, - weights = NULL, na.rm = FALSE, ...) -} -\arguments{ -\item{shp}{shape object, which is one of -\enumerate{ - \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} - \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} - \item{\code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}} - \item{\code{\link[sp:SpatialPixelsDataFrame]{SpatialPixels(DataFrame)}}} - \item{\code{\link[raster:Raster-class]{RasterLayer, RasterStack, or RasterBrick}}} - \item{\code{\link[sf:sf]{sf}} object if it can be coerced to an \code{\link[sp:sp]{sp}} object} -}} - -\item{by}{variable by which polygons or lines are merged. Does not apply to raster objects.} - -\item{fact}{number that specifies how many cells in both horizontal and vertical direction are merged. Only applied to raster objects.} - -\item{agg.fun}{aggregation function(s). One of the following formats: -\enumerate{ -\item{One function (name) by which all variables are aggregated.} -\item{A vector of two function names called \code{"num"} and \code{"cat"} that determine the functions by which numeric respectively categorical variables are aggregated. For instance \code{c(num="mean", cat="modal")}, which calculates the mean and mode for numeric respectively categorical variables.} -\item{A list where per variable the (names of the) function(s) are provided. The list names should correspond to the variable names.} -} -These predefined functions can be used: \code{"mean"}, \code{"modal"}, \code{"first"}, and \code{"last"}.} - -\item{weights}{name of a numeric variable in \code{shp}. The values serve as weights for the aggregation function. If provided, these values are passed on as second argument. Works with aggregation functions \code{"mean"} and \code{"modal"}. Use \code{"AREA"} for polygon area sizes.} - -\item{na.rm}{passed on to the aggregation function(s) \code{agg.fun}.} - -\item{...}{other arguments passed on to the aggregation function(s) \code{agg.fun}.} -} -\value{ -A shape object, in the same format as \code{shp} -} -\description{ -Aggregate spatial polygons, spatial lines or raster objects. For spatial polygons and lines, the units will be merged with the \code{by} variable. For rasters, the \code{fact} parameter determined how many rasters cells are aggregated both horizontally and vertically. Per data variable, an aggregation formula can be specified, by default mean for numeric and modal for categorical varaibles. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -This function is similar to \code{\link[raster:aggregate]{aggregate}} from the \code{raster} package. However, the aggregation can be specified in more detail: weights can be used (e.g. polygon area sizes). Also, an aggregation function can be specified per variable or raster layer. It is also possible to specify a general function for numeric data and a function for categorical data. - -By default, the data is not aggregated. In this case, this function is similar to \code{unionSpatialPolygons} from the \code{maptools} package. The only difference is way the aggregate-by variable is specified. When using \code{unionSpatialPolygons}, the values have to be assigned to \code{IDs} whereas when using \code{aggregate_map} the data variable name can be assigned to \code{by}. - -The underlying functions of \code{aggregate_map} for \code{\link[sp:sp]{sp}} objects are \code{\link[rgeos:gUnaryUnion]{gUnaryUnion}}, \code{\link[rgeos:gUnionCascaded]{gUnionCascaded}}, and \code{\link[rgeos:gLineMerge]{gLineMerge}}. For \code{Raster} objects, the \code{\link[raster:aggregate]{aggregate}} is used. - -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, the \code{\link[sf:tidyverse]{tidyverse}} methods \code{group_by} and \code{summarize} can be used. -} -\examples{ -\dontrun{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { - data(land) - - # original map - qtm(land, raster="cover_cls") - - # map decreased by factor 4 for each dimension - land4 <- aggregate_map(land, fact=4, agg.fun="modal") - qtm(land4, raster="cover_cls") - - # map decreased by factor 8, where the variable trees is - # aggregated with mean, min, and max - land_trees <- aggregate_map(land, fact=8, - agg.fun=list(trees="mean", trees="min", trees="max")) - - tm_shape(land_trees) + - tm_raster(c("trees.1", "trees.2", "trees.3"), title="Trees (\%)") + - tm_facets(free.scales=FALSE) + - tm_layout(panel.labels = c("mean", "min", "max")) - - data(NLD_muni, NLD_prov) - - # aggregate Dutch municipalities to provinces - NLD_prov2 <- aggregate_map(NLD_muni, by="province", - agg.fun = list(population="sum", origin_native="mean", origin_west="mean", - origin_non_west="mean", name="modal"), weights = "population") - - # see original provinces data - as.data.frame(NLD_prov)[, c("name", "population", "origin_native", - "origin_west", "origin_non_west")] - - # see aggregates data (the last column corresponds to the most populated municipalities) - sf::st_set_geometry(NLD_prov2, NULL) - - # largest municipalities in area per province - NLD_largest_muni <- aggregate_map(NLD_muni, by="province", - agg.fun = list(name="modal"), weights = "AREA") - - sf::st_set_geometry(NLD_largest_muni, NULL) -} -} -} diff --git a/man/append_data.Rd b/man/append_data.Rd deleted file mode 100644 index 12d7585..0000000 --- a/man/append_data.Rd +++ /dev/null @@ -1,80 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/append_data.R -\name{append_data} -\alias{append_data} -\alias{under_coverage} -\alias{over_coverage} -\title{Append data to a shape object (deprecated)} -\usage{ -append_data(shp, data, key.shp = NULL, key.data = NULL, - ignore.duplicates = FALSE, ignore.na = FALSE, - fixed.order = is.null(key.data) && is.null(key.shp)) - -under_coverage() - -over_coverage() -} -\arguments{ -\item{shp}{shape object, which is one of -\enumerate{ - \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} - \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} - \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} - \item{\code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}} - \item{\code{\link[sp:SpatialPixelsDataFrame]{SpatialPixels(DataFrame)}}} - \item{\code{\link[sf:sf]{sf}} object that can be coerced as one above} -}} - -\item{data}{data.frame} - -\item{key.shp}{variable name of \code{shp} map data to be matched with \code{key.data}. If not specified, and \code{fixed.order} is \code{FALSE}, the ID's of the polygons/lines/points are taken.} - -\item{key.data}{variable name of \code{data} to be matched with \code{key.shp}. If not specified, and \code{fixed.order} is \code{FALSE}, the row names of \code{data} are taken.} - -\item{ignore.duplicates}{should duplicated keys in \code{data} be ignored? (\code{FALSE} by default)} - -\item{ignore.na}{should NA values in \code{key.data} and \code{key.shp} be ignored? (\code{FALSE} by default)} - -\item{fixed.order}{should the data be append in the same order as the shapes in \code{shp}?} -} -\value{ -Shape object with appended data. Tip: run \code{append_data} without assigning the result to check the coverage. -} -\description{ -Data, in the format of a data.frame, is appended to a shape object. This is either done by a left join where keys are specified for both shape and data, or by fixed order. Under coverage (shape items that do not correspond to data records), over coverage (data records that do not correspond to shape items respectively) as well as the existence of duplicated key values are automatically checked and reported via console messages. With \code{under_coverage} and \code{over_coverage} the under and over coverage key values from the last \code{append_data} call can be retrieved. Tip: run \code{append_data} without assigning the result to check the coverage. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -This function supports \code{sf} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, the \code{\link[sf:tidyverse]{tidyverse}} method \code{left_join} can be used. -} -\examples{ -\dontrun{ -if (require(tmap)) { - data(World) - - f <- tempfile() - download.file("http://kejser.org/wp-content/uploads/2014/06/Country.csv", destfile = f) - domain_codes <- read.table(f, header=TRUE, sep="|") - unlink(f) - - domain_codes <- subset(domain_codes, select = c("Alpha3Code", "TopLevelDomain")) - domain_codes$Alpha3Code <- toupper(domain_codes$Alpha3Code) - - World <- append_data(World, domain_codes, key.shp = "iso_a3", key.data = "Alpha3Code", - ignore.na = TRUE) - - # codes in the data, but not in Europe: - oc <- over_coverage() - oc$value - - # Countries without appended data: - uc <- under_coverage() - - current_mode <- tmap_mode("view") - qtm(World[uc$id,], text="name") - - # plot the result - qtm(World, text="TopLevelDomain") - tmap_mode(current_mode) -} -} -} diff --git a/man/approx_areas.Rd b/man/approx_areas.Rd index bc9c889..4ec01d5 100644 --- a/man/approx_areas.Rd +++ b/man/approx_areas.Rd @@ -60,7 +60,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { approx_areas(NLD_muni, target = "mi mi") \%>\% summary_areas() # area of the polygons when unprojected - approx_areas(NLD_muni \%>\% set_projection(projection="longlat")) \%>\% summary_areas() + approx_areas(NLD_muni \%>\% sf::st_transform(crs = 4326)) \%>\% summary_areas() } } \seealso{ diff --git a/man/approx_distances.Rd b/man/approx_distances.Rd index 923ad9a..f9fd84f 100644 --- a/man/approx_distances.Rd +++ b/man/approx_distances.Rd @@ -32,10 +32,10 @@ if (require(tmap)) { # Distance between Maastricht and Groningen p_maastricht <- geocode_OSM("Maastricht")$coords p_groningen <- geocode_OSM("Groningen")$coords - approx_distances(p_maastricht, p_groningen, projection = "longlat", target = "km") + approx_distances(p_maastricht, p_groningen, projection = 4326, target = "km") # Check distances in several projections - sapply(c("eck4", "utm31", "laea_Eur", "rd", "longlat"), function(projection) { + sapply(c(3035, 28992, 4326), function(projection) { p_maastricht <- geocode_OSM("Maastricht", projection = projection)$coords p_groningen <- geocode_OSM("Groningen", projection = projection)$coords approx_distances(p_maastricht, p_groningen, projection = projection) diff --git a/man/bb.Rd b/man/bb.Rd index a6c158f..c5cf0db 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -33,9 +33,9 @@ If \code{x} is not specified, a bounding box can be created from scratch (see de \item{relative}{boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}.} -\item{current.projection}{projection that corresponds to the bounding box specified by \code{x}. See \code{\link{get_proj4}} for options.} +\item{current.projection}{projection that corresponds to the bounding box specified by \code{x}.} -\item{projection}{projection to transform the bounding box to. See \code{\link{get_proj4}} for options.} +\item{projection}{projection to transform the bounding box to.} \item{output}{output format of the bounding box, one of: \itemize{ @@ -78,7 +78,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { bb(NLD_muni, ext=1.10) ## convert to longlat - bb(NLD_muni, projection="longlat") + bb(NLD_muni, projection=4326) ## change existing bounding box bb(NLD_muni, ext=1.5) diff --git a/man/bb_poly.Rd b/man/bb_poly.Rd index c4441b4..76a0015 100644 --- a/man/bb_poly.Rd +++ b/man/bb_poly.Rd @@ -17,9 +17,9 @@ bb_earth(projection = NULL, stepsize = 1, earth.datum = 4326, \item{stepsize}{stepsize in terms of coordinates (usually meters when the shape is projected and degrees of longlat coordinates are used). If specified, it overrules \code{steps}} -\item{projection}{projection in which the coordinates of \code{x} are provided, see \code{\link{get_proj4}}. For \code{bb_earth}, \code{projection} is the projection in which the bounding box is returned (if possible).} +\item{projection}{projection in which the coordinates of \code{x} are provided. For \code{bb_earth}, \code{projection} is the projection in which the bounding box is returned (if possible).} -\item{earth.datum}{Geodetic datum to determine the earth boundary. By default \code{"WGS84"}, other frequently used datums are \code{"NAD83"} and \code{"NAD27"}. Any other \code{PROJ.4} character string can be used. See \code{\link{get_proj4}}.} +\item{earth.datum}{Geodetic datum to determine the earth boundary. By default EPSG 4326.} \item{bbx}{boundig box of the earth in a vector of 4 values: min longitude, max longitude, min latitude, max latitude. By default \code{c(-180, 180, -90, 90)}. If for some \code{projection}, a feasible solution does not exist, it may be wise to choose a smaller bbx, e.g. \code{c(-180, 180, -88, 88)}. However, this is also automatically done with the next argument, \code{buffer}.} diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index c00bf99..ba9bc1c 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -21,7 +21,7 @@ calc_densities(shp, var, target = "metric", total.area = NULL, \item{drop}{boolean that determines whether an one-column data-frame should be returned as a vector} } \value{ -Vector or data.frame (depending on whether \code{length(var)==1} with density values. This can be appended directly to the shape file with \code{\link{append_data}} with \code{fixed.order=TRUE}. +Vector or data.frame (depending on whether \code{length(var)==1} with density values. } \description{ Transpose quantitative variables to densitiy variables, which are often needed for choroplets. For example, the colors of a population density map should correspond population density counts rather than absolute population numbers. @@ -32,7 +32,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, target = "km km", var = c("pop_men", "pop_women")) - NLD_muni <- append_data(NLD_muni, NLD_muni_pop_per_km2, fixed=TRUE) + NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + tm_polygons(c("pop_women_km^2", "pop_women_km^2"), diff --git a/man/crop_shape.Rd b/man/crop_shape.Rd index 57bc565..79d21fa 100644 --- a/man/crop_shape.Rd +++ b/man/crop_shape.Rd @@ -28,9 +28,9 @@ This function is similar to \code{\link[raster:crop]{crop}} from the \code{raste if (require(tmap) && packageVersion("tmap") >= "2.0") { data(World, NLD_muni, land, metro) - land_NLD <- crop_shape(land, NLD_muni) + #land_NLD <- crop_shape(land, NLD_muni) - qtm(land_NLD, raster="trees", style="natural") + #qtm(land_NLD, raster="trees", style="natural") metro_Europe <- crop_shape(metro, World[World$continent == "Europe", ], polygon = TRUE) diff --git a/man/deprecated_functions.Rd b/man/deprecated_functions.Rd index ef6f0c0..dd61bee 100644 --- a/man/deprecated_functions.Rd +++ b/man/deprecated_functions.Rd @@ -2,25 +2,52 @@ % Please edit documentation in R/deprecated.R \name{deprecated_functions} \alias{deprecated_functions} -\alias{osm_poly} -\alias{osm_line} -\alias{osm_point} +\alias{get_proj4} +\alias{set_projection} +\alias{get_projection} +\alias{is_projected} \title{Deprecated tmaptools functions} \usage{ -osm_poly() +get_proj4(x, output = c("crs", "character", "epsg", "CRS")) -osm_line() +set_projection(shp, projection = NA, current.projection = NA, + overwrite.current.projection = FALSE) -osm_point() +get_projection(shp, guess.longlat = FALSE, output = c("character", + "crs", "epsg", "CRS")) + +is_projected(x) } -\description{ -The following functions are not used anymore or deprecated as of tmaptools version 2.0 +\arguments{ +\item{x}{see documentation in tmaptools 2.x for details} + +\item{output}{see documentation in tmaptools 2.x for details} + +\item{shp}{see documentation in tmaptools 2.x for details} + +\item{projection}{see documentation in tmaptools 2.x for details} + +\item{current.projection}{see documentation in tmaptools 2.x for details} + +\item{overwrite.current.projection}{see documentation in tmaptools 2.x for details} + +\item{guess.longlat}{see documentation in tmaptools 2.x for details + +Deprecated as of version 2.0 +\itemize{ + \item \code{append_data}, \code{aggregate_map}, \code{double_line}, \code{points_to_raster}, \code{poly_to_raster}, \code{sample_dots}, \code{sbind}, \code{smooth_map}, \code{smooth_raster_cover}, \code{read_shape}, \code{write_shape}. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} + \item \code{osm_poly}, \code{osm_line}, \code{osm_point}. Please use the package \code{osmdata} } -\details{ + +Deprecated as of version 3.0 \itemize{ - \item \code{osm_poly}: for reading vector OSM data, use the \code{osmdata} package - \item \code{osm_line}: for reading vector OSM data, use the \code{osmdata} package - \item \code{osm_point}: for reading vector OSM data, use the \code{osmdata} package + \item \code{get_proj4}: for projections, please use the function \code{\link[sf:st_crs]{st_crs}} + \item \code{set_projection} for setting map projections, use \code{\link[sf:st_crs]{st_crs}} or \code{\link[sf:st_transform]{st_transform}} + \item \code{get_projection} for getting map projections, use \code{\link[sf:st_crs]{st_crs}} + \item \code{is_projected} for checking if projections are long lat coordinates, use \code{\link[sf:st_is_longlat]{st_is_longlat}} +}} } +\description{ +The following functions are not used anymore or deprecated as of tmaptools version 3.0. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} } \keyword{internal} diff --git a/man/double_line.Rd b/man/double_line.Rd deleted file mode 100644 index 8f41a26..0000000 --- a/man/double_line.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/line_functions.R -\name{offset_line} -\alias{offset_line} -\alias{double_line} -\title{Create a double line or offset line (deprecated)} -\usage{ -offset_line(shp, offset) - -double_line(shp, width, sides = "both") -} -\arguments{ -\item{shp}{SpatialLines(DataFrame)} - -\item{offset}{offset from the original lines} - -\item{width}{width between the left and righthand side} - -\item{sides}{character value that specifies which sides are selected: \code{"both"}, \code{"left"}, or \code{"right"}. The default is \code{"both"}. For the other two options, see also the shortcut function \code{offset_line}.} -} -\value{ -A shape object, in the same format as \code{shp} -} -\description{ -Create a double line or offset line. The double line can be useful for visualizing two-way tracks or emulating objects such as railway tracks. The offset line can be useful to prevent overlapping of spatial lines. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -} -\examples{ -\dontrun{ -if (require(tmap)) { -### Demo to visualise the route of the Amstel Gold Race, a professional cycling race - tmpdir <- tempdir() - tmpfile <- tempfile() - download.file("http://www.gpstracks.nl/routes-fiets/f-limburg-amstel-gold-race-2014.zip", - tmpfile, mode="wb") - unzip(tmpfile, exdir=tmpdir) - - # read GPX file - AGR <- read_GPX(file.path(tmpdir, "f-limburg-amstel-gold-race-2014.gpx")) - - # read OSM of Zuid-Limburg - Limburg_OSM <- read_osm(AGR$tracks, ext=1.05) - - # change route part names - levels(AGR$tracks$name) <- paste(c("First", "Second", "Third", "Final"), "loop") - AGR$tracks_offset2 <- offset_line(AGR$tracks, offset=c(.0005,0,-.0005,-.001)) - - tm_shape(Limburg_OSM) + - tm_raster(saturation=.25) + - tm_shape(AGR$tracks_offset2) + - tm_lines(col = "name", lwd = 4, title.col="Amstel Gold Race", palette="Dark2") + - tm_shape(AGR$waypoints) + - tm_bubbles(size=.1, col="gold", border.col = "black") + - tm_text("name", size = .75, bg.color="white", bg.alpha=.25, auto.placement = .25) + - tm_legend(position=c("right", "top"), frame=TRUE, bg.color = "gold") + - tm_view(basemaps = "Esri.WorldTopoMap") - - # TIP: also run the plot in viewing mode, enabled with tmap_mode("view") -} -} -} diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index cb9c9a7..7b5cba0 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -17,9 +17,9 @@ geocode_OSM(q, projection = NULL, return.first.only = TRUE, \item{details}{provide output details, other than the point coordinates and bounding box} -\item{as.data.frame}{Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries} +\item{as.data.frame}{Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}.} -\item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}.} +\item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}, where the latter is the default geometry.} \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } @@ -34,7 +34,7 @@ Geocodes a location (based on a search query) to coordinates and a bounding box. if (require(tmap)) { geocode_OSM("India") geocode_OSM("CBS Weg 1, Heerlen") - geocode_OSM("CBS Weg 1, Heerlen", projection = "rd") + geocode_OSM("CBS Weg 1, Heerlen", projection = 28992) data(metro) @@ -42,8 +42,7 @@ if (require(tmap)) { five_cities <- metro[sample(length(metro), 5), ] # obtain geocode locations from their long names - five_cities_geocode <- geocode_OSM(five_cities$name_long) - sp::coordinates(five_cities_geocode) <- ~lon+lat + five_cities_geocode <- geocode_OSM(five_cities$name_long, as.sf = TRUE) # change to interactive mode current.mode <- tmap_mode("view") diff --git a/man/get_IDs.Rd b/man/get_IDs.Rd deleted file mode 100644 index 4a3674e..0000000 --- a/man/get_IDs.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_IDs.R -\name{get_IDs} -\alias{get_IDs} -\title{Get ID's of the shape items of sp objects} -\usage{ -get_IDs(shp) -} -\arguments{ -\item{shp}{shape object, which is one of -\enumerate{ - \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} - \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} - \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -}} -} -\value{ -vector of ID's -} -\description{ -Get ID's of the shape items of sp objects. For polygons and lines, the ID attribute is used. For points, the coordinates are used. -} diff --git a/man/get_proj4.Rd b/man/get_proj4.Rd deleted file mode 100644 index 4c5e4c0..0000000 --- a/man/get_proj4.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_proj4_code.R -\name{get_proj4} -\alias{get_proj4} -\title{Get a PROJ.4 character string} -\usage{ -get_proj4(x, output = c("crs", "character", "epsg", "CRS")) -} -\arguments{ -\item{x}{a projection. One of: -\enumerate{ - \item{a \code{PROJ.4} character string} - \item{a \code{\link[sf:st_crs]{crs}} object} - \item{a \code{\link[sp:CRS]{CRS}} object} - \item{an EPSG code} - \item{one the following shortcuts codes: - \describe{ - \item{\code{"longlat"}}{Not really a projection, but a plot of the longitude-latitude coordinates (WGS84 datum).} - \item{\code{"wintri"}}{Winkel Tripel (1921). Popular projection that is useful in world maps. It is the standard of world maps made by the National Geographic Society. Type: compromise} - \item{\code{"robin"}}{Robinson (1963). Another popular projection for world maps. Type: compromise} - \item{\code{"eck4"}}{Eckert IV (1906). Projection useful for world maps. Area sizes are preserved, which makes it particularly useful for truthful choropleths. Type: equal-area} - \item{\code{"hd"}}{Hobo-Dyer (2002). Another projection useful for world maps in which area sizes are preserved. Type: equal-area} - \item{\code{"gall"}}{Gall (Peters) (1855). Another projection useful for world maps in which area sizes are preserved. Type: equal-area} - \item{\code{"merc"}}{Web Mercator. Projection in which shapes are locally preserved, a variant of the original Mercator (1569), used by Google Maps, Bing Maps, and OpenStreetMap. Areas close to the poles are inflated. Type: conformal} - \item{\code{"utmXX(s)"}}{Universal Transverse Mercator. Set of 60 projections where each projection is a traverse mercator optimized for a 6 degree longitude range. These ranges are called UTM zones. Zone \code{01} covers -180 to -174 degrees (West) and zone \code{60} 174 to 180 east. Replace XX in the character string with the zone number. For southern hemisphere, add \code{"s"}. So, for instance, the Netherlands is \code{"utm31"} and New Zealand is \code{"utm59s"}} - \item{\code{"mill"}}{Miller (1942). Projetion based on Mercator, in which poles are displayed. Type: compromise} - \item{\code{"eqc0"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The equator is the standard parallel. Also known as Plate Carr\'ee. Type: equidistant} - \item{\code{"eqc30"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The latitude of 30 is the standard parallel. Type: equidistant} - \item{\code{"eqc45"}}{Equirectangular (120). Projection in which distances along meridians are conserved. The latitude of 45 is the standard parallel. Also known as Gall isographic. Type: equidistant} - \item{\code{"laea_Eur"}}{European Lambert Azimuthal Equal Area Projection. Similar to EPSG code 3035.} - \item{\code{"laea_NA"}}{North American Lambert Azimuthal Equal Area Projection. Known as SR-ORG:7314.} - \item{\code{"rd"}}{Rijksdriehoekstelsel. Triangulation coordinate system used in the Netherlands.} - }} -}} - -\item{output}{the output format of the projection, one of \code{"character"}, \code{"crs"},\code{"epsg"}, or \code{"CRS"}} -} -\value{ -see \code{output} -} -\description{ -Get full PROJ.4 string from an existing PROJ.4 string, a shortcut, or a \code{\link[sp:CRS]{CRS}} object. -} -\seealso{ -\url{http://en.wikipedia.org/wiki/List_of_map_projections} for a overview of projections. \url{http://trac.osgeo.org/proj/} for the \code{PROJ.4} project home page. An extensive list of \code{PROJ.4} codes can be created with rgdal's \code{\link[rgdal:make_EPSG]{make_EPSG}}. -} diff --git a/man/is_projected.Rd b/man/is_projected.Rd deleted file mode 100644 index c0882a3..0000000 --- a/man/is_projected.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/is_projected.R -\name{is_projected} -\alias{is_projected} -\title{Is the shape projected?} -\usage{ -is_projected(x) -} -\arguments{ -\item{x}{shape (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}), or projection (see \code{\link{get_proj4}} for options)} -} -\value{ -logical: \code{TRUE} if the shape is projected and \code{FALSE} otherwise. -} -\description{ -Checks whether the shape is projected. Applicable to \code{Spatial}, \code{Raster} and \code{\link[sf:sf]{sf}} objects. In case the projection is missing, it checks whether the coordinates are within -180/180 and -90/90 (if so, it returns \code{FALSE}). -} diff --git a/man/pipe.Rd b/man/pipe.Rd index cf7c17c..c763717 100644 --- a/man/pipe.Rd +++ b/man/pipe.Rd @@ -11,19 +11,3 @@ \description{ The pipe operator from magrittr, \code{\%>\%}, can also be used in functions from \code{tmaptools}. } -\examples{ -\dontrun{ -if (require(tmap)) { - data(land, World) - - current.mode <- tmap_mode("view") - - land \%>\% - crop_shape(World[World$name=="China",], polygon = TRUE) \%>\% - tm_shape() + - tm_raster("cover_cls") - - tmap_mode(current.mode) -} -} -} diff --git a/man/points_to_raster.Rd b/man/points_to_raster.Rd deleted file mode 100644 index 1adfeb4..0000000 --- a/man/points_to_raster.Rd +++ /dev/null @@ -1,60 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/to_raster.R -\name{points_to_raster} -\alias{points_to_raster} -\title{Bin spatial points to a raster (deprecated)} -\usage{ -points_to_raster(shp, nrow = NA, ncol = NA, N = 250000, by = NULL, - to.Raster = NULL) -} -\arguments{ -\item{shp}{shape object. a \code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}, a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}, or an \code{\link[sf:sf]{sf}} object that can be coerced as such.} - -\item{nrow}{number of raster rows. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}.} - -\item{ncol}{number of raster columns. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}.} - -\item{N}{preferred number of raster cells.} - -\item{by}{name of a data variable which should be a factor. The points are split and counted according to the levels of this factor.} - -\item{to.Raster}{not used anymore, since the output is always a \code{\link[raster:Raster-class]{raster}} as of version 2.0} -} -\value{ -a \code{RasterBrick} is returned when \code{by} is specified, and a \code{RasterLayer} when \code{by} is unspecified. -} -\description{ -Bin spatial points to a raster. For each raster cell, the number of points are counted. Optionally, a factor variable can be specified by which the points are counts are split. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -This function is a wrapper around \code{\link[raster:rasterize]{rasterize}}. - -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -} -\examples{ -\dontrun{ -if (require(tmap)) { - data(NLD_muni, NLD_prov) - - # sample points (each point represents 1000 people) - NLD_muni_points <- sample_dots(NLD_muni, vars = "population", - w=1000, convert2density = TRUE) - - # dot map - tm_shape(NLD_muni_points) + tm_dots() - - # convert points to raster - NLD_rst <- points_to_raster(NLD_muni_points, N = 1e4) - - # plot raster - tm_shape(NLD_rst) + - tm_raster() + - tm_shape(NLD_prov) + - tm_borders() + - tm_format("NLD") + tm_style("grey") -} -} -} -\seealso{ -\code{\link{poly_to_raster}} -} diff --git a/man/poly_to_raster.Rd b/man/poly_to_raster.Rd deleted file mode 100644 index 8c1b6d9..0000000 --- a/man/poly_to_raster.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/to_raster.R -\name{poly_to_raster} -\alias{poly_to_raster} -\title{Convert spatial polygons to a raster (deprecated)} -\usage{ -poly_to_raster(shp, r = NULL, nrow = NA, ncol = NA, N = 250000, - use.cover = FALSE, copy.data = FALSE, to.Raster = NULL, ...) -} -\arguments{ -\item{shp}{shape object. A \code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}, a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}}, or an \code{sf} object that can be coerced as such.} - -\item{r}{\code{\link[raster:raster]{Raster}} object. If not specified, it will be created from the bounding box of \code{shp} and the arguments \code{N}, \code{nrow}, and \code{ncol}.} - -\item{nrow}{number of raster rows. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}.} - -\item{ncol}{number of raster columns. If \code{NA}, it is automatically determined by \code{N} and the aspect ratio of \code{shp}.} - -\item{N}{preferred number of raster cells.} - -\item{use.cover}{logical; should the cover method be used? This method determines per raster cell which polygon has the highest cover fraction. This method is better, but very slow, since N times the number of polygons combinations are processed (using the \code{getCover} argument of \code{\link[raster:rasterize]{rasterize}}). By default, when a raster cell is covered by multiple polygons, the last polygon is taken (see \code{fun} argment of \code{\link[raster:rasterize]{rasterize}}))} - -\item{copy.data}{should the polygon data be appended to the raster? Only recommended when \code{N} is small.} - -\item{to.Raster}{not used anymore, since the "raster" output is always a \code{\link[raster:Raster-class]{RasterLayer}} as of version 2.0} - -\item{...}{arguments passed on to \code{\link[raster:rasterize]{rasterize}}} -} -\value{ -a \code{RasterBrick} is returned when \code{by} is specified, and a \code{RasterLayer} when \code{by} is unspecified -} -\description{ -Convert spatial polygons to a raster. The value of each raster cell will be the polygon ID number. Alternatively, if \code{copy.data}, the polygon data is appended to each raster cell. -} -\examples{ -\dontrun{ -if (require(tmap)) { - data(NLD_muni) - - # choropleth of 65+ population percentages - qtm(NLD_muni, fill="pop_65plus", format="NLD") - - # rasterized version - NLD_rst <- poly_to_raster(NLD_muni, copy.data = TRUE) - qtm(NLD_rst, raster="pop_65plus", format="NLD") -} -} -} -\seealso{ -\code{\link{points_to_raster}} -} diff --git a/man/read_GPX.Rd b/man/read_GPX.Rd index 4bcb2ee..2a73e65 100644 --- a/man/read_GPX.Rd +++ b/man/read_GPX.Rd @@ -4,18 +4,21 @@ \alias{read_GPX} \title{Read GPX file} \usage{ -read_GPX(file, layers = c("waypoints", "tracks", "routes", - "track_points", "route_points"), as.sf = TRUE) +read_GPX(file, layers = c("waypoints", "routes", "tracks", + "route_points", "track_points"), remove.empty.layers = TRUE, + as.sf = TRUE) } \arguments{ \item{file}{a GPX filename (including directory)} \item{layers}{vector of GPX layers. Possible options are \code{"waypoints"}, \code{"tracks"}, \code{"routes"}, \code{"track_points"}, \code{"route_points"}. By dedault, all those layers are read.} -\item{as.sf}{should \code{\link[sf:sf]{sf}} objects be returned? By default \code{TRUE}} +\item{remove.empty.layers}{should empty layers (i.e. with 0 features) be removed from the list?} + +\item{as.sf}{not used anymore} } \value{ -for each defiend layer, a shape is returned (only if the layer has any features). If only one layer is defined, the corresponding shape is returned. If more than one layer is defined, a list of shape objects, one for each layer, is returned. +a list of sf objects, one for each layer } \description{ Read a GPX file. By default, it reads all possible GPX layers, and only returns shapes for layers that have any features. @@ -23,35 +26,3 @@ Read a GPX file. By default, it reads all possible GPX layers, and only returns \details{ Note that this function returns \code{\link[sf:sf]{sf}} objects, but still uses methods from sp and rgdal internally. } -\examples{ -\dontrun{ -if (require(tmap)) { -### Demo to visualise the route of the Amstel Gold Race, a professional cycling race - tmpdir <- tempdir() - tmpfile <- tempfile() - download.file("http://www.gpstracks.nl/routes-fiets/f-limburg-amstel-gold-race-2014.zip", - tmpfile, mode="wb") - unzip(tmpfile, exdir=tmpdir) - - # read GPX file - AGR <- read_GPX(file.path(tmpdir, "f-limburg-amstel-gold-race-2014.gpx")) - - # read OSM of Zuid-Limburg - Limburg_OSM <- read_osm(AGR$tracks, ext=1.05) - - # change route part names - levels(AGR$tracks$name) <- paste(c("First", "Second", "Third", "Final"), "loop") - AGR$tracks_offset2 <- offset_line(AGR$tracks, offset=c(.0005,0,-.0005,-.001)) - - tm_shape(Limburg_OSM) + - tm_raster(saturation=.25) + - tm_shape(AGR$tracks_offset2) + - tm_lines(col = "name", lwd = 4, title.col="Amstel Gold Race", palette="Dark2") + - tm_shape(AGR$waypoints) + - tm_bubbles(size=.1, col="gold", border.col = "black") + - tm_text("name", size = .75, bg.color="white", bg.alpha=.25, auto.placement = .25) + - tm_legend(position=c("right", "top"), frame=TRUE, bg.color = "gold") + - tm_view(basemaps = "Esri.WorldTopoMap") -} -} -} diff --git a/man/read_shape.Rd b/man/read_shape.Rd deleted file mode 100644 index 79f2097..0000000 --- a/man/read_shape.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_shape.R -\name{read_shape} -\alias{read_shape} -\title{Read shape file (deprecated)} -\usage{ -read_shape(file, current.projection = NULL, as.sf = TRUE, ...) -} -\arguments{ -\item{file}{a shape file name (including directory)} - -\item{current.projection}{the current projection of the shape object, if it is missing in the shape file. See \code{\link{get_proj4}} for options. Use \code{\link{set_projection}} to reproject the shape object.} - -\item{as.sf}{should the shape be returned as an \code{\link[sf:sf]{sf}} object?} - -\item{...}{other parameters, such as \code{stringsAsFactors}, are passed on to \code{\link[rgdal:readOGR]{readOGR}}} -} -\value{ -shape object from class \code{\link[sp:Spatial]{Spatial}} or \code{\link[sf:sf]{sf}} if \code{as.sf = TRUE} -} -\description{ -Read an ESRI shape file. Optionally, set the current projection if it is missing. -} -\details{ -This function is a convenient wrapper of rgdal's \code{\link[rgdal:readOGR]{readOGR}}. It is possible to set the current projection, if it is undefined in the shape file. If a reprojection is required, use \code{\link{set_projection}}. - -For the Netherlands: often, the Dutch Rijksdriehoekstelsel (Dutch National Grid) projection is provided in the shape file without proper datum shift parameters to wgs84. This functions automatically adds these parameters. See \url{http://www.qgis.nl/2011/12/05/epsg28992-of-rijksdriehoekstelsel-verschuiving/} (in Dutch) for details. -} diff --git a/man/rev_geocode_OSM.Rd b/man/rev_geocode_OSM.Rd index c780e99..c40e924 100644 --- a/man/rev_geocode_OSM.Rd +++ b/man/rev_geocode_OSM.Rd @@ -4,7 +4,7 @@ \alias{rev_geocode_OSM} \title{Reverse geocodes a location using OpenStreetMap Nominatim} \usage{ -rev_geocode_OSM(x, y = NULL, zoom = NULL, projection = NULL, +rev_geocode_OSM(x, y = NULL, zoom = NULL, projection = 4326, as.data.frame = NA, server = "http://nominatim.openstreetmap.org") } \arguments{ @@ -14,7 +14,7 @@ rev_geocode_OSM(x, y = NULL, zoom = NULL, projection = NULL, \item{zoom}{zoom level} -\item{projection}{projection in which the coordinates \code{x} and \code{y} are provided. Either a \code{\link[sp:CRS]{CRS}} object or a character value. If it is a character, it can either be a \code{PROJ.4} character string or a shortcut. See \code{\link{get_proj4}} for a list of shortcut values. By default latitude longitude coordinates.} +\item{projection}{projection in which the coordinates \code{x} and \code{y} are provided.} \item{as.data.frame}{return as data.frame (\code{TRUE}) or list (\code{FALSE}). By default a list, unless multiple coordinates are provided.} @@ -37,7 +37,7 @@ if (require(tmap)) { # obtain reverse geocode address information addresses <- rev_geocode_OSM(five_cities, zoom = 6) - five_cities <- append_data(five_cities, addresses, fixed.order = TRUE) + five_cities <- sf::st_sf(data.frame(five_cities, addresses)) # change to interactive mode current.mode <- tmap_mode("view") diff --git a/man/sample_dots.Rd b/man/sample_dots.Rd deleted file mode 100644 index 7c50fa7..0000000 --- a/man/sample_dots.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sample_dots.R -\name{sample_dots} -\alias{sample_dots} -\title{Sample dots from spatial polygons (deprecated)} -\usage{ -sample_dots(shp, vars = NULL, convert2density = FALSE, nrow = NA, - ncol = NA, N = 250000, npop = NA, n = 10000, w = NA, - shp.id = NULL, var.name = "class", var.labels = vars, - target = "metric", randomize = TRUE, output = c("points", "grid"), - orig = NULL, to = NULL, ...) -} -\arguments{ -\item{shp}{A shape object, more specifically, a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygonsDataFrame}} or an \code{\link[sf:sf]{sf}} object that can be coerced as such.} - -\item{vars}{Names of one or more variables that are contained in \code{shp}. If \code{vars} is not provided, the dots are sampled uniformly. If \code{vars} consists of one variable name, the dots are sampled according to the distribution of the corresponding variable. If \code{vars} consist of more than one variable names, then the dots are sampled according to the distributions of those variables. A categorical variable is added that contains the distrubtion classes (see \code{var.name}).} - -\item{convert2density}{Should the variables be converted to density values? Density values are used for the sampling algorithm, so use \code{TRUE} when the values are absolute counts.} - -\item{nrow}{Number of grid rows} - -\item{ncol}{Number of grid colums} - -\item{N}{Number of grid points} - -\item{npop}{Population total. If \code{NA}, it is recontructed from the data. If density values are specified, the population total is approximated using the polygon areas (see also \code{target}, \code{orig} and \code{to}).} - -\item{n}{Number of sampled dots} - -\item{w}{Number of population units per dot. It is the population total divided by \code{n}. If specified, \code{n} is calculated accordingly.} - -\item{shp.id}{Name of the variable of \code{shp} that contains the polygon identifying numbers or names.} - -\item{var.name}{Name of the variable that will be created to store the classes. The classes are defined by \code{vars}, and the labels can be configured with \code{var.labels}.} - -\item{var.labels}{Labels of the classes (see \code{var.name}).} - -\item{target}{target unit, see \code{\link{approx_areas}}} - -\item{randomize}{should the order of sampled dots be randomized? The dots are sampled class-wise (specified by \code{vars}). If this order is not randomized (so if \code{randomize=FALSE}), then the dots from the last class will be drawn on top, which may introduce a perception bias. By default \code{randomize=TRUE}, so the sampled dots are randomized to prevent this bias.} - -\item{output}{format of the output: use \code{"points"} for spatial points, and \code{"grid"} for a spatial grid.} - -\item{orig}{not used anymore as of version 2.0} - -\item{to}{not used anymore as of version 2.0} - -\item{...}{other arguments passed on to \code{\link{calc_densities}} and \code{\link{approx_areas}}} -} -\value{ -A shape object, in the same format as \code{shp} -} -\description{ -Sample dots from spatial polygons according to a spatial distribution of a population. The population may consist of classes. The output, an sf object containing spatial points, can be used to create a dot map (see \code{\link[tmap:tm_dots]{tm_dots}}), where the dots are colored according to the classes. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. Alternatively, \code{\link[sf:st_sample]{st_sample}} can be used. -} -\examples{ -\dontrun{ -if (require(tmap)) { - data(World) - World_dots <- sample_dots(World, vars="pop_est_dens", nrow=200, ncol=400, w=1e6) - - tm_shape(World_dots) + tm_dots(size = .02, jitter=.1) + - tm_layout("One dot represents one million people", title.position = c("right", "bottom")) -} -} -} diff --git a/man/sbind.Rd b/man/sbind.Rd deleted file mode 100644 index e98405a..0000000 --- a/man/sbind.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sbind.R -\name{sbind} -\alias{sbind} -\title{Combine shape objects (from sp) (deprecated)} -\usage{ -sbind(...) -} -\arguments{ -\item{...}{shape objects. Each shape object is one of -\enumerate{ - \item{\code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} - \item{\code{\link[sp:SpatialPointsDataFrame]{SpatialPoints(DataFrame)}}} - \item{\code{\link[sp:SpatialLinesDataFrame]{SpatialLines(DataFrame)}}} -}} -} -\value{ -shape object -} -\description{ -Combine shape objects from sp into one shape object. It works analogous to \code{\link{rbind}}. -} diff --git a/man/set_projection.Rd b/man/set_projection.Rd deleted file mode 100644 index 0c12d50..0000000 --- a/man/set_projection.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_projection.R -\name{set_projection} -\alias{set_projection} -\alias{get_projection} -\title{Set and get the map projection} -\usage{ -set_projection(shp, projection = NA, current.projection = NA, - overwrite.current.projection = FALSE) - -get_projection(shp, guess.longlat = FALSE, output = c("character", - "crs", "epsg", "CRS")) -} -\arguments{ -\item{shp}{shape object, which is an object from a class defined by the \code{\link[sf:sf]{sf}}, \code{\link[sp:sp]{sp}}, or \code{\link[raster:raster-package]{raster}} package.} - -\item{projection}{new projection. See \code{\link{get_proj4}} for options. This argument is only used to transform the \code{shp}. Use \code{current.projection} to specify the current projection of \code{shp}.} - -\item{current.projection}{the current projection of \code{shp}. See \code{\link{get_proj4}} for possible options. Only use this if the current projection is missing or wrong.} - -\item{overwrite.current.projection}{logical that determines whether the current projection is overwritten if it already has a projection that is different.} - -\item{guess.longlat}{if \code{TRUE}, it checks if the coordinates are within -180/180 and -90/90, and if so, it returns the WGS84 longlat projection (which is \code{get_proj4("longlat")}).} - -\item{output}{output format of the projection. One of \code{"character"}, \code{"crs"} (from \code{sf} package), \code{"epsg"} or \code{"CRS"} (from \code{sp}/\code{rgdal} package)} -} -\value{ -\code{set_projection} returns a (transformed) shape object with updated projection information. \code{get_projection} returns the \code{PROJ.4} character string of \code{shp}. -} -\description{ -The function \code{set_projection} sets the projection of a shape file. It is -a convenient wrapper of \code{\link[sf:st_transform]{st_transform}} (or \code{\link[lwgeom:st_transform_proj]{st_transform_proj}}, see details) and -\code{\link[raster:projectRaster]{projectRaster}} with shortcuts for commonly -used projections. The projection can also be set directly in the plot call -with \code{\link[tmap:tm_shape]{tm_shape}}. This function is also used to set the current -projection information if this is missing. The function \code{get_projection} -is used to get the projection information. -} -\details{ -For \code{\link[sf:sf]{sf}} objects, \code{set_projection} first tries to use \code{\link[sf:st_transform]{sf::st_transform}}, which uses the GDAL API. For some projections, most notably Winkel Tripel (\code{"wintri"}), is doesn't work. In these cases, \code{set_projection} will use \code{\link[lwgeom:st_transform_proj]{lwgeom::st_transform_proj}}, which uses the PROJ.4 API. - -For raster objects, the projection method is based on the type of data. For numeric layers, the bilinear method is used, and for categorical layers the nearest neighbor. See \code{\link[raster:projectRaster]{projectRaster}} for details. -} diff --git a/man/simplify_shape.Rd b/man/simplify_shape.Rd index 6d4c966..8b74979 100644 --- a/man/simplify_shape.Rd +++ b/man/simplify_shape.Rd @@ -8,7 +8,7 @@ simplify_shape(shp, fact = 0.1, keep.units = FALSE, keep.subunits = FALSE, ...) } \arguments{ -\item{shp}{a \code{\link[sp:SpatialPolygons]{SpatialPolygons(DataFrame)}} or a \code{\link[sp:SpatialLines]{SpatialLines(DataFrame)}}, or an \code{\link[sf:sf]{sf}} object that can be coerced to one of them.} +\item{shp}{an \code{\link[sf:sf]{sf}} object.} \item{fact}{simplification factor, number between 0 and 1 (default is 0.1)} @@ -49,4 +49,5 @@ if (require(tmap)) { tmap_arrange(tm5, tm6, tm7) } } + } diff --git a/man/smooth_map.Rd b/man/smooth_map.Rd deleted file mode 100644 index 0726ffc..0000000 --- a/man/smooth_map.Rd +++ /dev/null @@ -1,183 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/smooth_map.R -\name{smooth_map} -\alias{smooth_map} -\title{Create a smooth map (deprecated)} -\usage{ -smooth_map(shp, var = NULL, nrow = NA, ncol = NA, N = 250000, - unit = "km", unit.size = 1000, smooth.raster = TRUE, nlevels = 5, - style = ifelse(is.null(breaks), "pretty", "fixed"), breaks = NULL, - bandwidth = NA, threshold = 0, cover.type = NA, cover = NULL, - cover.threshold = 0.6, weight = 1, extracting.method = "full", - buffer.width = NA, to.Raster = NULL) -} -\arguments{ -\item{shp}{shape object of class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}. Spatial points, polygons, and grids are supported. Spatial lines are not.} - -\item{var}{variable name. Not needed for \code{\link[sp:SpatialPoints]{SpatialPoints}}. If missing, the first variable name is taken. For polygons, the variable should contain densities, not absolute numbers.} - -\item{nrow}{number of rows in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}}} - -\item{ncol}{number of rows in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}}} - -\item{N}{preferred number of points in the raster that is used to smooth the shape object. Only applicable if shp is not a \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}}} - -\item{unit}{unit specification. Needed when calculating density values. When set to \code{NA}, the densities values are based on the dimensions of the raster (defined by \code{nrow} and \code{ncol}). See also \code{unit.size}.} - -\item{unit.size}{size of the unit in terms of coordinate units. The coordinate system of many projections is approximately in meters while thematic maps typically range many kilometers, so by default \code{unit="km"} and \code{unit.size=1000} (meaning 1 kilometer equals 1000 coordinate units).} - -\item{smooth.raster}{logical that determines whether 2D kernel density smoothing is applied to the raster shape object. Not applicable when \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} object (since it already requires a 2D kernel density estimator). Other spatial objects are converted to a raster, which is smoothed when \code{smooth.raster=TRUE}.} - -\item{nlevels}{preferred number of levels} - -\item{style}{method to cut the color scale: e.g. "fixed", "equal", "pretty", "quantile", or "kmeans". See the details in \code{\link[classInt:classIntervals]{classIntervals}}.} - -\item{breaks}{in case \code{style=="fixed"}, breaks should be specified} - -\item{bandwidth}{single numeric value or vector of two numeric values that specifiy the bandwidth of the kernal density estimator. By default, it is 1/50th of the shortest side in units (specified with \code{unit.size}).} - -\item{threshold}{threshold value when a 2D kernel density is applied. Density values below this threshold will be set to \code{NA}. Only applicable when \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} or \code{smooth.raster=TRUE}.} - -\item{cover.type}{character value that specifies the type of raster cover, in other words, how the boundaries are specified. Options: \code{"original"} uses the same boundaries as \code{shp} (default for polygons), \code{"smooth"} calculates a smooth boundary based on the 2D kernal density (determined by \code{\link{smooth_raster_cover}}), \code{"rect"} uses the bounding box of \code{shp} as boundaries (default for spatial points and grids).} - -\item{cover}{\code{\link[sp:SpatialPolygons]{SpatialPolygons}} shape that determines the covered area in which the contour lines are placed. If specified, \code{cover.type} is ignored.} - -\item{cover.threshold}{numeric value between 0 and 1 that determines which part of the estimated 2D kernal density is returned as cover. Only applicable when \code{cover.type="smooth"}.} - -\item{weight}{single number that specifies the weight of a single point. Only applicable if \code{shp} is a \code{\link[sp:SpatialPoints]{SpatialPoints}} object.} - -\item{extracting.method}{Method of how coordinates are extracted from the kernel density polygons. Options are: \code{"full"} (default), \code{"grid"}, and \code{"single"}. See details. For the slowest method \code{"full"}, \code{\link[raster:extract]{extract}} is used. For \code{"grid"}, points on a grid layout are selected that intersect with the polygon. For \code{"simple"}, a simple point is generated with \code{\link[rgeos:gPointOnSurface]{gPointOnSurface}}.} - -\item{buffer.width}{Buffer width of the iso lines to cut kernel density polygons. Should be small enough to let the polygons touch each other without space in between. However, too low values may cause geometric errors.} - -\item{to.Raster}{not used anymore, since the "raster" output is always a \code{\link[raster:Raster-class]{RasterLayer}} as of version 2.0} -} -\value{ -List with the following items: -\describe{ -\item{\code{"raster"}}{A smooth raster, which is either a \code{\link[sp:SpatialGridDataFrame]{SpatialGridDataFrame}} or a \code{\link[raster:Raster-class]{RasterLayer}} (see \code{to.Raster})} -\item{\code{"iso"}}{Contour lines, which is an \code{\link[sf:sf]{sf}} object of spatial lines.} -\item{\code{"polygons"}}{Kernel density polygons, which is an \code{\link[sf:sf]{sf}} object of spatial polygons} -\item{\code{"bbox"}}{Bounding box of the used raster} -\item{\code{"ncol"}}{Number of rows in the raster} -\item{\code{"nrow"}}{Number of columns in the raster} -} -} -\description{ -Create a smooth map from a shape object. A 2D kernel density estimator is applied to the shape, which can be a spatial points, polygons, or raster object. Various format are returned: a smooth raster, contour lines, and polygons. The covered area can be specified, i.e., the area outside of it is extracted from the output. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -For the estimation of the 2D kernal density, code is borrowed from \code{\link[KernSmooth:bkde2D]{bkde2D}}. This implemention is slightly different: \code{\link[KernSmooth:bkde2D]{bkde2D}} takes point coordinates and applies linear binning, whereas in this function, the data is already binned, with values 1 if the values of \code{var} are not missing and 0 if values of \code{var} are missing. - -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -} -\examples{ -\dontrun{ -if (require(tmap)) { - # set mode to plotting mode - current.mode <- tmap_mode("plot") - - #################################### - ## Already smoothed raster - #################################### - vol <- raster::raster(t(volcano[, ncol(volcano):1]), xmn=0, xmx=870, ymn=0, ymx=610) - vol_smooth <- smooth_map(vol, smooth.raster = FALSE, nlevels = 10) - - tm_shape(vol_smooth$polygons) + - tm_fill("level", palette=terrain.colors(11), title="Elevation") + - tm_shape(vol_smooth$iso) + - tm_iso(col = "black", size = .7, fontcolor="black") + - tm_layout("Maunga Whau volcano (Auckland)", title.position=c("left", "bottom"), - inner.margins=0) + - tm_legend(width=.13, position=c("right", "top"), bg.color="gray80", frame = TRUE) - - - #################################### - ## Smooth polygons - #################################### - data(NLD_muni) - - NLD_muni$population_dens <- as.vector(calc_densities(NLD_muni, "population")) - - qtm(NLD_muni, fill="population_dens") - - NLD_smooth <- smooth_map(NLD_muni, var = "population_dens") - - qtm(NLD_smooth$raster, style="grey") - qtm(NLD_smooth$polygons, format="NLD") - - #################################### - ## Smooth points - #################################### - - # Approximate world population density as spatial points, one for each 1 million people, - # in the following way. Each metropolitan area of x million people will be represented - # by x dots. The remaining population per country will be represented by dots that are - # sampled across the country. - create_dot_per_1mln_people <- function() { - data(World, metro) - metro_eck <- set_projection(metro, projection = "eck4") - - # aggregate metropolitan population per country - metro_per_country <- tapply(metro_eck$pop2010, INDEX = list(metro_eck$iso_a3), FUN=sum) - metro_per_country_in_World <- metro_per_country[names(metro_per_country) \%in\% World$iso_a3] - - # assign to World shape - World$pop_metro <- 0 - World$pop_metro[match(names(metro_per_country_in_World), World$iso_a3)] <- - metro_per_country_in_World - - # define population density other than metropolitan areas - World$pop_est_dens_non_metro <- (World$pop_est - World$pop_metro) / World$area - - # generate dots for metropolitan areas (1 dot = 1mln people) - repeats <- pmax(1, metro_eck$pop2010 \%/\% 1e6) - ids <- unlist(mapply(rep, 1:nrow(metro_eck), repeats, SIMPLIFY = FALSE)) - - metro_dots <- metro_eck[ids, ] - - - # sample population dots from non-metropolitan areas (1 dot = 1mln people) - World_pop <- sample_dots(World, vars="pop_est_dens_non_metro", w = 1e6, - npop = 7.3e9 - nrow(metro_dots)*1e6) - - # combine - - c(st_geometry(World_pop), st_geometry(metro_dots)) - } - - World_1mln_dots <- create_dot_per_1mln_people() - - - # dot map - tm_shape(World_1mln_dots) + tm_dots() - - # create smooth map - World_list <- smooth_map(World_1mln_dots, cover = World, weight=1e6) - - # plot smooth raster map - qtm(World_list$raster, style="grey") - - # plot smooth raster map - qtm(World, bbox="India") + qtm(World_list$iso) - - # plot kernel density map - qtm(World_list$polygons, style="grey", format="World") - - #################################### - ## Smooth raster - #################################### - data(land) - - land_smooth <- smooth_map(land, var="trees", cover.type = "smooth") - - qtm(land, raster="trees") - qtm(land_smooth$raster) - qtm(land_smooth$polygons, format="World", style="grey") - - # reset current mode - tmap_mode(current.mode) -} -} - -} diff --git a/man/smooth_raster_cover.Rd b/man/smooth_raster_cover.Rd deleted file mode 100644 index 1debbf8..0000000 --- a/man/smooth_raster_cover.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/smooth_raster_cover.R -\name{smooth_raster_cover} -\alias{smooth_raster_cover} -\title{Get a smoothed cover of a raster object (deprecated)} -\usage{ -smooth_raster_cover(shp, var = NULL, bandwidth = NA, threshold = 0.6, - output = "polygons") -} -\arguments{ -\item{shp}{raster object, from either \code{\link[sp:SpatialGridDataFrame]{SpatialGrid(DataFrame)}} or \code{\link[raster:Raster-class]{Raster}} class.} - -\item{var}{name of the variable from which missing values are flagged. If unspecified, the first variable will be taken.} - -\item{bandwidth}{single numeric value or vector of two numeric values that specifiy the bandwidth of the kernal density estimator. See details.} - -\item{threshold}{numeric value between 0 and 1 that determines which part of the estimated 2D kernal density is returned as cover.} - -\item{output}{class of the returned object. One of: \code{polygons} (\code{\link[sf:sf]{sf}} object), \code{lines} (\code{sf} object), or a \code{\link[raster:Raster-class]{raster}}. A vector of class names results in a list of output objects.} -} -\description{ -Get a smoothed cover of a raster object. From all non-missing values of a raster object, a 2D kernal density is applied. The output is a \code{sf} object of spatial polygons. Used by \code{\link{smooth_map}}. Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). Note that this function supports \code{sf} objects, but still uses sp-based methods (see details). -} -\details{ -For the estimation of the 2D kernal density, code is borrowed from \code{\link[KernSmooth:bkde2D]{bkde2D}}. This implemention is slightly different: \code{\link[KernSmooth:bkde2D]{bkde2D}} takes point coordinates and applies linear binning, whereas in this function, the data is already binned, with values 1 if the values of \code{var} are not missing and 0 if values of \code{var} are missing. - -This function supports \code{\link[sf:sf]{sf}} objects, but still uses sp-based methods, from the packages sp, rgeos, and/or rgdal. -} diff --git a/man/tmaptools-deprecated.Rd b/man/tmaptools-deprecated.Rd deleted file mode 100644 index 3a728c4..0000000 --- a/man/tmaptools-deprecated.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg.R -\docType{package} -\name{tmaptools-deprecated} -\alias{tmaptools-deprecated} -\alias{tmaptools-deprecated-package} -\title{Deprecated functions in \code{tmaptools}} -\description{ -These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} -} -\details{ -\code{\link{append_data}}, \code{\link{aggregate_map}}, \code{\link{double_line}}, \code{\link{points_to_raster}}, \code{\link{poly_to_raster}}, \code{\link{sample_dots}}, \code{\link{sbind}}, \code{\link{smooth_map}}, \code{\link{smooth_raster_cover}}, \code{\link{read_shape}}, \code{\link{write_shape}} -} diff --git a/man/tmaptools-package.Rd b/man/tmaptools-package.Rd index f3cec69..72e7ced 100644 --- a/man/tmaptools-package.Rd +++ b/man/tmaptools-package.Rd @@ -19,18 +19,6 @@ This page provides a brief overview of all package functions. \code{\link{bb}}\tab Create, extract or modify a bounding box \cr \code{\link{bb_poly}}\tab Convert bounding box to a polygon \cr \code{\link{get_asp_ratio}}\tab Get the aspect ratio of a shape object \cr -\code{\link{get_IDs}}\tab Get ID values of a shape object \cr -\code{\link{is_projected}}\tab Check if the map is projected \cr -\code{\link{get_projection}}\tab Get the map projection \cr ---------------------------- \tab --------------------------------------------------------------------------------------------------- \cr -} -} - -\section{Tool functions (data)}{ - -\tabular{ll}{ -\code{\link{append_data}}\tab Append a data frame to a shape object \cr -\code{\link{calc_densities}}\tab Calculate density values \cr --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr } } @@ -48,16 +36,8 @@ This page provides a brief overview of all package functions. \section{Spatial transformation functions}{ \tabular{ll}{ -\code{\link{aggregate_map}}\tab Aggregate the units of a map \cr \code{\link{crop_shape}}\tab Crop shape objects \cr -\code{\link{points_to_raster}}\tab Bin spatial points to a raster \cr -\code{\link{poly_to_raster}}\tab Convert polygons to a raster \cr -\code{\link{sbind}}\tab Bind shape objects \cr -\code{\link{sample_dots}}\tab Sample dots from polygons \cr -\code{\link{set_projection}}\tab Set the map projection \cr \code{\link{simplify_shape}}\tab Simplify a shape \cr -\code{\link{smooth_map}}\tab Create a smooth map using a kernel density estimator \cr -\code{\link{smooth_raster_cover}}\tab Create a smooth cover from a raster object \cr --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr } } @@ -68,9 +48,7 @@ This page provides a brief overview of all package functions. \code{\link{geocode_OSM}}\tab Get a location from an address description \cr \code{\link{read_GPX}}\tab Read a GPX file \cr \code{\link{read_osm}}\tab Read Open Street Map data \cr -\code{\link{read_shape}}\tab Read a shape object \cr \code{\link{rev_geocode_OSM}}\tab Get an address description from a location \cr -\code{\link{write_shape}}\tab Write a shape object \cr --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr } } diff --git a/man/write_shape.Rd b/man/write_shape.Rd deleted file mode 100644 index 9208692..0000000 --- a/man/write_shape.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_shape.R -\name{write_shape} -\alias{write_shape} -\title{Write shape file (deprecated)} -\usage{ -write_shape(shp, file) -} -\arguments{ -\item{shp}{a shape object} - -\item{file}{file name (including directory)} -} -\description{ -Write a shape object to an ESRI shape file. -} -\details{ -This function is a convenient wrapper of rgdal's \code{\link[rgdal:writeOGR]{writeOGR}}. -} diff --git a/sandbox/stars.R b/sandbox/stars.R new file mode 100644 index 0000000..faad237 --- /dev/null +++ b/sandbox/stars.R @@ -0,0 +1,44 @@ +library(stars) +library(OpenStreetMap) + +# read osm data +x <- openmap(upperLeft = c(53.699950, 3.046742), lowerRight = c(50.590457, 7.448777), type = "osm") + +# get ingredients from x (ncols, nrows, a, bbx) +ncols <- x$tiles[[1]]$yres # not sure why OpenStreetMap has swapped y and x... +nrows <- x$tiles[[1]]$xres + +rgb_values <- col2rgb(x$tiles[[1]]$colorData) +a <- array(t(rgb_values), dim = c(x = ncols, y = nrows, band = 3)) + +bbx_coor <- unname(unlist(x$bbox))[c(1,3,4,2)] +names(bbx_coor) <- c("xmin", "xmax", "ymin", "ymax") + +crs <- st_crs(x$tiles[[1]]$projection) + +bbx <- st_bbox(bbx_coor, crs = crs) + + +# methode 1: via raster package +x2 <- raster::raster(x) +x3 <- st_as_stars(x2) + +plot(x3) + + +# methode 2: array method +x4 <- st_as_stars(a) +attr(x4, "dimensions")[[2]]$delta <- -1 + +plot(x4) +# is there an easy way to add the bbox and crs to x4? + +# methode 3: bbox method +x5 <- st_as_stars(bbx, nx = ncols, ny = nrows, values = a[,,1]) +plot(x5) + +x6 <- st_as_stars(bbx, nx = ncols, ny = nrows, values = a) +# it only takes the first 799*920 slice +# how to add values for multiple bands? + +# are there other methods to convert x to a stars object? From cff6b44bea6bece7d072c05c5999d1bae906a119 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 14 Jan 2020 17:56:18 +0100 Subject: [PATCH 02/44] check ok --- NAMESPACE | 2 -- R/approx_distances.R | 22 +++++++++++----------- R/bb.R | 5 ++--- R/bb_poly.R | 2 +- R/crop_shape.R | 6 +++--- R/deprecated.R | 6 +++--- R/geocode_OSM.R | 10 +++++----- R/get_asp_ratio.R | 2 -- R/map_coloring.R | 2 +- examples/calc_densities.R | 2 +- man/calc_densities.Rd | 2 +- 11 files changed, 28 insertions(+), 33 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a472c12..78fa795 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,7 +25,6 @@ export(simplify_shape) export(tmap.pal.info) import(RColorBrewer) import(grid) -import(sp) importFrom(XML,xmlAttrs) importFrom(XML,xmlChildren) importFrom(XML,xmlRoot) @@ -37,7 +36,6 @@ importFrom(lwgeom,st_geod_area) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") importFrom(raster,brick) -importFrom(raster,couldBeLonLat) importFrom(raster,extent) importFrom(raster,mask) importFrom(raster,raster) diff --git a/R/approx_distances.R b/R/approx_distances.R index 079e22e..9704918 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -44,27 +44,27 @@ approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { stop("x cannot be coerced to a bounding box with bb", call. = FALSE) }) - pW <- st_sfc(st_point(c(bbx[1], (bbx[2]+bbx[4])/2)), crs=projection) - pE <- st_sfc(st_point(c(bbx[3], (bbx[2]+bbx[4])/2)), crs=projection) - pS <- st_sfc(st_point(c((bbx[1]+bbx[3])/2, bbx[2])), crs=projection) - pN <- st_sfc(st_point(c((bbx[1]+bbx[3])/2, bbx[4])), crs=projection) + pW <- sf::st_sfc(sf::st_point(c(bbx[1], (bbx[2]+bbx[4])/2)), crs=projection) + pE <- sf::st_sfc(sf::st_point(c(bbx[3], (bbx[2]+bbx[4])/2)), crs=projection) + pS <- sf::st_sfc(sf::st_point(c((bbx[1]+bbx[3])/2, bbx[2])), crs=projection) + pN <- sf::st_sfc(sf::st_point(c((bbx[1]+bbx[3])/2, bbx[4])), crs=projection) if (missing(target)) { list(hdist = get_distance(pW, pE), #st_distance(pW, pE)[1,1], vdist = get_distance(pS, pN)) #st_distance(pS, pN)[1,1]) } else { - list(hdist = set_units(get_distance(pW, pE), target, mode = "standard"), #st_distance(pW, pE)[1,1] - vdist = set_units(get_distance(pS, pN), target, mode = "standard")) #st_distance(pS, pN)[1,1] + list(hdist = units::set_units(get_distance(pW, pE), target, mode = "standard"), #st_distance(pW, pE)[1,1] + vdist = units::set_units(get_distance(pS, pN), target, mode = "standard")) #st_distance(pS, pN)[1,1] } } else { - p1 <- st_sfc(st_point(x), crs=projection) - p2 <- st_sfc(st_point(y), crs=projection) + p1 <- sf::st_sfc(sf::st_point(x), crs=projection) + p2 <- sf::st_sfc(sf::st_point(y), crs=projection) if (missing(target) || is.na(projection)) { - st_distance(p1, p2)[1,1] + sf::st_distance(p1, p2)[1,1] } else { - set_units(st_distance(p1, p2), target, mode = "standard")[1,1] + units::set_units(sf::st_distance(p1, p2), target, mode = "standard")[1,1] } } @@ -72,7 +72,7 @@ approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { get_distance <- function(p1, p2) { - tryCatch(st_distance(p1, p2)[1,1], error = function(e) { + tryCatch(sf::st_distance(p1, p2)[1,1], error = function(e) { p1ll <- lwgeom::st_transform_proj(p1, crs = 4326) p2ll <- lwgeom::st_transform_proj(p2, crs = 4326) lwgeom::st_geod_distance(p1ll, p2ll)[1,1] diff --git a/R/bb.R b/R/bb.R index 43c9482..ea4ccc3 100755 --- a/R/bb.R +++ b/R/bb.R @@ -38,7 +38,6 @@ #' \item \code{"extent"} an \code{raster::extent} object, which is a numeric vector of 4: xmin, xmax, ymin, ymax. This representation used by the \code{raster} package. #' } #' @return bounding box (see argument \code{output}) -#' @import sp #' @importFrom raster extent #' @importFrom XML xmlTreeParse xmlChildren xmlRoot xmlAttrs #' @example ./examples/bb.R @@ -235,10 +234,10 @@ get_bb <- function(x, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim b <- sfbb(x) } else if (inherits(x, "Raster")) { b <- sfbb(attr(x, "extent")) - current.projection <- get_projection(x, output = "crs") + current.projection <- sf::st_crs(x) } else if (inherits(x, "Spatial")) { b <- sfbb(attr(x, "bbox")) - current.projection <- get_projection(x, output = "crs") + current.projection <- sf::st_crs(x) } else if (inherits(x, c("sf", "sfc", "stars"))) { b <- sf::st_bbox(x) current.projection <- sf::st_crs(x) diff --git a/R/bb_poly.R b/R/bb_poly.R index 3715da4..48db654 100755 --- a/R/bb_poly.R +++ b/R/bb_poly.R @@ -20,7 +20,7 @@ bb_poly <- function(x, steps=100, stepsize=NA, projection=NULL) { } create_sf_rect <- function(bbx, steps=100, stepsize=NA, projection=NULL) { - if (is.null(projection)) projection <- st_crs(bbx) + if (is.null(projection)) projection <- sf::st_crs(bbx) x1 <- bbx[1] x2 <- bbx[3] diff --git a/R/crop_shape.R b/R/crop_shape.R index ebcbb30..e1432db 100755 --- a/R/crop_shape.R +++ b/R/crop_shape.R @@ -54,14 +54,14 @@ crop_shape <- function(x, y, polygon = FALSE, ...) { if (polycut) { if (inherits(y, "bbox")) y <- create_sf_rect(y) - yunion <- st_union(y) + yunion <- sf::st_union(y) ## REQUIRE SP if (israsterx) { stop("Rasterized method not implemented yet") #yunion <- as(yunion, "Spatial") #x2 <- raster::trim(raster::mask(x, yunion)) } else { - x2 <- suppressMessages(suppressWarnings(st_intersection(x, yunion))) + x2 <- suppressMessages(suppressWarnings(sf::st_intersection(x, yunion))) } } else { @@ -73,7 +73,7 @@ crop_shape <- function(x, y, polygon = FALSE, ...) { # x2 <- suppressWarnings(crop(x, y, ...)) } else { y <- create_sf_rect(y) - x2 <- suppressMessages(suppressWarnings(st_intersection(x, y))) + x2 <- suppressMessages(suppressWarnings(sf::st_intersection(x, y))) } } x2 diff --git a/R/deprecated.R b/R/deprecated.R index c2710ae..e268e28 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -77,11 +77,11 @@ get_projection <- function(shp, guess.longlat=FALSE, warning("get_projection is deprecated; for projections, please use the function st_crs from the sf package") p <- if (inherits(shp, c("sf", "sfc", "stars"))) { - st_crs(shp) + sf::st_crs(shp) } else if (inherits(shp, "Spatial")) { - st_crs(attr(attr(shp, "proj4string"), "projargs")) + sf::st_crs(attr(attr(shp, "proj4string"), "projargs")) } else if (inherits(shp, "Raster")) { - st_crs(attr(attr(shp, "crs"), "projargs")) + sf::st_crs(attr(attr(shp, "crs"), "projargs")) } else { stop("shp is neither an sf, sp, raster, nor a stars object") } diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index a680f73..38b28eb 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -71,11 +71,11 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS search_result_bb <- b[c(2,4,1,3)] names(search_result_bb) <- c("y_min", "y_max", "x_min", "x_max") - p <- st_sf(st_sfc(st_point(search_result_loc[2:1]), crs = .crs_longlat)) + p <- sf::st_sf(sf::st_sfc(sf::st_point(search_result_loc[2:1]), crs = .crs_longlat)) p <- sf::st_transform(p, crs=projection) - coords <- as.vector(st_coordinates(p)) + coords <- as.vector(sf::st_coordinates(p)) names(coords) <- c("x", "y") search_result_loc <- as.list(coords) @@ -116,15 +116,15 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS if (!project) { df$x <- df$lon df$y <- df$lat - res <- st_as_sf(df, coords = c("x","y"), crs=.crs_longlat) + res <- sf::st_as_sf(df, coords = c("x","y"), crs=.crs_longlat) } else { df$x2 <- df$x df$y2 <- df$y - res <- st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat) + res <- sf::st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat) } names(res)[names(res) == "geometry"] <- "point" res <- st_set_geometry(res, "point") - st_set_crs(res, .crs_longlat) + sf::st_set_crs(res, .crs_longlat) } else { df } diff --git a/R/get_asp_ratio.R b/R/get_asp_ratio.R index f8cfe4b..ffb9684 100644 --- a/R/get_asp_ratio.R +++ b/R/get_asp_ratio.R @@ -10,8 +10,6 @@ #' @param height See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @param res See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @return aspect ratio -#' @import sp -#' @importFrom raster couldBeLonLat #' @example ./examples/get_asp_ratio.R #' @export get_asp_ratio <- function(x, is.projected = NA, width=700, height=700, res=100) { diff --git a/R/map_coloring.R b/R/map_coloring.R index 09f70fc..b1f0d32 100644 --- a/R/map_coloring.R +++ b/R/map_coloring.R @@ -81,7 +81,7 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palett #' @return A list where the items correspond to the features. Each item is a vector of neighbours. #' @export get_neighbours <- function(x) { - y <- st_intersects(x, x) + y <- sf::st_intersects(x, x) n <- length(y) mapply(function(yi, i) { diff --git a/examples/calc_densities.R b/examples/calc_densities.R index d5a9309..186d4c4 100644 --- a/examples/calc_densities.R +++ b/examples/calc_densities.R @@ -6,7 +6,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_women_km^2", "pop_women_km^2"), + tm_polygons(c("pop_women_km.2", "pop_women_km.2"), title=expression("Population per " * km^2), style="quantile") + tm_facets(free.scales = FALSE) + tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index ba9bc1c..3f4c8c9 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -35,7 +35,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_women_km^2", "pop_women_km^2"), + tm_polygons(c("pop_women_km.2", "pop_women_km.2"), title=expression("Population per " * km^2), style="quantile") + tm_facets(free.scales = FALSE) + tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) From 3ce1ecddc242b425efd0247bae8cfb79685d3afc Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 15 Jan 2020 21:51:11 +0000 Subject: [PATCH 03/44] improved deprecated functions --- NAMESPACE | 8 ++ R/approx_distances.R | 4 +- R/deprecated.R | 86 +++++++++++++++++---- R/geocode_OSM.R | 2 +- R/get_asp_ratio.R | 4 + R/raster_functions.R | 74 ------------------ R/simplify_shape.R | 2 +- R/xxx_raster.R | 177 ------------------------------------------- R/xxx_scales.R | 58 +++++++------- 9 files changed, 116 insertions(+), 299 deletions(-) delete mode 100644 R/raster_functions.R delete mode 100644 R/xxx_raster.R diff --git a/NAMESPACE b/NAMESPACE index 78fa795..1592d5f 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,14 +32,22 @@ importFrom(XML,xmlTreeParse) importFrom(XML,xmlValue) importFrom(dichromat,dichromat) importFrom(grDevices,col2rgb) +importFrom(grDevices,colorRampPalette) +importFrom(grDevices,dev.off) +importFrom(grDevices,png) +importFrom(grDevices,rgb) importFrom(lwgeom,st_geod_area) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") +importFrom(methods,as) importFrom(raster,brick) importFrom(raster,extent) importFrom(raster,mask) importFrom(raster,raster) importFrom(raster,trim) +importFrom(stats,aggregate) +importFrom(stats,na.omit) importFrom(units,as_units) importFrom(units,set_units) +importFrom(utils,download.file) importFrom(viridisLite,viridis) diff --git a/R/approx_distances.R b/R/approx_distances.R index 9704918..fcc4496 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -24,11 +24,11 @@ approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { if (!inherits(x, c("sf", "Spatial", "raster"))) { if (missing(projection)) { - projection <- st_crs(NA) + projection <- sf::st_crs(NA) #stop("Please specify projection") } } else { - projection <- st_crs(x) + projection <- sf::st_crs(x) } if (is.na(projection)) { diff --git a/R/deprecated.R b/R/deprecated.R index e268e28..a5688eb 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -33,35 +33,91 @@ NULL #' @keywords internal #' @export get_proj4 <- function(x, output = c("crs", "character", "epsg", "CRS")) { - warning("get_proj4 is deprecated; for projections, please use the function st_crs from the sf package") + if (sys.nframe()==1L) warning("get_proj4 is deprecated; for projections, please use the function st_crs from the sf package") + output <- match.arg(output) - crs <- sf::st_crs(x) - - if (output == "crs") { - crs - } else if (output == "character") { - crs$proj4string - } else if (output == "epsg") { - crs$epsg - } else if (output == "CRS") { - stop("output CRS not supported anymore") + y <- if (is.null(x)) { + return(NULL) + } else if (is.na(x)) { + sf::st_crs() + } else if (inherits(x, "crs")) { + x + } else if (inherits(x, "CRS")) { + sf::st_crs(attr(x, "projargs")) + } else if (!is.numeric(x) && !is.character(x)) { + stop("x is not a character, crs object, CRS object, nor a number", call.=FALSE) } else { - stop("Unknown output") + if (x %in% names(.proj_epsg)) { + create_crs(unname(.proj_epsg[x])) + } else if (x %in% names(.proj_sc)) { + create_crs(unname(.proj_sc[x])) + } else if (is_num_string(x)) { + sf::st_crs(x) + } else if (substr(x, 1, 3)=="utm") { + if (!(nchar(x) %in% c(5,6))) stop("\"utm\" shortcut code should be utmXX or utmXXs where XX refers to the utm zone") + sf::st_crs(paste("+proj=utm +zone=", substr(x, 4, 5), ifelse(substr(x, 6, 6)=="s", " +south", ""), " +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", sep="")) + } else { + sf::st_crs(x) + } } + + if (output == "CRS") stop("output CRS not supported anymore") + + switch(output, + character = y$proj4string, + crs = y, + epsg = y$epsg) } +create_crs <- function(x) { + if (is.numeric(x)) { + sf::st_crs(x) + } else { + structure(list(epsg = as.integer(NA), proj4string = x), class = "crs") + } +} + +is_num_string <- function(x) { + suppressWarnings(!is.na(as.numeric(x))) +} + +.proj_epsg <- c(longlat = 4326, + latlong = 4326, + WGS84 = 4326, + NAD83 = 4269, + NAD27 = 4267, + merc = 3857, + laea_Eur = 3035, + laea_NA = 2163, + rd = 28992) + +.proj_sc <- c(wintri="+proj=wintri +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + robin="+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + eck4="+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + hd="+proj=cea +lat_ts=37.5 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + gall="+proj=cea +lon_0=0 +lat_ts=45 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + mill="+proj=mill +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +R_A +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + eqc0="+proj=eqc +lat_ts=0 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + eqc30="+proj=eqc +lat_ts=30 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", + eqc45="+proj=eqc +lat_ts=45 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0") + + #' @rdname deprecated_functions #' @name set_projection #' @keywords internal #' @export set_projection <- function(shp, projection=NA, current.projection=NA, overwrite.current.projection=FALSE) { - warning("set_projection is deprecated; for projections, please use the functions st_crs or st_transform from the sf package") + if (sys.nframe()==1L) warning("set_projection is deprecated; for projections, please use the functions st_crs or st_transform from the sf package") + + if (inherits(shp, "Raster")) shp <- stars::st_as_stars(shp) + if (!is.na(current.projection)) { if (!is.na(sf::st_crs(shp)) && !overwrite.current.projection) stop("Current projection already known. Use overwrite.current.projection = TRUE") sf::st_crs(shp) <- sf::st_crs(current.projection) } + if (!is.na(projection)) { shp <- sf::st_transform(shp, crs = sf::st_crs(projection)) } @@ -74,7 +130,7 @@ set_projection <- function(shp, projection=NA, current.projection=NA, overwrite. #' @export get_projection <- function(shp, guess.longlat=FALSE, output = c("character", "crs", "epsg", "CRS")) { - warning("get_projection is deprecated; for projections, please use the function st_crs from the sf package") + if (sys.nframe()==1L) warning("get_projection is deprecated; for projections, please use the function st_crs from the sf package") p <- if (inherits(shp, c("sf", "sfc", "stars"))) { sf::st_crs(shp) @@ -99,6 +155,6 @@ get_projection <- function(shp, guess.longlat=FALSE, #' @keywords internal #' @export is_projected <- function(x) { - warning("is_projected is deprecated; for projections, please use the function st_is_longlat from the sf package") + if (sys.nframe()==1L) warning("is_projected is deprecated; for projections, please use the function st_is_longlat from the sf package") !sf::st_is_longlat(x) } diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 38b28eb..ce2ed50 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -123,7 +123,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS res <- sf::st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat) } names(res)[names(res) == "geometry"] <- "point" - res <- st_set_geometry(res, "point") + res <- sf::st_set_geometry(res, "point") sf::st_set_crs(res, .crs_longlat) } else { df diff --git a/R/get_asp_ratio.R b/R/get_asp_ratio.R index ffb9684..8e65c58 100644 --- a/R/get_asp_ratio.R +++ b/R/get_asp_ratio.R @@ -10,6 +10,10 @@ #' @param height See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @param res See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @return aspect ratio +#' @importFrom grDevices colorRampPalette dev.off png rgb +#' @importFrom methods as +#' @importFrom stats aggregate na.omit +#' @importFrom utils download.file #' @example ./examples/get_asp_ratio.R #' @export get_asp_ratio <- function(x, is.projected = NA, width=700, height=700, res=100) { diff --git a/R/raster_functions.R b/R/raster_functions.R deleted file mode 100644 index b68adeb..0000000 --- a/R/raster_functions.R +++ /dev/null @@ -1,74 +0,0 @@ -set_raster_levels <- function(shp, lvls) { - isf <- !vapply(lvls, is.null, logical(1)) - cls <- class(shp) - if (any(isf)) { - shp@data@isfactor <- isf - dfs <- mapply(function(nm, lv) { - df <- data.frame(ID=1:length(lv), levels=factor(lv, levels=lv)) - if (cls=="RasterBrick") names(df)[2] <- nm - df - }, names(which(isf)), lvls[isf], SIMPLIFY=FALSE) - shp@data@attributes <- dfs - } - shp -} - -get_RasterLayer_levels <- function(r) { - if (r@data@isfactor) { - dt <- r@data@attributes[[1]] - levelsID <- ncol(dt) - as.character(dt[[levelsID]]) - } else { - NULL - } -} - -get_raster_names <- function(shp) { - nms <- names(shp) - - # overwrite unknown first names with FILE__VALUES - if (inherits(shp, "RasterStack")) { - if (shp@layers[[1]]@data@names[1]=="") nms[1] <- "FILE__VALUES" - } else { - if (shp@data@names[1]=="") nms[1] <- "FILE__VALUES" - } - nms -} - -get_raster_levels <- function(shp, layerIDs) { - if (missing(layerIDs)) layerIDs <- 1L:nlayers(shp) - - if (inherits(shp, "Spatial")) { - return(lapply(attr(shp, "data")[,layerIDs], levels)) - } - - shpnames <- get_raster_names(shp)[layerIDs] - if (inherits(shp, "RasterLayer")) { - lvls <- list(get_RasterLayer_levels(shp)) - } else if (inherits(shp, "RasterStack")) { - lvls <- lapply(shp@layers[layerIDs], get_RasterLayer_levels) - } else if (inherits(shp, "RasterBrick")) { - isfactor <- shp@data@isfactor - if (all(!isfactor)) { - lvls <- lapply(shpnames, function(sn) NULL) - } else { - atb <- shp@data@attributes - atb <- atb[vapply(atb, length, integer(1))!=0] - stopifnot(sum(isfactor)==length(atb)) - isfactor2 <- isfactor[layerIDs] - - lvls <- rep(list(NULL), length(layerIDs)) - if (any(isfactor2)) { - atb2 <- atb[match(layerIDs[isfactor2], which(isfactor))] - - lvls[isfactor2] <- lapply(atb2, function(a) { - if (class(a)=="list") a <- a[[1]] - levelsID <- ncol(a) # levels is always the last column of the attributes data.frame (?) - as.character(a[[levelsID]]) - }) - } - } - } - names(lvls) <- shpnames - lvls -} diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 8b758e3..19cc32e 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -36,7 +36,7 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS explode <- keep_shapes && keep.subunits x <- suppressWarnings(rmapshaper::ms_simplify(shp, keep=fact, keep_shapes=keep_shapes, explode=explode, ...)) - if (explode) x <- aggregate(x, by = list(x$UNIT__NR), FUN = function(x)x[1]) + if (explode) x <- stats::aggregate(x, by = list(x$UNIT__NR), FUN = function(x)x[1]) x[, c("rmapshaperid", "UNIT__NR")] <- list() names(x)[match(dataNames_new, names(x))] <- dataNames diff --git a/R/xxx_raster.R b/R/xxx_raster.R deleted file mode 100644 index 2725829..0000000 --- a/R/xxx_raster.R +++ /dev/null @@ -1,177 +0,0 @@ -raster_colors <- function(x, use.colortable = FALSE, max.value = 255) { - - x[is.na(x)] <- 0 - - n <- nrow(x) - - # get alpha transparency - if (ncol(x)==4) { - a <- x[,4] - x <- x[,1:3] - x[x] - } else { - a <- NULL - } - - if (!use.colortable) { - if (is.null(a)) { - cols <- rgb(x[,1], x[,2], x[,3], maxColorValue = max.value) - } else { - cols <- rgb(x[,1], x[,2], x[,3], a, maxColorValue = max.value) - } - return(factor(cols)) - } - - - storage.mode(x) <- "integer" - v <- x[, 1] * 1e6L + x[, 2] * 1e3L + x[, 3] - - isna <- is.na(v) - if (!is.null(a)) isna <- isna & (a==255) - - v <- v[!isna] - u <- unique(v) - nu <- length(u) - m <- match(v, u) - nc <- (min(256, nu)) - ta <- tabulate(m, nbins = nu) - mo <- order(ta, decreasing = TRUE) - ids <- mo[1:nc] - - r <- floor(u/1e6L) - g <- floor((u-r*1e6L)/1e3L) - b <- (u - r * 1e6L - g * 1e3L) - rs <- r[ids] - gs <- g[ids] - bs <- b[ids] - - RGB <- cbind(r, g, b) - RGBs <- cbind(rs, gs, bs) - - - dists <- apply(RGBs, MARGIN = 1, function(rw) { - sqrt((rw[1]-RGB[,1])^2 + (rw[2]-RGB[,2])^2 + (rw[3]-RGB[,3])^2) - }) - - ids2 <- apply(dists, MARGIN = 1, which.min) - - m2 <- ids2[m] - - ind <- integer(length=n) - - - ind[!isna] <- m2 - ind[isna] <- NA - - cols <- rgb(rs, gs, bs, maxColorValue = 255) - - factor(ind, labels=cols) -} - - - -extract_raster_data <- function(nm, isf, d, a){ - if (isf) { - if (class(a)=="list") a <- a[[1]] - id <- a$ID - a$ID <- NULL - a$COUNT <- NULL - alist <- lapply(a, function(ai) { - if (is.numeric(ai)) { - ai[d] - } else { - factor(d, levels=id, labels=as.character(ai)) - } - }) - as.data.frame(alist) - } else { - df <- data.frame(d) - names(df) <- ifelse(nm == "", "layer", nm) - df - } -} - -get_raster_layer_data <- function(rl) { - extract_raster_data(nm = rl@data@names, isf = rl@data@isfactor, d = rl@data@values, a = rl@data@attributes) -} - -fromDisk2 <- function(x) { - if (inherits(x, "RasterStack")) { - y <- FALSE - for (i in 1L:nlayers(x)) { - if (fromDisk(x[[i]])) y <- TRUE - } # stackApply doens't work - } else { - y <- fromDisk(x) - } - y -} - -get_raster_data <- function(shp, show.warnings = TRUE) { - cls <- class(shp) - if (fromDisk2(shp)) { - data <- raster::as.data.frame(shp) - layerID <- 1L:ncol(data) - } else if (inherits(shp, "RasterLayer")) { - data <- get_raster_layer_data(shp) - layerID <- rep(1L, ncol(data)) - } else if (inherits(shp, c("RasterStack", "RasterBrick"))) { - - if (inherits(shp, "RasterStack")) { - datalayers <- lapply(shp@layers, get_raster_layer_data) - } else { - nms <- shp@data@names - if (nms[1]=="") nms <- colnames(shp@data@values) - if (length(nms)!= nlayers(shp)) nms <- paste0("V", 1L:nlayers(shp)) - - - nl <- length(nms) - - isfactor <- shp@data@isfactor - - data <- as.list(as.data.frame(shp@data@values)) - - atb <- shp@data@attributes - atb <- atb[vapply(atb, length, integer(1))!=0] - - stopifnot(sum(isfactor)==length(atb)) - - atbList <- as.list(rep(NA, nl)) - atbList[isfactor] <- atb - - datalayers <- mapply(extract_raster_data, nms, isfactor, data, atbList, SIMPLIFY=FALSE) - } - - ks <- vapply(datalayers, ncol, integer(1)) - data <- do.call(cbind, datalayers) - if (any(duplicated(names(data)))) { - names(data) <- paste(unname(unlist(mapply(function(x, y) { - rep(x, each = y) - }, names(shp), ks, SIMPLIFY=FALSE))), names(data), sep = ".") - if (show.warnings) warning("Raster object contains duplicated variable names. Therefore, the variables have been internally renamed to ", paste(names(data), collapse = ", ")) - } - layerID <- unlist(mapply(rep, 1L:length(datalayers), ks, SIMPLIFY = FALSE)) - } - attr(data, "cls") <- cls - attr(data, "layerID") <- layerID - - mainID <- vapply(1L:max(layerID), function(i) which(layerID==i)[1], FUN.VALUE = integer(1)) - attr(data, "mainID") <- mainID - data -} - - -get_data_frame_levels <- function(data) { - lapply(data, function(x) { - if (is.factor(x)) { - levels(x) - } else if (is.numeric(x)) { - range(x, na.rm = TRUE) - } else if (is.logical(x)) { - c(FALSE, TRUE) - } else { - sort(unique(x)) - } - }) -} - diff --git a/R/xxx_scales.R b/R/xxx_scales.R index a8691a3..5918323 100644 --- a/R/xxx_scales.R +++ b/R/xxx_scales.R @@ -19,30 +19,30 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL } else { vec_fin <- unique(vec[!is.infinite(vec)]) frm <- gsub(" ", "", sprintf("%20.10f", abs(vec_fin))) - + # get width before decimal point #if (length(frm)==0) browser() mag <- max(nchar(frm)-11) - + # get number of decimals (which is number of decimals in vec, which is reduced when mag is large) ndec <- max(10 - nchar(frm) + nchar(sub("0+$","",frm))) if (is.na(digits)) { digits <- max(min(ndec, 4-mag), 0) - + # add sign to frm frm_sign <- paste0(ifelse(vec_fin<0, "-", "+"), frm) - + # test if number of digits is sufficient for unique labels if (!scientific) { while (anyDuplicated(substr(frm_sign, 1, nchar(frm_sign)-10 + digits)) && (digits < 10)) { digits <- digits + 1 } } - + } - + if (!scientific) { - + # check whether big number abbrevations should be used ext <- "" if (!is.na(big.num.abbr[1])) { @@ -56,10 +56,10 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL } } } - - - - + + + + # if (mag>11 || (mag > 9 && all(vec - floor(vec/1e9)*1e9 < 1))) { # vec <- vec / 1e9 # ext <- " bln" @@ -69,7 +69,7 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL # } else { # ext <- "" # } - + # set default values if (!("big.mark" %in% names(args))) args$big.mark <- "," if (!("format" %in% names(args))) args$format <- "f" @@ -94,20 +94,20 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL } } else { x[vec==-Inf] <- "" - + lbls <- paste(x[-n], x[-1], sep = paste0(" ", text.separator, " ")) if (vec[1]==-Inf) lbls[1] <- paste(paste(text.less.than, collapse = " "), x[2], sep = " ") if (vec[n]==Inf) lbls[n-1] <- paste(x[n-1], paste(text.or.more, collapse = " "), sep = " ") - + if (text.to.columns) { #xtra <- as.numeric(!is.na(text.align) && text.align=="right") - - + + nc1 <- nchar(paste(x[-n], " ", sep = "")) + 1 nc2 <- rep(nchar(paste(text.separator, " ", sep = "")), n-1) lbls_breaks <- matrix(c(nc1, nc1+nc2), ncol=2) - + if (vec[1]==-Inf) { if (length(text.less.than)==1) { lbls_breaks[1,] <- rep(nchar(paste(text.less.than[1], " ", sep = "")) + 1, 2) @@ -115,13 +115,13 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL lbls_breaks[1,] <- cumsum(c(nchar(paste(text.less.than[1], " ", sep = "")) + 1, nchar(text.less.than[2])+1)) } } - if (vec[n]==Inf) { + if (vec[n]==Inf) { if (length(text.or.more)==1) { - lbls_breaks[n-1,] <- rep(nchar(paste(x[n-1], " ", sep = "")) + 1, 2) + lbls_breaks[n-1,] <- rep(nchar(paste(x[n-1], " ", sep = "")) + 1, 2) } else { lbls_breaks[n-1,] <- cumsum(c(nchar(paste(x[n-1], " ", sep = "")) + 1, nchar(text.or.more[1])+1)) } - + } attr(lbls, "brks") <- lbls_breaks @@ -136,12 +136,12 @@ fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left", var = NULL) { - + # if (style %in% c("log10", "log10_pretty")) { # x <- log10(x) # style <- ifelse(style == "log10", "fixed", "pretty") # } - + nobs <- sum(!is.na(x)) # create intervals and assign colors if (style=="fixed") { @@ -164,7 +164,7 @@ num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left nunique <- length(na.omit(unique(x))) - + if (nunique == 1 && style!="pretty") { if (!is.null(var)) { warning("Single unique value found for the variable \"", var, "\", so style set to \"pretty\"", call. = FALSE) @@ -174,15 +174,15 @@ num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left } tempx <- nunique <= n - + if (tempx) { x_orig <- x if (length(na.omit(unique(x))) == 1) x <- pretty(x) x <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n + 1) } - - q <- suppressWarnings(classIntervals(x, n, style= style, intervalClosure=interval.closure)) - + + q <- suppressWarnings(classInt::classIntervals(x, n, style= style, intervalClosure=interval.closure)) + if (tempx) q$var <- x_orig } @@ -197,9 +197,9 @@ num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left brks <- q$brks # to prevent ugly rounded breaks such as -.5, .5, ..., 100.5 for n=101 - qm1 <- suppressWarnings(classIntervals(x, n-1, style= style, intervalClosure=interval.closure)) + qm1 <- suppressWarnings(classInt::classIntervals(x, n-1, style= style, intervalClosure=interval.closure)) brksm1 <- qm1$brks - qp1 <- suppressWarnings(classIntervals(x, n+1, style= style, intervalClosure=interval.closure)) + qp1 <- suppressWarnings(classInt::classIntervals(x, n+1, style= style, intervalClosure=interval.closure)) brksp1 <- qp1$brks if (min(brksm1) > min(brks) && max(brksm1) < max(brks)) { q <- qm1 From 9d0ce70d9672733a70a5d5fec9d0a123c23035c7 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Thu, 13 Feb 2020 10:44:53 +0000 Subject: [PATCH 04/44] fixed https://github.com/mtennekes/tmap/issues/391 --- R/bb.R | 54 +++++++++++++++++++++--------- R/read_osm.R | 94 +--------------------------------------------------- 2 files changed, 39 insertions(+), 109 deletions(-) diff --git a/R/bb.R b/R/bb.R index ea4ccc3..0a2181c 100755 --- a/R/bb.R +++ b/R/bb.R @@ -140,18 +140,22 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) # STEP 1: try to cut the bounding box, such that it is feasible (i.e. corresponding to lon between -180 and 180 and lat between -90 and 90) - earth_end <- suppressWarnings(bb_earth(projection=current.projection)) - - if (is.null(earth_end)) { - sf_poly2 <- sf_poly - } else { - sf_poly2 <- tryCatch({ - suppressMessages(sf::st_intersection(sf_poly, earth_end)) - }, error=function(e){ - sf_poly - }) - if (is.null(sf_poly2) || !inherits(sf_poly2, c("sf", "sfc")) || length(sf_poly2) == 0) sf_poly2 <- sf_poly - } + + sf_poly2 <- sf_poly + + + # earth_end <- suppressWarnings(bb_earth(projection=current.projection)) + # + # if (is.null(earth_end)) { + # sf_poly2 <- sf_poly + # } else { + # sf_poly2 <- tryCatch({ + # suppressMessages(sf::st_intersection(sf_poly, earth_end)) + # }, error=function(e){ + # sf_poly + # }) + # if (is.null(sf_poly2) || !inherits(sf_poly2, c("sf", "sfc")) || length(sf_poly2) == 0) sf_poly2 <- sf_poly + # } # STEP 2: Extract the bounding box corner points and add intermediate points, which can be needed since the exterme values may not be corner points once they are projected. Create a SpatialPoints objects from these points. co <- sf::st_coordinates(sf_poly2)[,1:2] @@ -170,11 +174,26 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N stop("Something went wrong with the bounding box. Please check the projection.", call.=FALSE) }) + + # STEP 3b: check dateline crossings + longs <- st_coordinates(sf_pnts2_prj)[,1] + if (any(longs < -150) && any(longs > 150) && !any(longs > -150 & longs < 150)) { + longs[longs < -150] <- longs[longs < -150] + 360 + sf_pnts2_prj[[1]][,1] <- longs + } + + sf_poly2_prj <- st_polygon(list(st_coordinates(sf_pnts2_prj)[,1:2])) + + # STEP 4: Get bounding box of reprojected object + #st_bbox((st_wrap_dateline(st_polygon(list(st_coordinates(sf_pnts2_prj)[,1:2]))))) + - b <- sf::st_bbox(sf_pnts2_prj) + + + b <- sf::st_bbox(sf_poly2_prj) is_prj <- !sf::st_is_longlat(projection) } else { is_prj <- if (is.na(current.projection)) { @@ -186,10 +205,13 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N - ## check if long lat coordinates are valid + ## check if lat coordinates are valid (long values may exceed the datetime boundary) if (!is_prj) { - b[1:2] <- pmax(b[1:2], c(-180, -90)) - b[3:4] <- pmin(b[3:4], c(180, 90)) + b[2] <- pmax(b[2], -90) + b[4] <- pmin(b[4], 90) + + # b[1:2] <- pmax(b[1:2], c(-180, -90)) + # b[3:4] <- pmin(b[3:4], c(180, 90)) } output <- match.arg(output) diff --git a/R/read_osm.R b/R/read_osm.R index 466d549..51f9b8f 100644 --- a/R/read_osm.R +++ b/R/read_osm.R @@ -46,99 +46,7 @@ read_osm <- function(x, zoom=NULL, type="osm", minNumTiles=NULL, mergeTiles=NULL optionalArgs <- optionalArgs[!sapply(optionalArgs, is.null)] om <- suppressWarnings({do.call("openmap", args = c(list(upperLeft=x[c(4,1)], lowerRight=x[c(2,3)]), optionalArgs))}) - omr <- raster::raster(om) - -# omr2 <- raster::raster(om) -# -# -# plot(omr2) -# -# -# all(omr2$layer.1[,] == cols[1,]) -# all(omr2$layer.2[,] == cols[2,]) -# -# cols <- col2rgb(om$tiles[[1]]$colorData) -# dimy <- om$tiles[[1]]$xres -# dimx <- om$tiles[[1]]$yres -# -# bbox <- unlist(om$tiles[[1]]$bbox)[c(1,3,4,2)] -# names(bbox) <- c("xmin", "xmax", "ymin", "ymax") -# -# bbx <- st_bbox(bbox, crs = sf::st_crs(attr((om$tiles[[1]]$projection), "projargs"))) -# -# -# stars::st_as_stars() -# -# red <- matrix(cols[1,], ncol = dimx, byrow = FALSE) -# dim(red) <- c(y = dimy, x = dimx) -# -# green <- matrix(cols[1,], ncol = dimx, byrow = FALSE) -# dim(green) <- c(y = dimy, x = dimx) -# -# blue <- matrix(cols[1,], ncol = dimx, byrow = FALSE) -# dim(blue) <- c(y = dimy, x = dimx) -# -# omr3 <- stars::st_as_stars(omr2) -# plot(omr3) -# -# -# a <- array(c(red, green, blue), dim = c(dim(red), 3)) -# dim(a) <- c(y = unname(nrow(red)), x = unname(ncol(red)), band = 3) -# -# omr4 <- stars::st_as_stars(list(a)) -# omr5 <- stars::st_as_stars(bbx, nx = dimx, ny = dimy) -# -# attr(omr4, "dimensions")[1:2] <- attr(omr5, "dimensions") -# -# attr(attr(omr4, "dimensions"), "raster") <- attr(attr(omr5, "dimensions"), "raster") -# -# -# plot(omr4) -# -# , dimensions = attr(stars::st_as_stars(bbx, nx = dimx, ny = dimy), "dimensions")) -# -# plot(omr4) -# -# plot(omr3) -# -# -# -# omr <- st_dimensions(stars::st_as_stars(bbx, nx = dimx, ny = dimy)) -# #attr(omr, "dimensions")[[2]]$delta = -1 -# -# plot(omr) -# -# omr <- st_as_stars(red) -# -# attr(omr, "dimensions") <- attr(omr3, "dimensions") -# -# plot(omr) -# -# -# -# st_dimensions(omr) -# -# stars::r -# -# str(attr(st_dimensions(omr), "raster")) -# -# plot(omr) -# -# m = matrix(1:6, ncol = 2) -# dim(m) = c(x = 3, y = 2) -# omr <- stars::st_as_stars(bbx, nx = 3, ny = 2, values = m) -# plot(omr) -# -# -# omr <- stars::st_as_stars(bbx) - - - # if (use.colortable) { - # tab <- raster_colors(raster::values(omr), use.colortable = TRUE) - # omr <- raster::raster(omr) - # omr <- raster::setValues(omr, as.integer(tab) - 1L) - # raster::colortable(omr) <- levels(tab) - # } + omr <- stars::st_as_stars(om) attr(omr, "leaflet.provider") <- unname(OSM2LP[type]) attr(omr, "is.OSM") <- TRUE From f923c591bb878cddccedd1f1bfe1ff20ee1310fc Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Mon, 24 Feb 2020 10:49:06 +0000 Subject: [PATCH 05/44] improved geocode_OSM --- DESCRIPTION | 8 ++++---- NEWS | 6 +++--- R/approx_distances.R | 6 +++++- R/bb.R | 8 ++++++-- R/geocode_OSM.R | 12 ++++++++---- R/simplify_shape.R | 2 +- man/bb.Rd | 18 ++++++++++++++---- man/bb_poly.Rd | 9 +++++++-- man/calc_densities.Rd | 10 ++++++++-- man/deprecated_functions.Rd | 17 ++++++++++++----- man/geocode_OSM.Rd | 17 +++++++++++++---- man/get_asp_ratio.Rd | 3 +-- man/get_brewer_pal.Rd | 3 +-- man/map_coloring.Rd | 12 +++++++++--- man/read_GPX.Rd | 9 ++++++--- man/read_osm.Rd | 12 ++++++++++-- man/rev_geocode_OSM.Rd | 10 ++++++++-- man/simplify_shape.Rd | 3 +-- sandbox/stars.R | 20 ++++++++++++++++++++ 19 files changed, 137 insertions(+), 48 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f1618d8..44c2526 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,14 +7,14 @@ Description: Set of tools for reading and processing spatial data. The aim is to License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-01-12 +Date: 2020-02-24 Depends: R (>= 3.0), methods Imports: - sf (>= 0.7-1), + sf (>= 0.8-2), lwgeom (>= 0.1-4), - stars, + stars (>= 0.4-1), units (>= 0.6-1), grid, raster (>= 2.7-15), @@ -36,4 +36,4 @@ Suggests: shinyjs URL: https://github.com/mtennekes/tmaptools BugReports: https://github.com/mtennekes/tmaptools/issues -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/NEWS b/NEWS index b1c162e..156cc4b 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,7 @@ -version 3 (devel) -- added bbox geometry column to output of geocode_OSM when as.sf = TRUE +version 3 +- geocode_OSM also returns a bounding box if as.sf=TRUE - removed hardcoded proj4 shortcuts -- stars support (being implemented) +- stars support version 2.0-2 - sp-based functions marked as deprecated diff --git a/R/approx_distances.R b/R/approx_distances.R index fcc4496..64311ca 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -12,7 +12,11 @@ #' @seealso \code{\link{approx_areas}} #' @export approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { - ## set metric and imperial to defaults: km and mi + + if (identical(projection, "longlat")) projection <- sf::st_crs(4326) # shortcut needed for tnap 2.x + + + ## set metric and imperial to defaults: km and mi if (!missing(target)) { is_metric <- target=="metric" is_imperial <- target=="imperial" diff --git a/R/bb.R b/R/bb.R index 0a2181c..e9c0f65 100755 --- a/R/bb.R +++ b/R/bb.R @@ -176,13 +176,17 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N # STEP 3b: check dateline crossings - longs <- st_coordinates(sf_pnts2_prj)[,1] + longs <- sf::st_coordinates(sf_pnts2_prj)[,1] if (any(longs < -150) && any(longs > 150) && !any(longs > -150 & longs < 150)) { longs[longs < -150] <- longs[longs < -150] + 360 sf_pnts2_prj[[1]][,1] <- longs } - sf_poly2_prj <- st_polygon(list(st_coordinates(sf_pnts2_prj)[,1:2])) + # close polygon (rounding errors may cause open polygons otherwise) + coords <- sf::st_coordinates(sf_pnts2_prj)[,1:2] + coords[nrow(coords), ] <- coords[1, ] + + sf_poly2_prj <- sf::st_polygon(list(coords)) # STEP 4: Get bounding box of reprojected object diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index ce2ed50..bd07e0c 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -7,18 +7,21 @@ #' @param return.first.only Only return the first result #' @param details provide output details, other than the point coordinates and bounding box #' @param as.data.frame Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}. -#' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}, where the latter is the default geometry. +#' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry. +#' @param geometry When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_set_geometry]{st_set_geometry}}. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. #' @return If \code{as.SPDF} then a \code{\link[sp:SpatialPointsDataFrame]{SpatialPointsDataFrame}} is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. #' @export #' @importFrom XML xmlChildren xmlRoot xmlAttrs xmlTreeParse xmlValue #' @example ./examples/geocode_OSM.R #' @seealso \code{\link{rev_geocode_OSM}}, \code{\link{bb}} -geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALSE, as.data.frame=NA, as.sf=FALSE, server="http://nominatim.openstreetmap.org") { - n <- length(q) +geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="http://nominatim.openstreetmap.org") { + n <- length(q) q2 <- gsub(" ", "+", enc2utf8(q), fixed = TRUE) addr <- paste0(server, "/search?q=", q2, "&format=xml&polygon=0&addressdetails=0") + geometry <- match.arg(geometry) + project <- !missing(projection) @@ -123,7 +126,8 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS res <- sf::st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat) } names(res)[names(res) == "geometry"] <- "point" - res <- sf::st_set_geometry(res, "point") + + if (geometry == "point") res <- sf::st_set_geometry(res, "point") sf::st_set_crs(res, .crs_longlat) } else { df diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 19cc32e..e9d1abe 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -49,7 +49,7 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS if (!requireNamespace("lwgeom", quietly = TRUE)) { stop("simplified shape is not valid and needs to be fixed; please install the lwgeom package and rerun this function", call. = FALSE) } - lwgeom::st_make_valid(x) + sf::st_make_valid(x) } else { x } diff --git a/man/bb.Rd b/man/bb.Rd index c5cf0db..f31bc0d 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -4,10 +4,20 @@ \alias{bb} \title{Bounding box generator} \usage{ -bb(x = NA, ext = NULL, cx = NULL, cy = NULL, width = NULL, - height = NULL, xlim = NULL, ylim = NULL, relative = FALSE, - current.projection = NULL, projection = NULL, output = c("bbox", - "matrix", "extent")) +bb( + x = NA, + ext = NULL, + cx = NULL, + cy = NULL, + width = NULL, + height = NULL, + xlim = NULL, + ylim = NULL, + relative = FALSE, + current.projection = NULL, + projection = NULL, + output = c("bbox", "matrix", "extent") +) } \arguments{ \item{x}{One of the following: diff --git a/man/bb_poly.Rd b/man/bb_poly.Rd index 76a0015..a223d57 100644 --- a/man/bb_poly.Rd +++ b/man/bb_poly.Rd @@ -7,8 +7,13 @@ \usage{ bb_poly(x, steps = 100, stepsize = NA, projection = NULL) -bb_earth(projection = NULL, stepsize = 1, earth.datum = 4326, - bbx = c(-180, -90, 180, 90), buffer = 1e-06) +bb_earth( + projection = NULL, + stepsize = 1, + earth.datum = 4326, + bbx = c(-180, -90, 180, 90), + buffer = 1e-06 +) } \arguments{ \item{x}{object that can be coerced to a bounding box with \code{\link{bb}}} diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index 3f4c8c9..6113d6b 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -4,8 +4,14 @@ \alias{calc_densities} \title{Calculate densities} \usage{ -calc_densities(shp, var, target = "metric", total.area = NULL, - suffix = NA, drop = TRUE) +calc_densities( + shp, + var, + target = "metric", + total.area = NULL, + suffix = NA, + drop = TRUE +) } \arguments{ \item{shp}{a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} diff --git a/man/deprecated_functions.Rd b/man/deprecated_functions.Rd index dd61bee..9f36dee 100644 --- a/man/deprecated_functions.Rd +++ b/man/deprecated_functions.Rd @@ -10,11 +10,18 @@ \usage{ get_proj4(x, output = c("crs", "character", "epsg", "CRS")) -set_projection(shp, projection = NA, current.projection = NA, - overwrite.current.projection = FALSE) - -get_projection(shp, guess.longlat = FALSE, output = c("character", - "crs", "epsg", "CRS")) +set_projection( + shp, + projection = NA, + current.projection = NA, + overwrite.current.projection = FALSE +) + +get_projection( + shp, + guess.longlat = FALSE, + output = c("character", "crs", "epsg", "CRS") +) is_projected(x) } diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index 7b5cba0..ca52772 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -4,9 +4,16 @@ \alias{geocode_OSM} \title{Geocodes a location using OpenStreetMap Nominatim} \usage{ -geocode_OSM(q, projection = NULL, return.first.only = TRUE, - details = FALSE, as.data.frame = NA, as.sf = FALSE, - server = "http://nominatim.openstreetmap.org") +geocode_OSM( + q, + projection = NULL, + return.first.only = TRUE, + details = FALSE, + as.data.frame = NA, + as.sf = FALSE, + geometry = c("point", "bbox"), + server = "http://nominatim.openstreetmap.org" +) } \arguments{ \item{q}{a character (vector) that specifies a search query. For instance \code{"India"} or \code{"CBS Weg 11, Heerlen, Netherlands"}.} @@ -19,7 +26,9 @@ geocode_OSM(q, projection = NULL, return.first.only = TRUE, \item{as.data.frame}{Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}.} -\item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}, where the latter is the default geometry.} +\item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry.} + +\item{geometry}{When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_set_geometry]{st_set_geometry}}.} \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } diff --git a/man/get_asp_ratio.Rd b/man/get_asp_ratio.Rd index ec63e1a..4c2ca3e 100644 --- a/man/get_asp_ratio.Rd +++ b/man/get_asp_ratio.Rd @@ -4,8 +4,7 @@ \alias{get_asp_ratio} \title{Get aspect ratio} \usage{ -get_asp_ratio(x, is.projected = NA, width = 700, height = 700, - res = 100) +get_asp_ratio(x, is.projected = NA, width = 700, height = 700, res = 100) } \arguments{ \item{x}{shape object (either \code{\link[sp:Spatial]{Spatial}}, a \code{\link[raster:Raster-class]{Raster}}, or an \code{\link[sf:sf]{sf}}), a bounding box (that can be coerced by \code{\link{bb}}), or a \code{\link[tmap:tmap-element]{tmap}} object.} diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd index 00ba099..8ce264f 100644 --- a/man/get_brewer_pal.Rd +++ b/man/get_brewer_pal.Rd @@ -4,8 +4,7 @@ \alias{get_brewer_pal} \title{Get and plot a (modified) Color Brewer palette} \usage{ -get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, - plot = TRUE) +get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) } \arguments{ \item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} (or \code{\link[RColorBrewer:display.brewer.pal]{display.brewer.pal}}) for options.} diff --git a/man/map_coloring.Rd b/man/map_coloring.Rd index 3d955bd..ba09ef8 100644 --- a/man/map_coloring.Rd +++ b/man/map_coloring.Rd @@ -4,8 +4,14 @@ \alias{map_coloring} \title{Map coloring} \usage{ -map_coloring(x, algorithm = "greedy", ncols = NA, minimize = FALSE, - palette = NULL, contrast = 1) +map_coloring( + x, + algorithm = "greedy", + ncols = NA, + minimize = FALSE, + palette = NULL, + contrast = 1 +) } \arguments{ \item{x}{Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}} object), or an adjacency list.} @@ -43,7 +49,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { tm_shape(NLD_prov) + tm_borders(lwd=2) + tm_text("name", shadow=TRUE) + - tm_format("NLD", title="Dutch provinces and\\nmunicipalities", bg.color="white") + tm_format("NLD", title="Dutch provinces and\nmunicipalities", bg.color="white") } } diff --git a/man/read_GPX.Rd b/man/read_GPX.Rd index 2a73e65..449101a 100644 --- a/man/read_GPX.Rd +++ b/man/read_GPX.Rd @@ -4,9 +4,12 @@ \alias{read_GPX} \title{Read GPX file} \usage{ -read_GPX(file, layers = c("waypoints", "routes", "tracks", - "route_points", "track_points"), remove.empty.layers = TRUE, - as.sf = TRUE) +read_GPX( + file, + layers = c("waypoints", "routes", "tracks", "route_points", "track_points"), + remove.empty.layers = TRUE, + as.sf = TRUE +) } \arguments{ \item{file}{a GPX filename (including directory)} diff --git a/man/read_osm.Rd b/man/read_osm.Rd index 291792d..65477fd 100644 --- a/man/read_osm.Rd +++ b/man/read_osm.Rd @@ -4,8 +4,16 @@ \alias{read_osm} \title{Read Open Street Map data} \usage{ -read_osm(x, zoom = NULL, type = "osm", minNumTiles = NULL, - mergeTiles = NULL, use.colortable = FALSE, raster, ...) +read_osm( + x, + zoom = NULL, + type = "osm", + minNumTiles = NULL, + mergeTiles = NULL, + use.colortable = FALSE, + raster, + ... +) } \arguments{ \item{x}{object that can be coerced to a bounding box with \code{\link{bb}} (e.g. an existing bounding box or a shape). In the first case, other arguments can be passed on to \code{\link{bb}} (see \code{...}). If an existing bounding box is specified in projected coordinates, plesae specify \code{current.projection}.} diff --git a/man/rev_geocode_OSM.Rd b/man/rev_geocode_OSM.Rd index c40e924..9ee336b 100644 --- a/man/rev_geocode_OSM.Rd +++ b/man/rev_geocode_OSM.Rd @@ -4,8 +4,14 @@ \alias{rev_geocode_OSM} \title{Reverse geocodes a location using OpenStreetMap Nominatim} \usage{ -rev_geocode_OSM(x, y = NULL, zoom = NULL, projection = 4326, - as.data.frame = NA, server = "http://nominatim.openstreetmap.org") +rev_geocode_OSM( + x, + y = NULL, + zoom = NULL, + projection = 4326, + as.data.frame = NA, + server = "http://nominatim.openstreetmap.org" +) } \arguments{ \item{x}{x coordinate(s), or a spatial points object (\code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPoints]{SpatialPoints}})} diff --git a/man/simplify_shape.Rd b/man/simplify_shape.Rd index 8b74979..38e6023 100644 --- a/man/simplify_shape.Rd +++ b/man/simplify_shape.Rd @@ -4,8 +4,7 @@ \alias{simplify_shape} \title{Simplify shape} \usage{ -simplify_shape(shp, fact = 0.1, keep.units = FALSE, - keep.subunits = FALSE, ...) +simplify_shape(shp, fact = 0.1, keep.units = FALSE, keep.subunits = FALSE, ...) } \arguments{ \item{shp}{an \code{\link[sf:sf]{sf}} object.} diff --git a/sandbox/stars.R b/sandbox/stars.R index faad237..12f4f4b 100644 --- a/sandbox/stars.R +++ b/sandbox/stars.R @@ -23,11 +23,31 @@ bbx <- st_bbox(bbx_coor, crs = crs) x2 <- raster::raster(x) x3 <- st_as_stars(x2) +st_dimensions(x3) + plot(x3) # methode 2: array method x4 <- st_as_stars(a) + +plot(x4) + +st_dimensions(x4) + +x5 <- x4 %>% + st_set_crs(crs) %>% + st_set_dimensions("x", + offset = bbx["xmin"], + delta = (bbx["xmax"] - bbx["xmin"]) / ncols) %>% + st_set_dimensions("y", + offset = bbx["ymin"], + delta = (bbx["ymin"] - bbx["ymax"]) / nrows) + + + + + attr(x4, "dimensions")[[2]]$delta <- -1 plot(x4) From 7a61849cfbc346d4c7ee050a54ecc71f817676c4 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Mon, 24 Feb 2020 16:40:29 +0000 Subject: [PATCH 06/44] updated travis --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index d4c11e1..b047f71 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,6 +10,9 @@ cache: - ccache latex: false +r_github_packages: + - r-spatial/sf + addons: postgresql: "9.6" apt: From 8506dc52215abce20b1ea5d585fc1df424458464 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Mon, 24 Feb 2020 16:52:10 +0000 Subject: [PATCH 07/44] travis/tic --- .travis.yml | 3 --- tic.R | 3 ++- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index b047f71..d4c11e1 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,9 +10,6 @@ cache: - ccache latex: false -r_github_packages: - - r-spatial/sf - addons: postgresql: "9.6" apt: diff --git a/tic.R b/tic.R index fa6266c..cfc057b 100644 --- a/tic.R +++ b/tic.R @@ -2,7 +2,8 @@ add_package_checks() get_stage("install") %>% # install lwgeom with its own library since linking again postgis source install fails sometimes - add_code_step(install.packages("lwgeom", configure.args="--without-liblwgeom")) %>% + add_code_step(remotes::install_github("r-spatial/sf")) %>% + add_code_step(install.packages("lwgeom", configure.args="--without-liblwgeom")) %>% add_code_step(remotes::install_github("mtennekes/tmaptools")) %>% add_code_step(remotes::install_github("mtennekes/tmap")) From d66678d7bae1fe3bfb679c240a86a82916cc5688 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 24 Mar 2020 09:19:18 +0100 Subject: [PATCH 08/44] revert version requirements sf stars --- DESCRIPTION | 4 ++-- NAMESPACE | 1 + R/approx_areas.R | 2 +- R/simplify_shape.R | 2 +- 4 files changed, 5 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 44c2526..206a5d3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,9 +12,9 @@ Depends: R (>= 3.0), methods Imports: - sf (>= 0.8-2), + sf (>= 0.8-1), lwgeom (>= 0.1-4), - stars (>= 0.4-1), + stars (>= 0.4-0), units (>= 0.6-1), grid, raster (>= 2.7-15), diff --git a/NAMESPACE b/NAMESPACE index 1592d5f..3ce075a 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ importFrom(grDevices,dev.off) importFrom(grDevices,png) importFrom(grDevices,rgb) importFrom(lwgeom,st_geod_area) +importFrom(lwgeom,st_make_valid) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") importFrom(methods,as) diff --git a/R/approx_areas.R b/R/approx_areas.R index 90c9bb0..14b700f 100755 --- a/R/approx_areas.R +++ b/R/approx_areas.R @@ -18,7 +18,7 @@ #' @example ./examples/approx_areas.R #' @seealso \code{\link{approx_distances}} #' @importFrom units set_units as_units -#' @importFrom lwgeom st_transform_proj st_geod_area +#' @importFrom lwgeom st_transform_proj st_geod_area st_make_valid #' @export approx_areas <- function(shp, target="metric", total.area=NULL) { is_metric <- target=="metric" diff --git a/R/simplify_shape.R b/R/simplify_shape.R index e9d1abe..19cc32e 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -49,7 +49,7 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS if (!requireNamespace("lwgeom", quietly = TRUE)) { stop("simplified shape is not valid and needs to be fixed; please install the lwgeom package and rerun this function", call. = FALSE) } - sf::st_make_valid(x) + lwgeom::st_make_valid(x) } else { x } From b6880f4fae5513f6856f732ffc759b08a1884158 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 24 Mar 2020 10:54:19 +0100 Subject: [PATCH 09/44] bb: using bb_earth for empty polygons --- R/bb.R | 22 +++++++++++++++++++--- tic.R | 6 +++--- 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/R/bb.R b/R/bb.R index e9c0f65..40cd7ae 100755 --- a/R/bb.R +++ b/R/bb.R @@ -139,9 +139,25 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) - # STEP 1: try to cut the bounding box, such that it is feasible (i.e. corresponding to lon between -180 and 180 and lat between -90 and 90) - - sf_poly2 <- sf_poly + # STEP 1: check if poly can be reprojected, and if not, cut the bounding box such that lon between -180 and 180 and lat between -90 and 90 + + #sf_poly2 <- sf_poly + sf_poly_prj <- sf::st_transform(sf_poly, crs = projection) + if (!inherits(sf_poly_prj, "sfc_POLYGON") || sf::st_is_empty(sf_poly_prj)) { + earth_end <- suppressWarnings(bb_earth(projection=current.projection)) + if (is.null(earth_end)) { + sf_poly2 <- sf_poly + } else { + sf_poly2 <- tryCatch({ + suppressMessages(sf::st_intersection(sf_poly, earth_end)) + }, error=function(e){ + sf_poly + }) + if (is.null(sf_poly2) || !inherits(sf_poly2, c("sf", "sfc")) || length(sf_poly2) == 0) sf_poly2 <- sf_poly + } + } else { + sf_poly2 <- sf_poly + } # earth_end <- suppressWarnings(bb_earth(projection=current.projection)) diff --git a/tic.R b/tic.R index cfc057b..35e3e2f 100644 --- a/tic.R +++ b/tic.R @@ -3,9 +3,9 @@ add_package_checks() get_stage("install") %>% # install lwgeom with its own library since linking again postgis source install fails sometimes add_code_step(remotes::install_github("r-spatial/sf")) %>% - add_code_step(install.packages("lwgeom", configure.args="--without-liblwgeom")) %>% - add_code_step(remotes::install_github("mtennekes/tmaptools")) %>% - add_code_step(remotes::install_github("mtennekes/tmap")) + add_code_step(install.packages("lwgeom", configure.args="--without-liblwgeom"))# %>% + #add_code_step(remotes::install_github("mtennekes/tmaptools")) %>% + #add_code_step(remotes::install_github("mtennekes/tmap")) ### # deploy pkgdowm site From 7023a3204b4f9b1ac88c4c214d434f698fe97d96 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 24 Mar 2020 15:54:49 +0100 Subject: [PATCH 10/44] fixed bb with crs = NA --- R/bb.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/bb.R b/R/bb.R index 40cd7ae..b7ac0b2 100755 --- a/R/bb.R +++ b/R/bb.R @@ -304,8 +304,8 @@ get_bb <- function(x, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim if (is.null(current.projection)) current.projection <- sf::st_crs(NA) if (!is.na(current.projection)) { attr(b, "crs") <- current.projection - } else if (!is.na(attr(b, "crs"))) { - current.projection <- attr(b, "crs") + } else if (!is.na(sf::st_crs(b))) { + current.projection <- sf::st_crs(b) } list(b=b, From 7b3354fd533bd1f5cb6437e271910a67a187dbab Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 25 Mar 2020 08:54:43 +0100 Subject: [PATCH 11/44] updated DESCRIPTION, moved st_make_valid to sf again. --- DESCRIPTION | 6 +++--- NAMESPACE | 1 - R/approx_areas.R | 2 +- R/simplify_shape.R | 5 +---- man/palette_explorer.Rd | 4 +++- 5 files changed, 8 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 206a5d3..f41660b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,12 +7,12 @@ Description: Set of tools for reading and processing spatial data. The aim is to License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-02-24 +Date: 2020-03-25 Depends: R (>= 3.0), methods Imports: - sf (>= 0.8-1), + sf (>= 0.9), lwgeom (>= 0.1-4), stars (>= 0.4-0), units (>= 0.6-1), @@ -36,4 +36,4 @@ Suggests: shinyjs URL: https://github.com/mtennekes/tmaptools BugReports: https://github.com/mtennekes/tmaptools/issues -RoxygenNote: 7.0.2 +RoxygenNote: 7.1.0 diff --git a/NAMESPACE b/NAMESPACE index 3ce075a..1592d5f 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,7 +37,6 @@ importFrom(grDevices,dev.off) importFrom(grDevices,png) importFrom(grDevices,rgb) importFrom(lwgeom,st_geod_area) -importFrom(lwgeom,st_make_valid) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") importFrom(methods,as) diff --git a/R/approx_areas.R b/R/approx_areas.R index 14b700f..90c9bb0 100755 --- a/R/approx_areas.R +++ b/R/approx_areas.R @@ -18,7 +18,7 @@ #' @example ./examples/approx_areas.R #' @seealso \code{\link{approx_distances}} #' @importFrom units set_units as_units -#' @importFrom lwgeom st_transform_proj st_geod_area st_make_valid +#' @importFrom lwgeom st_transform_proj st_geod_area #' @export approx_areas <- function(shp, target="metric", total.area=NULL) { is_metric <- target=="metric" diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 19cc32e..1d3cf85 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -46,10 +46,7 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS } if (!all(sf::st_is_valid(x))) { - if (!requireNamespace("lwgeom", quietly = TRUE)) { - stop("simplified shape is not valid and needs to be fixed; please install the lwgeom package and rerun this function", call. = FALSE) - } - lwgeom::st_make_valid(x) + sf::st_make_valid(x) } else { x } diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index b29889a..9718084 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -5,7 +5,9 @@ \alias{palette_explorer} \alias{tmap.pal.info} \title{Explore color palettes} -\format{An object of class \code{data.frame} with 40 rows and 4 columns.} +\format{ +An object of class \code{data.frame} with 40 rows and 4 columns. +} \usage{ palette_explorer() From 517826294da702fc1e91849e2d6e8684b7c6c30a Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Mon, 30 Mar 2020 16:12:06 +0200 Subject: [PATCH 12/44] submitted to CRAN (3.0) --- DESCRIPTION | 2 +- NEWS | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f41660b..f02e51b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,7 @@ Description: Set of tools for reading and processing spatial data. The aim is to License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-03-25 +Date: 2020-03-30 Depends: R (>= 3.0), methods diff --git a/NEWS b/NEWS index 156cc4b..a09130e 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,7 @@ -version 3 -- geocode_OSM also returns a bounding box if as.sf=TRUE -- removed hardcoded proj4 shortcuts +version 3.0 - stars support +- removed hardcoded proj4 shortcuts +- geocode_OSM also returns a bounding box if as.sf=TRUE version 2.0-2 - sp-based functions marked as deprecated From adbf1da21ffadf4ce8270c91237f924351b24e4f Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 21 Apr 2020 09:45:37 +0200 Subject: [PATCH 13/44] added asp.limit --- DESCRIPTION | 10 +++++----- NEWS | 3 +++ R/bb.R | 22 +++++++++++++++++++++- man/bb.Rd | 3 +++ 4 files changed, 32 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f02e51b..e553bbe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 3.0 +Version: 3.0-1 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 @@ -9,12 +9,12 @@ Encoding: UTF-8 LazyData: true Date: 2020-03-30 Depends: - R (>= 3.0), + R (>= 3.5), methods Imports: - sf (>= 0.9), + sf (>= 0.9.2), lwgeom (>= 0.1-4), - stars (>= 0.4-0), + stars (>= 0.4-1), units (>= 0.6-1), grid, raster (>= 2.7-15), @@ -27,7 +27,7 @@ Imports: dichromat, XML Suggests: - tmap (>= 2.2), + tmap (>= 3.0), rmapshaper, osmdata, OpenStreetMap, diff --git a/NEWS b/NEWS index a09130e..c3a9633 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,6 @@ +version 3.0-1 +- bb takes asp.limit argumentm which controls the maximum aspect ratio + version 3.0 - stars support - removed hardcoded proj4 shortcuts diff --git a/R/bb.R b/R/bb.R index b7ac0b2..73e1a01 100755 --- a/R/bb.R +++ b/R/bb.R @@ -29,6 +29,7 @@ #' @param xlim limits of the x-axis. These are either absolute or relative (depending on the argument \code{relative}). #' @param ylim limits of the y-axis. See \code{xlim}. #' @param relative boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}. +#' @param asp.limit maximum aspect ratio, which is width/height. Number greater than or equal to 1. For landscape bounding boxes, \code{1/asp.limit} will be used. The returned bounding box will have an aspect ratio between \code{1/asp.limit} and \code{asp.limit}. #' @param current.projection projection that corresponds to the bounding box specified by \code{x}. #' @param projection projection to transform the bounding box to. #' @param output output format of the bounding box, one of: @@ -43,7 +44,7 @@ #' @example ./examples/bb.R #' @seealso \code{\link{geocode_OSM}} #' @export -bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim=NULL, relative = FALSE, current.projection=NULL, projection=NULL, output = c("bbox", "matrix", "extent")) { +bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim=NULL, relative = FALSE, asp.limit = NULL, current.projection=NULL, projection=NULL, output = c("bbox", "matrix", "extent")) { # check projections if (!is.null(current.projection)) current.projection <- sf::st_crs(current.projection) @@ -234,6 +235,25 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N # b[3:4] <- pmin(b[3:4], c(180, 90)) } + + ## limit aspect ratio + if (!is.null(asp.limit)) { + bbh <- unname(b[4] - b[2]) + bbw <- unname(b[3] - b[1]) + if (bbh < 1e-8 || bbh < (bbw / asp.limit)) { + # increase height such that aspect ratio is at most 10. Use lowerbound of 1 for height. + cy <- (b[2] + b[4]) / 2 + b[2] <- cy - max(bbw / (asp.limit * 2), .5) + b[4] <- cy + max(bbw / (asp.limit * 2), .5) + } + if (bbw < 1e-8 || bbw < (bbh / asp.limit)) { + # increase width such that aspect ratio is at least 1/10. Use lowerbound of 1 for width. + cx <- (b[1] + b[3]) / 2 + b[1] <- cx - max(bbh / (asp.limit * 2), .5) + b[3] <- cx + max(bbh / (asp.limit * 2), .5) + } + } + output <- match.arg(output) if (output == "bbox") { diff --git a/man/bb.Rd b/man/bb.Rd index f31bc0d..c92f4aa 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -14,6 +14,7 @@ bb( xlim = NULL, ylim = NULL, relative = FALSE, + asp.limit = NULL, current.projection = NULL, projection = NULL, output = c("bbox", "matrix", "extent") @@ -43,6 +44,8 @@ If \code{x} is not specified, a bounding box can be created from scratch (see de \item{relative}{boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}.} +\item{asp.limit}{maximum aspect ratio, which is width/height. Number greater than or equal to 1. For landscape bounding boxes, \code{1/asp.limit} will be used. The returned bounding box will have an aspect ratio between \code{1/asp.limit} and \code{asp.limit}.} + \item{current.projection}{projection that corresponds to the bounding box specified by \code{x}.} \item{projection}{projection to transform the bounding box to.} From 1a402139259ae1d10f60ea6f59506bf82c6367cf Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Fri, 1 May 2020 00:09:29 +0200 Subject: [PATCH 14/44] fixed https://github.com/mtennekes/tmap/issues/431 --- R/bb.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/bb.R b/R/bb.R index 73e1a01..385cece 100755 --- a/R/bb.R +++ b/R/bb.R @@ -144,7 +144,7 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N #sf_poly2 <- sf_poly sf_poly_prj <- sf::st_transform(sf_poly, crs = projection) - if (!inherits(sf_poly_prj, "sfc_POLYGON") || sf::st_is_empty(sf_poly_prj)) { + if (!inherits(sf_poly_prj, "sfc_POLYGON") || (nrow(st_coordinates(sf_poly_prj)) < 4L) || sf::st_is_empty(sf_poly_prj)) { earth_end <- suppressWarnings(bb_earth(projection=current.projection)) if (is.null(earth_end)) { sf_poly2 <- sf_poly From 4f1e503503687ab54c63e9447c27a854a571ec62 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Fri, 1 May 2020 15:14:36 +0200 Subject: [PATCH 15/44] ... --- R/bb.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/bb.R b/R/bb.R index 385cece..2890ec4 100755 --- a/R/bb.R +++ b/R/bb.R @@ -144,7 +144,7 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N #sf_poly2 <- sf_poly sf_poly_prj <- sf::st_transform(sf_poly, crs = projection) - if (!inherits(sf_poly_prj, "sfc_POLYGON") || (nrow(st_coordinates(sf_poly_prj)) < 4L) || sf::st_is_empty(sf_poly_prj)) { + if (!inherits(sf_poly_prj, "sfc_POLYGON") || (nrow(sf::st_coordinates(sf_poly_prj)) < 4L) || sf::st_is_empty(sf_poly_prj)) { earth_end <- suppressWarnings(bb_earth(projection=current.projection)) if (is.null(earth_end)) { sf_poly2 <- sf_poly From 5d326a2e361630c874fbdbd7b43f8d741f6b4d66 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Mon, 4 May 2020 12:39:28 +0200 Subject: [PATCH 16/44] synced xxx_scales --- .travis.yml | 41 ++++------ R/xxx_scales.R | 205 ------------------------------------------------- 2 files changed, 17 insertions(+), 229 deletions(-) diff --git a/.travis.yml b/.travis.yml index d4c11e1..49c267b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,47 +3,42 @@ language: r r: - release +deploy.skip_cleanup: true + sudo: required dist: trusty cache: - packages - ccache + latex: false addons: - postgresql: "9.6" apt: sources: - sourceline: 'ppa:opencpu/jq' - sourceline: 'ppa:ubuntugis/ubuntugis-unstable' packages: - - libprotobuf-dev - - protobuf-compiler + - libgdal-dev + - libgeos-dev + - libproj-dev + - libudunits2-dev - libv8-dev - libjq-dev - - libudunits2-dev - - libproj-dev - - libgeos-dev - - libgdal-dev + - libprotobuf-dev + - protobuf-compiler + - libssl-dev + - libcairo2-dev + - libnetcdf-dev + - netcdf-bin - libjson-c-dev - - postgresql-server-dev-9.6 before_install: - # install postgis from source (required for lwgeom installation): - - wget http://download.osgeo.org/postgis/source/postgis-2.4.4.tar.gz - - (mv postgis* /tmp; cd /tmp; tar xzf postgis-2.4.4.tar.gz) - - (cd /tmp/postgis-2.4.4 ; ./configure; make; sudo make install) - # create postgis databases: - - sudo service postgresql restart - - createdb postgis - - psql -d postgis -c "CREATE EXTENSION postgis;" - - psql -d postgis -c "GRANT CREATE ON DATABASE postgis TO travis" - - createdb empty - - psql -d empty -c "CREATE EXTENSION postgis;" - - R -q -e 'install.packages("remotes"); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages(); tic::before_install()' + - R -e 'install.packages("rgdal", repos="http://R-Forge.R-project.org")' + - R -q -e 'install.packages("remotes"); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages()' + install: R -q -e 'tic::install()' script: R -q -e 'tic::script()' - before_deploy: R -q -e 'tic::before_deploy()' deploy: provider: script @@ -55,6 +50,4 @@ deploy: - $TRAVIS_EVENT_TYPE != cron - $TRAVIS_R_VERSION_STRING = release -after_success: - - R -q -e 'tic::after_success()' - - R -q -e 'covr::codecov(quiet = FALSE)' +after_success: R -q -e 'tic::after_success()' diff --git a/R/xxx_scales.R b/R/xxx_scales.R index 5918323..015e3a1 100644 --- a/R/xxx_scales.R +++ b/R/xxx_scales.R @@ -6,211 +6,6 @@ are_breaks_diverging <- function(brks) { negb && posb } -fancy_breaks <- function(vec, intervals=FALSE, interval.closure="left", fun=NULL, scientific=FALSE, big.num.abbr = c("mln" = 6, "bln" = 9), prefix = "", suffix = "", text.separator="to", text.less.than=c("less", "than"), text.or.more=c("or", "more"), text.align="left", text.to.columns=FALSE, digits=NA, ...) { - args <- list(...) - n <- length(vec) - - if (!is.null(fun)) { - x <- do.call(fun, list(vec)) - } else { - ### analyse the numeric vector - if (all(is.infinite(vec))) { - x <- as.character(vec) - } else { - vec_fin <- unique(vec[!is.infinite(vec)]) - frm <- gsub(" ", "", sprintf("%20.10f", abs(vec_fin))) - - # get width before decimal point - #if (length(frm)==0) browser() - mag <- max(nchar(frm)-11) - - # get number of decimals (which is number of decimals in vec, which is reduced when mag is large) - ndec <- max(10 - nchar(frm) + nchar(sub("0+$","",frm))) - if (is.na(digits)) { - digits <- max(min(ndec, 4-mag), 0) - - # add sign to frm - frm_sign <- paste0(ifelse(vec_fin<0, "-", "+"), frm) - - # test if number of digits is sufficient for unique labels - if (!scientific) { - while (anyDuplicated(substr(frm_sign, 1, nchar(frm_sign)-10 + digits)) && (digits < 10)) { - digits <- digits + 1 - } - } - - } - - if (!scientific) { - - # check whether big number abbrevations should be used - ext <- "" - if (!is.na(big.num.abbr[1])) { - big.num.abbr <- sort(big.num.abbr, decreasing = TRUE) - for (i in 1:length(big.num.abbr)) { - o <- unname(big.num.abbr[i]) - if (mag>(o+2) || (mag > o && all(vec - floor(vec/(10^o))*(10^o) < 1))) { - vec <- vec / (10^o) - ext <- paste0(" ", names(big.num.abbr)[i]) - break - } - } - } - - - - - # if (mag>11 || (mag > 9 && all(vec - floor(vec/1e9)*1e9 < 1))) { - # vec <- vec / 1e9 - # ext <- " bln" - # } else if (mag > 8 || (mag > 6 && all(vec - floor(vec/1e6)*1e6 < 1))) { - # vec <- vec / 1e6 - # ext <- " mln" - # } else { - # ext <- "" - # } - - # set default values - if (!("big.mark" %in% names(args))) args$big.mark <- "," - if (!("format" %in% names(args))) args$format <- "f" - if (!("preserve.width" %in% names(args))) args$preserve.width <- "none" - x <- paste(do.call("formatC", c(list(x=vec, digits=digits), args)), ext, sep="") - x <- paste0(prefix, x, suffix) - } else { - if (!("format" %in% names(args))) args$format <- "g" - x <- do.call("formatC", c(list(x=vec, digits=digits), args)) - } - } - } - - if (intervals) { - if (scientific) { - if (interval.closure=="left") { - lbls <- paste("[", x[-n], ", ", x[-1], ")", sep="") - lbls[n-1] <- paste(substr(lbls[n-1], 1, nchar(lbls[n-1])-1), "]", sep="") - } else { - lbls <- paste("(", x[-n], ", ", x[-1], "]", sep="") - lbls[1] <- paste("[", substr(lbls[1], 2, nchar(lbls[1])), sep="") - } - } else { - x[vec==-Inf] <- "" - - lbls <- paste(x[-n], x[-1], sep = paste0(" ", text.separator, " ")) - if (vec[1]==-Inf) lbls[1] <- paste(paste(text.less.than, collapse = " "), x[2], sep = " ") - if (vec[n]==Inf) lbls[n-1] <- paste(x[n-1], paste(text.or.more, collapse = " "), sep = " ") - - if (text.to.columns) { - #xtra <- as.numeric(!is.na(text.align) && text.align=="right") - - - nc1 <- nchar(paste(x[-n], " ", sep = "")) + 1 - nc2 <- rep(nchar(paste(text.separator, " ", sep = "")), n-1) - - lbls_breaks <- matrix(c(nc1, nc1+nc2), ncol=2) - - if (vec[1]==-Inf) { - if (length(text.less.than)==1) { - lbls_breaks[1,] <- rep(nchar(paste(text.less.than[1], " ", sep = "")) + 1, 2) - } else { - lbls_breaks[1,] <- cumsum(c(nchar(paste(text.less.than[1], " ", sep = "")) + 1, nchar(text.less.than[2])+1)) - } - } - if (vec[n]==Inf) { - if (length(text.or.more)==1) { - lbls_breaks[n-1,] <- rep(nchar(paste(x[n-1], " ", sep = "")) + 1, 2) - } else { - lbls_breaks[n-1,] <- cumsum(c(nchar(paste(x[n-1], " ", sep = "")) + 1, nchar(text.or.more[1])+1)) - } - - } - - attr(lbls, "brks") <- lbls_breaks - } - } - } - - y <- if (intervals) lbls else x - attr(y, "align") <- text.align - y -} - - -num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left", var = NULL) { - - # if (style %in% c("log10", "log10_pretty")) { - # x <- log10(x) - # style <- ifelse(style == "log10", "fixed", "pretty") - # } - - nobs <- sum(!is.na(x)) - # create intervals and assign colors - if (style=="fixed") { - q <- list(var=x, - brks=breaks) - if (any(na.omit(x) < min(breaks))) warning("Values have found that are less than the lowest break", call. = FALSE) - if (any(na.omit(x) > max(breaks))) warning("Values have found that are higher than the highest break", call. = FALSE) - attr(q, "style") <- "fixed" - attr(q, "nobs") <- nobs - attr(q, "intervalClosure") <- interval.closure - class(q) <- "classIntervals" - } else { - if (nobs==0) { - if (!is.null(var)) { - stop("Numerical variable \"", var, "\" only contains missing values.", call.=FALSE) - } else { - stop("Numerical variable only contains missing values.", call.=FALSE) - } - } - - nunique <- length(na.omit(unique(x))) - - - if (nunique == 1 && style!="pretty") { - if (!is.null(var)) { - warning("Single unique value found for the variable \"", var, "\", so style set to \"pretty\"", call. = FALSE) - } else { - warning("Single unique value found, so style set to \"pretty\"", call. = FALSE) - } - } - - tempx <- nunique <= n - - if (tempx) { - x_orig <- x - if (length(na.omit(unique(x))) == 1) x <- pretty(x) - x <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n + 1) - } - - q <- suppressWarnings(classInt::classIntervals(x, n, style= style, intervalClosure=interval.closure)) - - if (tempx) q$var <- x_orig - - } - - if (approx && style != "fixed") { - if (n >= length(unique(x)) && style=="equal") { - # to prevent classIntervals to set style to "unique" - q <- list(var=x, brks=seq(min(x, na.rm=TRUE), max(x, na.rm=TRUE), length.out=n)) - attr(q, "intervalClosure") <- interval.closure - class(q) <- "classIntervals" - } else { - brks <- q$brks - - # to prevent ugly rounded breaks such as -.5, .5, ..., 100.5 for n=101 - qm1 <- suppressWarnings(classInt::classIntervals(x, n-1, style= style, intervalClosure=interval.closure)) - brksm1 <- qm1$brks - qp1 <- suppressWarnings(classInt::classIntervals(x, n+1, style= style, intervalClosure=interval.closure)) - brksp1 <- qp1$brks - if (min(brksm1) > min(brks) && max(brksm1) < max(brks)) { - q <- qm1 - } else if (min(brksp1) > min(brks) && max(brksp1) < max(brks)) { - q <- qp1 - } - } - } - q -} - # Map breaks to index numbers of a diverging colour scale # From 9c254aa412af810c5bb4d0b1cd64317a3ca3fd7a Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 13 May 2020 09:24:48 +0200 Subject: [PATCH 17/44] improved geocode_OSM (no results) --- NEWS | 3 ++- R/bb.R | 4 ++-- R/geocode_OSM.R | 4 +++- man/bb.Rd | 4 ++-- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index c3a9633..92c6175 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,6 @@ version 3.0-1 -- bb takes asp.limit argumentm which controls the maximum aspect ratio +- bb takes asp.limit argument which controls the maximum aspect ratio +- improved geocode_OSM when no results are found version 3.0 - stars support diff --git a/R/bb.R b/R/bb.R index 2890ec4..bf1f194 100755 --- a/R/bb.R +++ b/R/bb.R @@ -17,8 +17,8 @@ #' #' @param x One of the following: #' \itemize{ -#' \item A shape (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}} (simple features)). -#' \item A bounding box (either 2 by 2 matrix or an \code{\link[raster:Extent]{Extent}} object). +#' \item A shape (from class \code{\link[sf:sf]{sf}} (simple features)), \code{\link[stars:st_as_stars]{stars}}, \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}. +#' \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{\link[raster:Extent]{Extent}}, numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). #' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} #' If \code{x} is not specified, a bounding box can be created from scratch (see details). #' @param ext Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios. diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index bd07e0c..3e48071 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -42,7 +42,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS res <- xmlChildren(xmlRoot(doc)) if (length(res)==0) { - warning(paste("No results found for \"", q[k], "\".", sep="")) #if (n==1) + message(paste("No results found for \"", q[k], "\".", sep="")) #if (n==1) return(NULL) } @@ -111,6 +111,8 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS output3 <- do.call(c, output2) + if (is.null(output3)) return(NULL) + if (as.data.frame) { df <- do.call(rbind, output3) diff --git a/man/bb.Rd b/man/bb.Rd index c92f4aa..14f1e19 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -23,8 +23,8 @@ bb( \arguments{ \item{x}{One of the following: \itemize{ -\item A shape (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}} (simple features)). -\item A bounding box (either 2 by 2 matrix or an \code{\link[raster:Extent]{Extent}} object). +\item A shape (from class \code{\link[sf:sf]{sf}} (simple features)), \code{\link[stars:st_as_stars]{stars}}, \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}. +\item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{\link[raster:Extent]{Extent}}, numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} If \code{x} is not specified, a bounding box can be created from scratch (see details).} From 0158aa00f6cd5c2325d928626b1afc78ececbb7d Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Fri, 5 Jun 2020 10:57:25 +0200 Subject: [PATCH 18/44] improved bb: working for +proj=ortho --- R/bb.R | 83 +++++++++------------------------------------------------- 1 file changed, 12 insertions(+), 71 deletions(-) diff --git a/R/bb.R b/R/bb.R index bf1f194..7bc1413 100755 --- a/R/bb.R +++ b/R/bb.R @@ -138,83 +138,24 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N current.projection <- .crs_longlat } - sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) - # STEP 1: check if poly can be reprojected, and if not, cut the bounding box such that lon between -180 and 180 and lat between -90 and 90 - - #sf_poly2 <- sf_poly - sf_poly_prj <- sf::st_transform(sf_poly, crs = projection) - if (!inherits(sf_poly_prj, "sfc_POLYGON") || (nrow(sf::st_coordinates(sf_poly_prj)) < 4L) || sf::st_is_empty(sf_poly_prj)) { - earth_end <- suppressWarnings(bb_earth(projection=current.projection)) - if (is.null(earth_end)) { - sf_poly2 <- sf_poly - } else { - sf_poly2 <- tryCatch({ - suppressMessages(sf::st_intersection(sf_poly, earth_end)) - }, error=function(e){ - sf_poly - }) - if (is.null(sf_poly2) || !inherits(sf_poly2, c("sf", "sfc")) || length(sf_poly2) == 0) sf_poly2 <- sf_poly - } - } else { - sf_poly2 <- sf_poly - } - - - # earth_end <- suppressWarnings(bb_earth(projection=current.projection)) - # - # if (is.null(earth_end)) { - # sf_poly2 <- sf_poly - # } else { - # sf_poly2 <- tryCatch({ - # suppressMessages(sf::st_intersection(sf_poly, earth_end)) - # }, error=function(e){ - # sf_poly - # }) - # if (is.null(sf_poly2) || !inherits(sf_poly2, c("sf", "sfc")) || length(sf_poly2) == 0) sf_poly2 <- sf_poly - # } - - # STEP 2: Extract the bounding box corner points and add intermediate points, which can be needed since the exterme values may not be corner points once they are projected. Create a SpatialPoints objects from these points. - co <- sf::st_coordinates(sf_poly2)[,1:2] - co2 <- apply(co, 2, function(v) { - n <- length(v) - c(v[1], rep(v[-n], each=4) + as.vector(sapply((v[-1] - v[-n]) / 4, function(w)cumsum(rep(w,4))))) - }) - - sf_pnts <- sf::st_sfc(sf::st_multipoint(co2), crs=current.projection) - - - # STEP 3: Reproject SpatialPoints object - tryCatch({ - sf_pnts2_prj <- st_transform2(sf_pnts, crs=projection) - }, error=function(e) { - stop("Something went wrong with the bounding box. Please check the projection.", call.=FALSE) - }) - - - # STEP 3b: check dateline crossings - longs <- sf::st_coordinates(sf_pnts2_prj)[,1] - if (any(longs < -150) && any(longs > 150) && !any(longs > -150 & longs < 150)) { - longs[longs < -150] <- longs[longs < -150] + 360 - sf_pnts2_prj[[1]][,1] <- longs - } - - # close polygon (rounding errors may cause open polygons otherwise) - coords <- sf::st_coordinates(sf_pnts2_prj)[,1:2] - coords[nrow(coords), ] <- coords[1, ] - - sf_poly2_prj <- sf::st_polygon(list(coords)) - - - # STEP 4: Get bounding box of reprojected object - - #st_bbox((st_wrap_dateline(st_polygon(list(st_coordinates(sf_pnts2_prj)[,1:2]))))) + ls1 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[2]), + c(b[3], b[4]), c(b[1], b[4]), c(b[1], b[2]))) + ls2 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[4]), + c(b[1], b[4]), c(b[3], b[2]), c(b[1], b[2]))) + sf_lns = st_sfc(ls1, ls2) + sf_lns = st_segmentize(sf_lns, st_length(sf_lns)[1]/100) + st_crs(sf_lns) = current.projection + #sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) + # STEP 1: check if poly can be reprojected, and if not, cut the bounding box such that lon between -180 and 180 and lat between -90 and 90 + #sf_poly2 <- sf_poly + sf_lns_prj <- sf::st_transform(sf_lns, crs = projection, partial = TRUE) - b <- sf::st_bbox(sf_poly2_prj) + b <- sf::st_bbox(sf_lns_prj) is_prj <- !sf::st_is_longlat(projection) } else { is_prj <- if (is.na(current.projection)) { From bc98efc9a23b2db42138260e55e3051e8650e3be Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Fri, 5 Jun 2020 22:21:44 +0200 Subject: [PATCH 19/44] improved bb projection --- R/bb.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/bb.R b/R/bb.R index 7bc1413..e468add 100755 --- a/R/bb.R +++ b/R/bb.R @@ -138,12 +138,16 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N current.projection <- .crs_longlat } + mx = mean(b[c(1,3)]) + my = mean(b[c(2,4)]) ls1 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[2]), c(b[3], b[4]), c(b[1], b[4]), c(b[1], b[2]))) ls2 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[4]), c(b[1], b[4]), c(b[3], b[2]), c(b[1], b[2]))) - sf_lns = st_sfc(ls1, ls2) + ls3 = st_linestring(rbind(c(mx, b[2]), c(mx, b[4]), + c(b[1], my), c(b[3], my), c(mx, b[4]), c(b[3], my), c(mx, b[2]), c(b[1], my))) + sf_lns = st_sfc(ls1, ls2,ls3) sf_lns = st_segmentize(sf_lns, st_length(sf_lns)[1]/100) st_crs(sf_lns) = current.projection @@ -155,7 +159,7 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N #sf_poly2 <- sf_poly sf_lns_prj <- sf::st_transform(sf_lns, crs = projection, partial = TRUE) - b <- sf::st_bbox(sf_lns_prj) + b <- sf::st_bbox(sf_lns_prj[!sf::st_is_empty(sf_lns_prj),]) is_prj <- !sf::st_is_longlat(projection) } else { is_prj <- if (is.na(current.projection)) { From 557fb6101550919fcf777ab11fa12ec2a8483fe4 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Thu, 11 Jun 2020 18:53:43 +0200 Subject: [PATCH 20/44] #22 and improved simplify_shape --- NEWS | 1 + R/approx_distances.R | 2 +- R/bb.R | 22 ++++++++++++++-------- R/simplify_shape.R | 20 ++++++++++++++------ examples/calc_densities.R | 2 +- man/approx_distances.Rd | 2 +- man/calc_densities.Rd | 2 +- man/simplify_shape.Rd | 2 +- 8 files changed, 34 insertions(+), 19 deletions(-) diff --git a/NEWS b/NEWS index 92c6175..26897a6 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,7 @@ version 3.0-1 - bb takes asp.limit argument which controls the maximum aspect ratio - improved geocode_OSM when no results are found +- simplify_shape now works on sfc objects and sf objects with only a geometry column version 3.0 - stars support diff --git a/R/approx_distances.R b/R/approx_distances.R index 64311ca..6d2ec46 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -2,7 +2,7 @@ #' #' Approximate distances between two points or across the horizontal and vertical centerlines of a bounding box. #' -#' @param x object that can be coerced to a bounding box with \code{\link{bb}}, or a pair of coordintes (vector of two). In the former case, the distance across the horizontal and vertical centerlines of the bounding box are approximated. In the latter case, \code{y} is also required; the distance between points \code{x} amd \code{y} is approximated. +#' @param x object that can be coerced to a bounding box with \code{\link{bb}}, or a pair of coordintes (vector of two). In the former case, the distance across the horizontal and vertical centerlines of the bounding box are approximated. In the latter case, \code{y} is also required; the distance between points \code{x} and \code{y} is approximated. #' @param y a pair of coordintes, vector of two. Only required when \code{x} is also a pair of coordintes. #' @param projection projection code, needed in case \code{x} is a bounding box or when \code{x} and \code{y} are pairs of coordinates. See \code{\link{get_proj4}} #' @param target target unit, one of: \code{"m"}, \code{"km"}, \code{"mi"}, and \code{"ft"}. diff --git a/R/bb.R b/R/bb.R index e468add..d16583c 100755 --- a/R/bb.R +++ b/R/bb.R @@ -141,15 +141,15 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N mx = mean(b[c(1,3)]) my = mean(b[c(2,4)]) - ls1 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[2]), + ls1 = sf::st_linestring(rbind(c(b[1], b[2]), c(b[3], b[2]), c(b[3], b[4]), c(b[1], b[4]), c(b[1], b[2]))) - ls2 = st_linestring(rbind(c(b[1], b[2]), c(b[3], b[4]), + ls2 = sf::st_linestring(rbind(c(b[1], b[2]), c(b[3], b[4]), c(b[1], b[4]), c(b[3], b[2]), c(b[1], b[2]))) - ls3 = st_linestring(rbind(c(mx, b[2]), c(mx, b[4]), + ls3 = sf::st_linestring(rbind(c(mx, b[2]), c(mx, b[4]), c(b[1], my), c(b[3], my), c(mx, b[4]), c(b[3], my), c(mx, b[2]), c(b[1], my))) - sf_lns = st_sfc(ls1, ls2,ls3) - sf_lns = st_segmentize(sf_lns, st_length(sf_lns)[1]/100) - st_crs(sf_lns) = current.projection + sf_lns = sf::st_sfc(ls1, ls2,ls3) + sf_lns = sf::st_segmentize(sf_lns, sf::st_length(sf_lns)[1]/100) + sf::st_crs(sf_lns) = current.projection #sf_poly <- sf::st_sfc(sf::st_polygon(list(matrix(c(b[1], b[2], b[1], b[4], b[3], b[4], b[3], b[2], b[1], b[2]), byrow = TRUE, ncol = 2))), crs=current.projection) @@ -159,8 +159,14 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N #sf_poly2 <- sf_poly sf_lns_prj <- sf::st_transform(sf_lns, crs = projection, partial = TRUE) - b <- sf::st_bbox(sf_lns_prj[!sf::st_is_empty(sf_lns_prj),]) - is_prj <- !sf::st_is_longlat(projection) + is_prj <- !sf::st_is_longlat(projection) + + #b <- sf::st_bbox(sf_lns_prj[!sf::st_is_empty(sf_lns_prj),]) + b <- sf::st_bbox(sf_lns_prj) + if (any(!is.finite(b))) { + if (is_prj) stop("Unable to determine bounding for projected crs.", call. = FALSE) + b[1:4] <- c(-180, -90, 180, 90) + } } else { is_prj <- if (is.na(current.projection)) { !maybe_longlat(b) diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 1d3cf85..6331b59 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -4,7 +4,7 @@ #' #' This function is a wrapper of \code{\link[rmapshaper:ms_simplify]{ms_simplify}}. In addition, the data is preserved. Also \code{\link[sf:sf]{sf}} objects are supported. #' -#' @param shp an \code{\link[sf:sf]{sf}} object. +#' @param shp an \code{\link[sf:sf]{sf}} or \code{\link[sf:sfc]{sfc}} object. #' @param fact simplification factor, number between 0 and 1 (default is 0.1) #' @param keep.units d #' @param keep.subunits d @@ -16,13 +16,17 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS if (!requireNamespace("rmapshaper", quietly = TRUE)) { stop("rmapshaper package is needed for simplify_shape", call. = FALSE) } else { + is_sfc = inherits(shp, "sfc") + if (is_sfc) shp = sf::st_sf(geometry = shp) + sfcol <- attr(shp, "sf_column") dataNames <- setdiff(names(shp), sfcol) - dataNames_new <- paste(dataNames, 1L:length(dataNames), sep ="__") - - names(shp)[match(dataNames, names(shp))] <- dataNames_new + if (length(dataNames)) { + dataNames_new <- paste(dataNames, 1L:length(dataNames), sep ="__") + names(shp)[match(dataNames, names(shp))] <- dataNames_new + } unitCols <- which(sapply(shp, inherits, "units")) if (length(unitCols) > 0) { @@ -39,16 +43,20 @@ simplify_shape <- function(shp, fact = 0.1, keep.units=FALSE, keep.subunits=FALS if (explode) x <- stats::aggregate(x, by = list(x$UNIT__NR), FUN = function(x)x[1]) x[, c("rmapshaperid", "UNIT__NR")] <- list() - names(x)[match(dataNames_new, names(x))] <- dataNames + + if (length(dataNames)) { + names(x)[match(dataNames_new, names(x))] <- dataNames + } if (length(unitCols) > 0) { shp[, unitCols] <- mapply(units::as_units, sf::st_drop_geometry(shp[, unitCols]), units, SIMPLIFY = FALSE) } - if (!all(sf::st_is_valid(x))) { + x = if (!all(sf::st_is_valid(x))) { sf::st_make_valid(x) } else { x } + if (is_sfc) sf::st_geometry(x) else x } } diff --git a/examples/calc_densities.R b/examples/calc_densities.R index 186d4c4..295fa73 100644 --- a/examples/calc_densities.R +++ b/examples/calc_densities.R @@ -6,7 +6,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_women_km.2", "pop_women_km.2"), + tm_polygons(c("pop_men_km.2", "pop_women_km.2"), title=expression("Population per " * km^2), style="quantile") + tm_facets(free.scales = FALSE) + tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) diff --git a/man/approx_distances.Rd b/man/approx_distances.Rd index f9fd84f..00d1e5a 100644 --- a/man/approx_distances.Rd +++ b/man/approx_distances.Rd @@ -7,7 +7,7 @@ approx_distances(x, y = NULL, projection = NULL, target = NULL) } \arguments{ -\item{x}{object that can be coerced to a bounding box with \code{\link{bb}}, or a pair of coordintes (vector of two). In the former case, the distance across the horizontal and vertical centerlines of the bounding box are approximated. In the latter case, \code{y} is also required; the distance between points \code{x} amd \code{y} is approximated.} +\item{x}{object that can be coerced to a bounding box with \code{\link{bb}}, or a pair of coordintes (vector of two). In the former case, the distance across the horizontal and vertical centerlines of the bounding box are approximated. In the latter case, \code{y} is also required; the distance between points \code{x} and \code{y} is approximated.} \item{y}{a pair of coordintes, vector of two. Only required when \code{x} is also a pair of coordintes.} diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index 6113d6b..b3a6b1d 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -41,7 +41,7 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_women_km.2", "pop_women_km.2"), + tm_polygons(c("pop_men_km.2", "pop_women_km.2"), title=expression("Population per " * km^2), style="quantile") + tm_facets(free.scales = FALSE) + tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) diff --git a/man/simplify_shape.Rd b/man/simplify_shape.Rd index 38e6023..7ad308f 100644 --- a/man/simplify_shape.Rd +++ b/man/simplify_shape.Rd @@ -7,7 +7,7 @@ simplify_shape(shp, fact = 0.1, keep.units = FALSE, keep.subunits = FALSE, ...) } \arguments{ -\item{shp}{an \code{\link[sf:sf]{sf}} object.} +\item{shp}{an \code{\link[sf:sf]{sf}} or \code{\link[sf:sfc]{sfc}} object.} \item{fact}{simplification factor, number between 0 and 1 (default is 0.1)} From 11ba4937cf63ca74c4db470b7f207a8ba0499e15 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 30 Jun 2020 17:09:08 +0200 Subject: [PATCH 21/44] CRAN 3.0-1 submitted --- DESCRIPTION | 2 +- NEWS | 2 +- R/geocode_OSM.R | 29 ++++++++++++++++++++++++----- man/geocode_OSM.Rd | 3 +++ 4 files changed, 29 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e553bbe..44609c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,7 @@ Description: Set of tools for reading and processing spatial data. The aim is to License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-03-30 +Date: 2020-06-30 Depends: R (>= 3.5), methods diff --git a/NEWS b/NEWS index 26897a6..3ff3800 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,6 @@ version 3.0-1 - bb takes asp.limit argument which controls the maximum aspect ratio -- improved geocode_OSM when no results are found +- improved geocode_OSM when no results are found; also added argument keep.unfound - simplify_shape now works on sfc objects and sf objects with only a geometry column version 3.0 diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 3e48071..b8eb9b4 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -5,6 +5,7 @@ #' @param q a character (vector) that specifies a search query. For instance \code{"India"} or \code{"CBS Weg 11, Heerlen, Netherlands"}. #' @param projection projection in which the coordinates and bounding box are returned. Either a \code{\link[sp:CRS]{CRS}} object or a character value. If it is a character, it can either be a \code{PROJ.4} character string or a shortcut. See \code{\link{get_proj4}} for a list of shortcut values. By default latitude longitude coordinates. #' @param return.first.only Only return the first result +#' @param keep.unfound Keep list items / data.frame rows with \code{NA}s for unfound search terms. By default \code{FALSE} #' @param details provide output details, other than the point coordinates and bounding box #' @param as.data.frame Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}. #' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry. @@ -15,7 +16,7 @@ #' @importFrom XML xmlChildren xmlRoot xmlAttrs xmlTreeParse xmlValue #' @example ./examples/geocode_OSM.R #' @seealso \code{\link{rev_geocode_OSM}}, \code{\link{bb}} -geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="http://nominatim.openstreetmap.org") { +geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound = FALSE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="http://nominatim.openstreetmap.org") { n <- length(q) q2 <- gsub(" ", "+", enc2utf8(q), fixed = TRUE) addr <- paste0(server, "/search?q=", q2, "&format=xml&polygon=0&addressdetails=0") @@ -30,6 +31,8 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS as.data.frame <- TRUE return.first.only <- TRUE } + sn_names <- c("place_id", "osm_type", "osm_id", "place_rank", "display_name", "class", "type", "importance", "icon") + output2 <- lapply(1:n, function(k) { @@ -43,12 +46,28 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS if (length(res)==0) { message(paste("No results found for \"", q[k], "\".", sep="")) #if (n==1) - return(NULL) + if (keep.unfound) { + if (as.data.frame) { + res = if (project) { + list(query = q[k], x = as.numeric(as.numeric(NA)), y = as.numeric(NA), y_min = as.numeric(NA), + y_max = as.numeric(NA), x_min = as.numeric(NA), x_max = as.numeric(NA)) + } else { + list(query = q[k], lat = as.numeric(NA), lon = as.numeric(NA), lat_min = as.numeric(NA), + lat_max = as.numeric(NA), lon_min = as.numeric(NA), lon_max = as.numeric(NA)) + } + } else { + res = list(queue = q[k], coords = c(x=NA, y = NA), bbox = sf::st_bbox()) + } + if (details) res[sn_names] = as.character(NA) + if (as.sf) res$bbox = sf::st_sfc(sf::st_polygon()) + + if (as.data.frame) res <- as.data.frame(res, stringsAsFactors=FALSE) + return(list(res)) + } else return(NULL) } idx <- if (return.first.only) 1 else 1:length(res) - sn_names <- c("place_id", "osm_type", "osm_id", "place_rank", "display_name", "class", "type", "importance", "icon") output <- lapply(idx, function(i) { search_result <- xmlAttrs(res[[i]]) @@ -121,11 +140,11 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, details=FALS if (!project) { df$x <- df$lon df$y <- df$lat - res <- sf::st_as_sf(df, coords = c("x","y"), crs=.crs_longlat) + res <- suppressWarnings(sf::st_as_sf(df, coords = c("x","y"), crs=.crs_longlat, na.fail = FALSE)) } else { df$x2 <- df$x df$y2 <- df$y - res <- sf::st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat) + res <- suppressWarnings(sf::st_as_sf(df, coords = c("x2","y2"), crs=.crs_longlat, na.fail = FALSE)) } names(res)[names(res) == "geometry"] <- "point" diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index ca52772..ec5ff74 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -8,6 +8,7 @@ geocode_OSM( q, projection = NULL, return.first.only = TRUE, + keep.unfound = FALSE, details = FALSE, as.data.frame = NA, as.sf = FALSE, @@ -22,6 +23,8 @@ geocode_OSM( \item{return.first.only}{Only return the first result} +\item{keep.unfound}{Keep list items / data.frame rows with \code{NA}s for unfound search terms. By default \code{FALSE}} + \item{details}{provide output details, other than the point coordinates and bounding box} \item{as.data.frame}{Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}.} From 7f7b32ddc13e92af8bafd5dd8994e86bef32bb60 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 1 Jul 2020 13:49:35 +0200 Subject: [PATCH 22/44] cleaned-up imports, resubmitted to CRAN as version 3.1 --- DESCRIPTION | 7 +++---- NAMESPACE | 9 ++++----- NEWS | 2 +- R/bb.R | 11 +++++++---- R/calc_densities.R | 2 +- R/crop_shape.R | 11 +++++------ R/geocode_OSM.R | 5 +++-- R/get_asp_ratio.R | 2 +- R/get_brewer_pal.R | 5 +++-- R/map_coloring.R | 4 ++-- R/palette_explorer.R | 2 +- R/read_osm.R | 9 +-------- man/bb.Rd | 4 ++-- man/calc_densities.Rd | 2 +- man/crop_shape.Rd | 10 +++++----- man/geocode_OSM.Rd | 4 ++-- man/get_asp_ratio.Rd | 2 +- man/get_brewer_pal.Rd | 4 ++-- man/get_neighbours.Rd | 2 +- man/map_coloring.Rd | 2 +- man/palette_explorer.Rd | 2 +- man/read_osm.Rd | 3 --- 22 files changed, 48 insertions(+), 56 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 44609c7..72846f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,13 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 3.0-1 +Version: 3.1 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-06-30 +Date: 2020-07-01 Depends: R (>= 3.5), methods @@ -17,9 +17,7 @@ Imports: stars (>= 0.4-1), units (>= 0.6-1), grid, - raster (>= 2.7-15), classInt, - KernSmooth, magrittr, RColorBrewer, viridisLite, @@ -31,6 +29,7 @@ Suggests: rmapshaper, osmdata, OpenStreetMap, + raster, png, shiny, shinyjs diff --git a/NAMESPACE b/NAMESPACE index 1592d5f..7272eb3 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,9 @@ export(simplify_shape) export(tmap.pal.info) import(RColorBrewer) import(grid) +import(sf) +importFrom(RColorBrewer,brewer.pal) +importFrom(RColorBrewer,brewer.pal.info) importFrom(XML,xmlAttrs) importFrom(XML,xmlChildren) importFrom(XML,xmlRoot) @@ -40,11 +43,7 @@ importFrom(lwgeom,st_geod_area) importFrom(lwgeom,st_transform_proj) importFrom(magrittr,"%>%") importFrom(methods,as) -importFrom(raster,brick) -importFrom(raster,extent) -importFrom(raster,mask) -importFrom(raster,raster) -importFrom(raster,trim) +importFrom(stars,st_as_stars) importFrom(stats,aggregate) importFrom(stats,na.omit) importFrom(units,as_units) diff --git a/NEWS b/NEWS index 3ff3800..98bdaac 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -version 3.0-1 +version 3.1 - bb takes asp.limit argument which controls the maximum aspect ratio - improved geocode_OSM when no results are found; also added argument keep.unfound - simplify_shape now works on sfc objects and sf objects with only a geometry column diff --git a/R/bb.R b/R/bb.R index d16583c..368c07b 100755 --- a/R/bb.R +++ b/R/bb.R @@ -17,8 +17,8 @@ #' #' @param x One of the following: #' \itemize{ -#' \item A shape (from class \code{\link[sf:sf]{sf}} (simple features)), \code{\link[stars:st_as_stars]{stars}}, \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}. -#' \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{\link[raster:Extent]{Extent}}, numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). +#' \item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. +#' \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). #' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} #' If \code{x} is not specified, a bounding box can be created from scratch (see details). #' @param ext Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios. @@ -39,7 +39,7 @@ #' \item \code{"extent"} an \code{raster::extent} object, which is a numeric vector of 4: xmin, xmax, ymin, ymax. This representation used by the \code{raster} package. #' } #' @return bounding box (see argument \code{output}) -#' @importFrom raster extent +#' @import sf #' @importFrom XML xmlTreeParse xmlChildren xmlRoot xmlAttrs #' @example ./examples/bb.R #' @seealso \code{\link{geocode_OSM}} @@ -215,7 +215,10 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N } else if (output == "matrix") { b <- matrix(b, ncol=2, dimnames = list(c("x", "y"), c("min", "max"))) } else { - b <- extent(b[c(1,3,2,4)]) + if (requireNamespace("raster")) { + warning("raster package functionality in tmaptools will no longer be supported from the next version onwards") + b <- raster::extent(b[c(1,3,2,4)]) + } else stop("raster package needed") } b diff --git a/R/calc_densities.R b/R/calc_densities.R index 7355225..b4d1578 100644 --- a/R/calc_densities.R +++ b/R/calc_densities.R @@ -2,7 +2,7 @@ #' #' Transpose quantitative variables to densitiy variables, which are often needed for choroplets. For example, the colors of a population density map should correspond population density counts rather than absolute population numbers. #' -#' @param shp a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}} +#' @param shp a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} from the \code{sp} package. #' @param var name(s) of a qualtity variable name contained in the \code{shp} data #' @param target the target unit, see \code{\link{approx_areas}}. Density values are calculated in \code{var/target^2}. #' @param total.area total area size of \code{shp} in number of target units (defined by \code{unit}), \code{\link{approx_areas}}. diff --git a/R/crop_shape.R b/R/crop_shape.R index e1432db..55839ea 100755 --- a/R/crop_shape.R +++ b/R/crop_shape.R @@ -1,16 +1,15 @@ #' Crop shape object #' -#' Crop a shape object (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}). A shape file \code{x} is cropped, either by the bounding box of another shape \code{y}, or by \code{y} itself if it is a SpatialPolygons object and \code{polygon = TRUE}. +#' Crop a shape object (from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}). A shape file \code{x} is cropped, either by the bounding box of another shape \code{y}, or by \code{y} itself if it is a SpatialPolygons object and \code{polygon = TRUE}. #' -#' This function is similar to \code{\link[raster:crop]{crop}} from the \code{raster} package. The main difference is that \code{crop_shape} also allows to crop using a polygon instead of a rectangle. +#' This function is similar to \code{crop} from the \code{raster} package. The main difference is that \code{crop_shape} also allows to crop using a polygon instead of a rectangle. #' -#' @param x shape object, i.e. an object from class \code{\link[sp:Spatial]{Spatial-class}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}. -#' @param y bounding box, an \code{\link[raster:extent]{extent}}, or a shape object from which the bounding box is extracted (unless \code{polygon} is \code{TRUE} and \code{x} is a \code{SpatialPolygons} object). +#' @param x shape object, i.e. an object from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. +#' @param y bounding box, an \code{\link[sf:st_bbox]{st_bbox}}, \code{extent} (\code{raster} package), or a shape object from which the bounding box is extracted (unless \code{polygon} is \code{TRUE} and \code{x} is an \code{sf} object). #' @param polygon should \code{x} be cropped by the polygon defined by \code{y}? If \code{FALSE} (default), \code{x} is cropped by the bounding box of \code{x}. Polygon cropping only works when \code{x} is a spatial object and \code{y} is a \code{SpatialPolygons} object. -#' @param ... arguments passed on to \code{\link[raster:crop]{crop}} +#' @param ... not used anymore #' @export #' @seealso \code{\link{bb}} -#' @importFrom raster trim mask brick #' @example ./examples/crop_shape.R #' @return cropped shape, in the same class as \code{x} crop_shape <- function(x, y, polygon = FALSE, ...) { diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index b8eb9b4..0de1aaa 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -3,7 +3,7 @@ #' Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). #' #' @param q a character (vector) that specifies a search query. For instance \code{"India"} or \code{"CBS Weg 11, Heerlen, Netherlands"}. -#' @param projection projection in which the coordinates and bounding box are returned. Either a \code{\link[sp:CRS]{CRS}} object or a character value. If it is a character, it can either be a \code{PROJ.4} character string or a shortcut. See \code{\link{get_proj4}} for a list of shortcut values. By default latitude longitude coordinates. +#' @param projection projection in which the coordinates and bounding box are returned. See \code{\link[sf:st_crs]{st_crs}} for details. By default latitude longitude coordinates (EPSG 4326). #' @param return.first.only Only return the first result #' @param keep.unfound Keep list items / data.frame rows with \code{NA}s for unfound search terms. By default \code{FALSE} #' @param details provide output details, other than the point coordinates and bounding box @@ -11,9 +11,10 @@ #' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry. #' @param geometry When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_set_geometry]{st_set_geometry}}. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. -#' @return If \code{as.SPDF} then a \code{\link[sp:SpatialPointsDataFrame]{SpatialPointsDataFrame}} is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. +#' @return If \code{as.sf} then a \code{\link[sf:sf]{sf}} object is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. #' @export #' @importFrom XML xmlChildren xmlRoot xmlAttrs xmlTreeParse xmlValue +#' @importFrom stars st_as_stars #' @example ./examples/geocode_OSM.R #' @seealso \code{\link{rev_geocode_OSM}}, \code{\link{bb}} geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound = FALSE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="http://nominatim.openstreetmap.org") { diff --git a/R/get_asp_ratio.R b/R/get_asp_ratio.R index 8e65c58..6b6e9e1 100644 --- a/R/get_asp_ratio.R +++ b/R/get_asp_ratio.R @@ -4,7 +4,7 @@ #' #' The arguments \code{width}, \code{height}, and \code{res} are passed on to \code{\link[grDevices:png]{png}}. If \code{x} is a tmap object, a temporarily png image is created to calculate the aspect ratio of a tmap object. The default size of this image is 700 by 700 pixels at 100 dpi. #' -#' @param x shape object (either \code{\link[sp:Spatial]{Spatial}}, a \code{\link[raster:Raster-class]{Raster}}, or an \code{\link[sf:sf]{sf}}), a bounding box (that can be coerced by \code{\link{bb}}), or a \code{\link[tmap:tmap-element]{tmap}} object. +#' @param x A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{Raster}, a bounding box (that can be coerced by \code{\link{bb}}), or a \code{\link[tmap:tmap-element]{tmap}} object. #' @param is.projected Logical that determined wether the coordinates of \code{x} are projected (\code{TRUE}) or longitude latitude coordinates (\code{FALSE}). By deafult, it is determined by the coordinates of \code{x}. #' @param width See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @param height See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R index 7f1cfa4..d3a4613 100644 --- a/R/get_brewer_pal.R +++ b/R/get_brewer_pal.R @@ -4,15 +4,16 @@ #' #' The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. #' -#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} (or \code{\link[RColorBrewer:display.brewer.pal]{display.brewer.pal}}) for options. +#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:brewer.pal]{brewer.pal}} for options. #' @param n number of colors #' @param contrast a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details. -#' @param stretch logical that determines whether intermediate colors are used for a cateogorical palette when \code{n} is greater than the number of available colors. +#' @param stretch logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors. #' @param plot should the palette be plot, or only returned? If \code{TRUE} the palette is silently returned. #' @return vector of color values. It is silently returned when \code{plot=TRUE}. #' @example ./examples/get_brewer_pal.R #' @seealso \code{\link{palette_explorer}} #' @import grid +#' @importFrom RColorBrewer brewer.pal brewer.pal.info #' @export get_brewer_pal <- function(palette, n=5, contrast=NA, stretch=TRUE, plot=TRUE) { call <- names(match.call(expand.dots = TRUE)[-1]) diff --git a/R/map_coloring.R b/R/map_coloring.R index b1f0d32..2273314 100644 --- a/R/map_coloring.R +++ b/R/map_coloring.R @@ -2,7 +2,7 @@ #' #' Color the polygons of a map such that adjacent polygons have different colors #' -#' @param x Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}} object), or an adjacency list. +#' @param x Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list. #' @param algorithm currently, only "greedy" is implemented. #' @param ncols number of colors. By default it is 8 when \code{palette} is undefined. Else, it is set to the length of \code{palette} #' @param minimize logical that determines whether \code{algorithm} will search for a minimal number of colors. If \code{FALSE}, the \code{ncols} colors will be picked by a random procedure. @@ -77,7 +77,7 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palett #' #' Get neighbours list from spatial objects. The output is similar to the function \code{poly2nb} of the \code{spdep} package, but uses \code{sf} instead of \code{sp}. #' -#' @param x a shape object, i.e., a \code{\link[sf:sf]{sf}} object or a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}. +#' @param x a shape object, i.e., a \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} (\code{sp} package). #' @return A list where the items correspond to the features. Each item is a vector of neighbours. #' @export get_neighbours <- function(x) { diff --git a/R/palette_explorer.R b/R/palette_explorer.R index cdc5d9e..71c8efd 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -105,7 +105,7 @@ is_light <- function(col) { #' @name palette_explorer #' @rdname palette_explorer #' @example ./examples/palette_explorer.R -#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} +#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:brewer.pal]{RColorBrewer}} #' @references \url{http://www.color-blindness.com/types-of-color-blindness/} palette_explorer <- function() { if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) diff --git a/R/read_osm.R b/R/read_osm.R index 51f9b8f..48a478e 100644 --- a/R/read_osm.R +++ b/R/read_osm.R @@ -10,22 +10,15 @@ #' @param minNumTiles passed on to \code{\link[OpenStreetMap:openmap]{openmap}} Only applicable when \code{raster=TRUE}. #' @param mergeTiles passed on to \code{\link[OpenStreetMap:openmap]{openmap}} Only applicable when \code{raster=TRUE}. #' @param use.colortable should the colors of the returned raster object be stored in a \code{\link[raster:colortable]{colortable}}? If \code{FALSE}, a RasterStack is returned with three layers that correspond to the red, green and blue values betweeen 0 and 255. -#' @param raster deprecated #' @param ... arguments passed on to \code{\link{bb}}. #' @name read_osm #' @rdname read_osm -#' @importFrom raster raster #' @export #' @example ./examples/read_osm.R #' @return The output of \code{read_osm} is a \code{\link[raster:raster]{raster}} object. -read_osm <- function(x, zoom=NULL, type="osm", minNumTiles=NULL, mergeTiles=NULL, use.colortable = FALSE, raster, ...) { +read_osm <- function(x, zoom=NULL, type="osm", minNumTiles=NULL, mergeTiles=NULL, use.colortable = FALSE, ...) { if (!get(".internet", envir = .TMAPTOOLS_CACHE)) stop("No internet connection found.") - if (!missing(raster)) { - warning("The argument raster is deprecated, since read_osm only returns raster as of tmaptools version 2.0 (see details section in the documentation)") - if (!raster) stop("Reading vectorized OSM data is not implemented anymore. Please use the osmdata package.") - } - # @importFrom OpenStreetMap openmap k <- v <- NULL args <- list(...) diff --git a/man/bb.Rd b/man/bb.Rd index 14f1e19..085eb10 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -23,8 +23,8 @@ bb( \arguments{ \item{x}{One of the following: \itemize{ -\item A shape (from class \code{\link[sf:sf]{sf}} (simple features)), \code{\link[stars:st_as_stars]{stars}}, \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}. -\item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{\link[raster:Extent]{Extent}}, numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). +\item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. +\item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} If \code{x} is not specified, a bounding box can be created from scratch (see details).} diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index b3a6b1d..5a8a067 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -14,7 +14,7 @@ calc_densities( ) } \arguments{ -\item{shp}{a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}} +\item{shp}{a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} from the \code{sp} package.} \item{var}{name(s) of a qualtity variable name contained in the \code{shp} data} diff --git a/man/crop_shape.Rd b/man/crop_shape.Rd index 79d21fa..666e5b6 100644 --- a/man/crop_shape.Rd +++ b/man/crop_shape.Rd @@ -7,22 +7,22 @@ crop_shape(x, y, polygon = FALSE, ...) } \arguments{ -\item{x}{shape object, i.e. an object from class \code{\link[sp:Spatial]{Spatial-class}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}.} +\item{x}{shape object, i.e. an object from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}.} -\item{y}{bounding box, an \code{\link[raster:extent]{extent}}, or a shape object from which the bounding box is extracted (unless \code{polygon} is \code{TRUE} and \code{x} is a \code{SpatialPolygons} object).} +\item{y}{bounding box, an \code{\link[sf:st_bbox]{st_bbox}}, \code{extent} (\code{raster} package), or a shape object from which the bounding box is extracted (unless \code{polygon} is \code{TRUE} and \code{x} is an \code{sf} object).} \item{polygon}{should \code{x} be cropped by the polygon defined by \code{y}? If \code{FALSE} (default), \code{x} is cropped by the bounding box of \code{x}. Polygon cropping only works when \code{x} is a spatial object and \code{y} is a \code{SpatialPolygons} object.} -\item{...}{arguments passed on to \code{\link[raster:crop]{crop}}} +\item{...}{not used anymore} } \value{ cropped shape, in the same class as \code{x} } \description{ -Crop a shape object (from class \code{\link[sp:Spatial]{Spatial}}, \code{\link[raster:Raster-class]{Raster}}, or \code{\link[sf:sf]{sf}}). A shape file \code{x} is cropped, either by the bounding box of another shape \code{y}, or by \code{y} itself if it is a SpatialPolygons object and \code{polygon = TRUE}. +Crop a shape object (from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}). A shape file \code{x} is cropped, either by the bounding box of another shape \code{y}, or by \code{y} itself if it is a SpatialPolygons object and \code{polygon = TRUE}. } \details{ -This function is similar to \code{\link[raster:crop]{crop}} from the \code{raster} package. The main difference is that \code{crop_shape} also allows to crop using a polygon instead of a rectangle. +This function is similar to \code{crop} from the \code{raster} package. The main difference is that \code{crop_shape} also allows to crop using a polygon instead of a rectangle. } \examples{ if (require(tmap) && packageVersion("tmap") >= "2.0") { diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index ec5ff74..57dcb67 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -19,7 +19,7 @@ geocode_OSM( \arguments{ \item{q}{a character (vector) that specifies a search query. For instance \code{"India"} or \code{"CBS Weg 11, Heerlen, Netherlands"}.} -\item{projection}{projection in which the coordinates and bounding box are returned. Either a \code{\link[sp:CRS]{CRS}} object or a character value. If it is a character, it can either be a \code{PROJ.4} character string or a shortcut. See \code{\link{get_proj4}} for a list of shortcut values. By default latitude longitude coordinates.} +\item{projection}{projection in which the coordinates and bounding box are returned. See \code{\link[sf:st_crs]{st_crs}} for details. By default latitude longitude coordinates (EPSG 4326).} \item{return.first.only}{Only return the first result} @@ -36,7 +36,7 @@ geocode_OSM( \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } \value{ -If \code{as.SPDF} then a \code{\link[sp:SpatialPointsDataFrame]{SpatialPointsDataFrame}} is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. +If \code{as.sf} then a \code{\link[sf:sf]{sf}} object is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. } \description{ Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). diff --git a/man/get_asp_ratio.Rd b/man/get_asp_ratio.Rd index 4c2ca3e..caf7d86 100644 --- a/man/get_asp_ratio.Rd +++ b/man/get_asp_ratio.Rd @@ -7,7 +7,7 @@ get_asp_ratio(x, is.projected = NA, width = 700, height = 700, res = 100) } \arguments{ -\item{x}{shape object (either \code{\link[sp:Spatial]{Spatial}}, a \code{\link[raster:Raster-class]{Raster}}, or an \code{\link[sf:sf]{sf}}), a bounding box (that can be coerced by \code{\link{bb}}), or a \code{\link[tmap:tmap-element]{tmap}} object.} +\item{x}{A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{Raster}, a bounding box (that can be coerced by \code{\link{bb}}), or a \code{\link[tmap:tmap-element]{tmap}} object.} \item{is.projected}{Logical that determined wether the coordinates of \code{x} are projected (\code{TRUE}) or longitude latitude coordinates (\code{FALSE}). By deafult, it is determined by the coordinates of \code{x}.} diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd index 8ce264f..b446086 100644 --- a/man/get_brewer_pal.Rd +++ b/man/get_brewer_pal.Rd @@ -7,13 +7,13 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) } \arguments{ -\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} (or \code{\link[RColorBrewer:display.brewer.pal]{display.brewer.pal}}) for options.} +\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:brewer.pal]{brewer.pal}} for options.} \item{n}{number of colors} \item{contrast}{a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details.} -\item{stretch}{logical that determines whether intermediate colors are used for a cateogorical palette when \code{n} is greater than the number of available colors.} +\item{stretch}{logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors.} \item{plot}{should the palette be plot, or only returned? If \code{TRUE} the palette is silently returned.} } diff --git a/man/get_neighbours.Rd b/man/get_neighbours.Rd index ac96e75..edf3f34 100644 --- a/man/get_neighbours.Rd +++ b/man/get_neighbours.Rd @@ -7,7 +7,7 @@ get_neighbours(x) } \arguments{ -\item{x}{a shape object, i.e., a \code{\link[sf:sf]{sf}} object or a \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}}.} +\item{x}{a shape object, i.e., a \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} (\code{sp} package).} } \value{ A list where the items correspond to the features. Each item is a vector of neighbours. diff --git a/man/map_coloring.Rd b/man/map_coloring.Rd index ba09ef8..e79d1c2 100644 --- a/man/map_coloring.Rd +++ b/man/map_coloring.Rd @@ -14,7 +14,7 @@ map_coloring( ) } \arguments{ -\item{x}{Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPolygonsDataFrame]{SpatialPolygons(DataFrame)}} object), or an adjacency list.} +\item{x}{Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list.} \item{algorithm}{currently, only "greedy" is implemented.} diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index 9718084..8d4fda8 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -27,6 +27,6 @@ if (require(shiny) && require(shinyjs)) { \url{http://www.color-blindness.com/types-of-color-blindness/} } \seealso{ -\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} +\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:brewer.pal]{RColorBrewer}} } \keyword{datasets} diff --git a/man/read_osm.Rd b/man/read_osm.Rd index 65477fd..062f6d6 100644 --- a/man/read_osm.Rd +++ b/man/read_osm.Rd @@ -11,7 +11,6 @@ read_osm( minNumTiles = NULL, mergeTiles = NULL, use.colortable = FALSE, - raster, ... ) } @@ -28,8 +27,6 @@ read_osm( \item{use.colortable}{should the colors of the returned raster object be stored in a \code{\link[raster:colortable]{colortable}}? If \code{FALSE}, a RasterStack is returned with three layers that correspond to the red, green and blue values betweeen 0 and 255.} -\item{raster}{deprecated} - \item{...}{arguments passed on to \code{\link{bb}}.} } \value{ From 314b4af5390119f07e4da9094bf42b42dc468d2b Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 1 Jul 2020 15:43:42 +0200 Subject: [PATCH 23/44] CRAN 3.1 submission (take #3) --- R/approx_areas.R | 4 ++-- R/bb_poly.R | 4 ++-- R/geocode_OSM.R | 2 +- R/get_brewer_pal.R | 4 ++-- R/palette_explorer.R | 4 ++-- man/approx_areas.Rd | 4 ++-- man/bb_poly.Rd | 4 ++-- man/geocode_OSM.Rd | 2 +- man/get_brewer_pal.Rd | 4 ++-- man/palette_explorer.Rd | 4 ++-- 10 files changed, 18 insertions(+), 18 deletions(-) diff --git a/R/approx_areas.R b/R/approx_areas.R index 90c9bb0..cae2524 100755 --- a/R/approx_areas.R +++ b/R/approx_areas.R @@ -1,10 +1,10 @@ #' Approximate area sizes of the shapes #' -#' Approximate the area sizes of the polygons in real-world area units (such as sq km or sq mi), proportional numbers, or normalized numbers. Also, the areas can be calibrated to a prespecified area total. This function is a convenient wrapper around \code{\link[sf:st_area]{st_area}}. +#' Approximate the area sizes of the polygons in real-world area units (such as sq km or sq mi), proportional numbers, or normalized numbers. Also, the areas can be calibrated to a prespecified area total. This function is a convenient wrapper around \code{\link[sf:geos_measures]{st_area}}. #' #' Note that the method of determining areas is an approximation, since it depends on the used projection and the level of detail of the shape object. Projections with equal-area property are highly recommended. See \url{https://en.wikipedia.org/wiki/List_of_map_projections} for equal area world map projections. #' -#' @param shp shape object, i.e., an \code{\link[sf:sf]{sf}} or \code{\link[sp:sp]{sp}} object. +#' @param shp shape object, i.e., an \code{\link[sf:sf]{sf}} or \code{sp} object. #' @param target target unit, one of #' \describe{ #' \item{\code{"prop"}:}{Proportional numbers. In other words, the sum of the area sizes equals one.} diff --git a/R/bb_poly.R b/R/bb_poly.R index 48db654..baaa0f2 100755 --- a/R/bb_poly.R +++ b/R/bb_poly.R @@ -1,6 +1,6 @@ #' Convert bounding box to a spatial polygon #' -#' Convert bounding box to a spatial (\code{\link[sf:st_sfc]{sfc}}) object . Useful for plotting (see example). The function \code{bb_earth} returns a spatial polygon of the 'boundaries' of the earth, which can also be done in other projections (if a feasible solution exists). +#' Convert bounding box to a spatial (\code{\link[sf:sfc]{sfc}}) object . Useful for plotting (see example). The function \code{bb_earth} returns a spatial polygon of the 'boundaries' of the earth, which can also be done in other projections (if a feasible solution exists). #' #' @param x object that can be coerced to a bounding box with \code{\link{bb}} #' @param projection projection in which the coordinates of \code{x} are provided. For \code{bb_earth}, \code{projection} is the projection in which the bounding box is returned (if possible). @@ -9,7 +9,7 @@ #' @param earth.datum Geodetic datum to determine the earth boundary. By default EPSG 4326. #' @param bbx boundig box of the earth in a vector of 4 values: min longitude, max longitude, min latitude, max latitude. By default \code{c(-180, 180, -90, 90)}. If for some \code{projection}, a feasible solution does not exist, it may be wise to choose a smaller bbx, e.g. \code{c(-180, 180, -88, 88)}. However, this is also automatically done with the next argument, \code{buffer}. #' @param buffer In order to determine feasible earth bounding boxes in other projections, a buffer is used to decrease the bounding box by a small margin (default \code{1e-06}). This value is subtracted from each the bounding box coordinates. If it still does not result in a feasible bounding box, this procedure is repeated 5 times, where each time the buffer is multiplied by 10. Set \code{buffer=0} to disable this procedure. -#' @return \code{\link[sf:st_sfc]{sfc}} object +#' @return \code{\link[sf:sfc]{sfc}} object #' @example ./examples/bb_poly.R #' @name bb_poly #' @rdname bb_poly diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 0de1aaa..65b3563 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -9,7 +9,7 @@ #' @param details provide output details, other than the point coordinates and bounding box #' @param as.data.frame Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}. #' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry. -#' @param geometry When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_set_geometry]{st_set_geometry}}. +#' @param geometry When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. #' @return If \code{as.sf} then a \code{\link[sf:sf]{sf}} object is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. #' @export diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R index d3a4613..a3aea15 100644 --- a/R/get_brewer_pal.R +++ b/R/get_brewer_pal.R @@ -1,10 +1,10 @@ #' Get and plot a (modified) Color Brewer palette #' -#' Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:brewer.pal]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +#' Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. #' #' The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. #' -#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:brewer.pal]{brewer.pal}} for options. +#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}} for options. #' @param n number of colors #' @param contrast a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details. #' @param stretch logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors. diff --git a/R/palette_explorer.R b/R/palette_explorer.R index 71c8efd..39ad08c 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -97,7 +97,7 @@ is_light <- function(col) { #' Explore color palettes #' -#' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:brewer.pal.info]{brewer.pal.info}}, but extended with the color palettes from viridis. +#' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:RColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. #' @export #' @importFrom grDevices col2rgb #' @importFrom dichromat dichromat @@ -105,7 +105,7 @@ is_light <- function(col) { #' @name palette_explorer #' @rdname palette_explorer #' @example ./examples/palette_explorer.R -#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:brewer.pal]{RColorBrewer}} +#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} #' @references \url{http://www.color-blindness.com/types-of-color-blindness/} palette_explorer <- function() { if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) diff --git a/man/approx_areas.Rd b/man/approx_areas.Rd index 4ec01d5..c8a26aa 100644 --- a/man/approx_areas.Rd +++ b/man/approx_areas.Rd @@ -7,7 +7,7 @@ approx_areas(shp, target = "metric", total.area = NULL) } \arguments{ -\item{shp}{shape object, i.e., an \code{\link[sf:sf]{sf}} or \code{\link[sp:sp]{sp}} object.} +\item{shp}{shape object, i.e., an \code{\link[sf:sf]{sf}} or \code{sp} object.} \item{target}{target unit, one of \describe{ @@ -24,7 +24,7 @@ These units are the output units. See \code{orig} for the coordinate units used Numeric vector of area sizes (class \code{\link[units:units]{units}}). } \description{ -Approximate the area sizes of the polygons in real-world area units (such as sq km or sq mi), proportional numbers, or normalized numbers. Also, the areas can be calibrated to a prespecified area total. This function is a convenient wrapper around \code{\link[sf:st_area]{st_area}}. +Approximate the area sizes of the polygons in real-world area units (such as sq km or sq mi), proportional numbers, or normalized numbers. Also, the areas can be calibrated to a prespecified area total. This function is a convenient wrapper around \code{\link[sf:geos_measures]{st_area}}. } \details{ Note that the method of determining areas is an approximation, since it depends on the used projection and the level of detail of the shape object. Projections with equal-area property are highly recommended. See \url{https://en.wikipedia.org/wiki/List_of_map_projections} for equal area world map projections. diff --git a/man/bb_poly.Rd b/man/bb_poly.Rd index a223d57..85617af 100644 --- a/man/bb_poly.Rd +++ b/man/bb_poly.Rd @@ -31,10 +31,10 @@ bb_earth( \item{buffer}{In order to determine feasible earth bounding boxes in other projections, a buffer is used to decrease the bounding box by a small margin (default \code{1e-06}). This value is subtracted from each the bounding box coordinates. If it still does not result in a feasible bounding box, this procedure is repeated 5 times, where each time the buffer is multiplied by 10. Set \code{buffer=0} to disable this procedure.} } \value{ -\code{\link[sf:st_sfc]{sfc}} object +\code{\link[sf:sfc]{sfc}} object } \description{ -Convert bounding box to a spatial (\code{\link[sf:st_sfc]{sfc}}) object . Useful for plotting (see example). The function \code{bb_earth} returns a spatial polygon of the 'boundaries' of the earth, which can also be done in other projections (if a feasible solution exists). +Convert bounding box to a spatial (\code{\link[sf:sfc]{sfc}}) object . Useful for plotting (see example). The function \code{bb_earth} returns a spatial polygon of the 'boundaries' of the earth, which can also be done in other projections (if a feasible solution exists). } \examples{ if (require(tmap) && packageVersion("tmap") >= "2.0") { diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index 57dcb67..edacafc 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -31,7 +31,7 @@ geocode_OSM( \item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry.} -\item{geometry}{When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_set_geometry]{st_set_geometry}}.} +\item{geometry}{When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}.} \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd index b446086..95b2510 100644 --- a/man/get_brewer_pal.Rd +++ b/man/get_brewer_pal.Rd @@ -7,7 +7,7 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) } \arguments{ -\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:brewer.pal]{brewer.pal}} for options.} +\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}} for options.} \item{n}{number of colors} @@ -21,7 +21,7 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) vector of color values. It is silently returned when \code{plot=TRUE}. } \description{ -Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:brewer.pal]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. } \details{ The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index 8d4fda8..f8aa25d 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -14,7 +14,7 @@ palette_explorer() tmap.pal.info } \description{ -\code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:brewer.pal.info]{brewer.pal.info}}, but extended with the color palettes from viridis. +\code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:RColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. } \examples{ \dontrun{ @@ -27,6 +27,6 @@ if (require(shiny) && require(shinyjs)) { \url{http://www.color-blindness.com/types-of-color-blindness/} } \seealso{ -\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:brewer.pal]{RColorBrewer}} +\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} } \keyword{datasets} From 947f3bdb7c58553f896413fac69651adddbf1970 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Wed, 1 Jul 2020 18:49:06 +0200 Subject: [PATCH 24/44] CRAN 3.1 --- R/get_brewer_pal.R | 4 ++-- R/palette_explorer.R | 4 ++-- man/get_brewer_pal.Rd | 4 ++-- man/palette_explorer.Rd | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R index a3aea15..bd245b5 100644 --- a/R/get_brewer_pal.R +++ b/R/get_brewer_pal.R @@ -1,10 +1,10 @@ #' Get and plot a (modified) Color Brewer palette #' -#' Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +#' Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. #' #' The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. #' -#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}} for options. +#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}} for options. #' @param n number of colors #' @param contrast a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details. #' @param stretch logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors. diff --git a/R/palette_explorer.R b/R/palette_explorer.R index 39ad08c..9121a7e 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -97,7 +97,7 @@ is_light <- function(col) { #' Explore color palettes #' -#' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:RColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. +#' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. #' @export #' @importFrom grDevices col2rgb #' @importFrom dichromat dichromat @@ -105,7 +105,7 @@ is_light <- function(col) { #' @name palette_explorer #' @rdname palette_explorer #' @example ./examples/palette_explorer.R -#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} +#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} #' @references \url{http://www.color-blindness.com/types-of-color-blindness/} palette_explorer <- function() { if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd index 95b2510..11f68aa 100644 --- a/man/get_brewer_pal.Rd +++ b/man/get_brewer_pal.Rd @@ -7,7 +7,7 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) } \arguments{ -\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}} for options.} +\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}} for options.} \item{n}{number of colors} @@ -21,7 +21,7 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) vector of color values. It is silently returned when \code{plot=TRUE}. } \description{ -Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:RColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. } \details{ The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index f8aa25d..b9f7a69 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -14,7 +14,7 @@ palette_explorer() tmap.pal.info } \description{ -\code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:RColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. +\code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. } \examples{ \dontrun{ @@ -27,6 +27,6 @@ if (require(shiny) && require(shinyjs)) { \url{http://www.color-blindness.com/types-of-color-blindness/} } \seealso{ -\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:RColorBrewer]{RColorBrewer}} +\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} } \keyword{datasets} From a28a280c601dbc7205988abec5fb7303da31daa5 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Sat, 5 Sep 2020 09:02:31 +0200 Subject: [PATCH 25/44] fixed https://github.com/mtennekes/tmap/issues/492 and https://github.com/mtennekes/tmap/issues/493 --- R/approx_areas.R | 2 +- R/approx_distances.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/approx_areas.R b/R/approx_areas.R index cae2524..2c4c918 100755 --- a/R/approx_areas.R +++ b/R/approx_areas.R @@ -34,7 +34,7 @@ approx_areas <- function(shp, target="metric", total.area=NULL) { areas <- tryCatch(sf::st_area(shp), error = function(e) { - lwgeom::st_geod_area(lwgeom::st_transform_proj(shp, crs = 4326)) + lwgeom::st_geod_area(lwgeom::st_transform_proj(shp, crs = st_crs(4326))) }) if (target == "prop") { diff --git a/R/approx_distances.R b/R/approx_distances.R index 6d2ec46..5782e32 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -77,8 +77,8 @@ approx_distances <- function(x, y = NULL, projection = NULL, target = NULL) { get_distance <- function(p1, p2) { tryCatch(sf::st_distance(p1, p2)[1,1], error = function(e) { - p1ll <- lwgeom::st_transform_proj(p1, crs = 4326) - p2ll <- lwgeom::st_transform_proj(p2, crs = 4326) + p1ll <- lwgeom::st_transform_proj(p1, crs = st_crs(4326)) + p2ll <- lwgeom::st_transform_proj(p2, crs = st_crs(4326)) lwgeom::st_geod_distance(p1ll, p2ll)[1,1] }) } From 45d26c82966cb7d69e2bef0c64fb9b615af32242 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Guillou?= Date: Tue, 15 Dec 2020 11:49:24 +1000 Subject: [PATCH 26/44] update Nominatim usage policy URL, fix typo --- DESCRIPTION | 2 +- R/geocode_OSM.R | 8 ++++---- man/geocode_OSM.Rd | 4 ++-- man/rev_geocode_OSM.Rd | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 72846f8..5253d24 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,4 +35,4 @@ Suggests: shinyjs URL: https://github.com/mtennekes/tmaptools BugReports: https://github.com/mtennekes/tmaptools/issues -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 65b3563..808af44 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -1,6 +1,6 @@ #' Geocodes a location using OpenStreetMap Nominatim #' -#' Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). +#' Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{https://operations.osmfoundation.org/policies/nominatim/}). #' #' @param q a character (vector) that specifies a search query. For instance \code{"India"} or \code{"CBS Weg 11, Heerlen, Netherlands"}. #' @param projection projection in which the coordinates and bounding box are returned. See \code{\link[sf:st_crs]{st_crs}} for details. By default latitude longitude coordinates (EPSG 4326). @@ -9,7 +9,7 @@ #' @param details provide output details, other than the point coordinates and bounding box #' @param as.data.frame Return the output as a \code{data.frame}. If \code{FALSE}, a list is returned with at least two items: \code{"coords"}, a vector containing the coordinates, and \code{"bbox"}, the corresponding bounding box. By default false, unless \code{q} contains multiple queries. If \code{as.sf = TRUE} (see below), \code{as.data.frame} will set to \code{TRUE}. #' @param as.sf Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry. -#' @param geometry When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}. +#' @param geometry When \code{as.sf}, this argument determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. #' @return If \code{as.sf} then a \code{\link[sf:sf]{sf}} object is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. #' @export @@ -164,7 +164,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound #' Reverse geocodes a location using OpenStreetMap Nominatim #' -#' Reverse geocodes a location (based on spatial coordinates) to an address. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). +#' Reverse geocodes a location (based on spatial coordinates) to an address. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{https://operations.osmfoundation.org/policies/nominatim/}). #' #' @param x x coordinate(s), or a spatial points object (\code{\link[sf:sf]{sf}} or \code{\link[sp:SpatialPoints]{SpatialPoints}}) #' @param y y coordinate(s) @@ -174,7 +174,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. #' @export #' @importFrom XML xmlChildren xmlRoot xmlAttrs xmlTreeParse xmlValue -#' @return A data frmame or a list with all atributes that are contained in the search result +#' @return A data frame or a list with all attributes that are contained in the search result #' @example ./examples/rev_geocode_OSM.R #' @seealso \code{\link{geocode_OSM}} rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="http://nominatim.openstreetmap.org") { diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index edacafc..b017f7c 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -31,7 +31,7 @@ geocode_OSM( \item{as.sf}{Return the output as \code{\link[sf:sf]{sf}} object. If \code{TRUE}, \code{return.first.only} will be set to \code{TRUE}. Two geometry columns are added: \code{bbox} and \code{point}. The argument \code{geometry} determines which of them is set to the default geometry.} -\item{geometry}{When \code{as.sf}, this arugment determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}.} +\item{geometry}{When \code{as.sf}, this argument determines which column (\code{bbox} or \code{point}) is set as geometry column. Note that the geometry can be changed afterwards with \code{\link[sf:st_geometry]{st_set_geometry}}.} \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } @@ -39,7 +39,7 @@ geocode_OSM( If \code{as.sf} then a \code{\link[sf:sf]{sf}} object is returned. Else, if \code{as.data.frame}, then a \code{data.frame} is returned, else a list. } \description{ -Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). +Geocodes a location (based on a search query) to coordinates and a bounding box. Similar to geocode from the ggmap package. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{https://operations.osmfoundation.org/policies/nominatim/}). } \examples{ \dontrun{ diff --git a/man/rev_geocode_OSM.Rd b/man/rev_geocode_OSM.Rd index 9ee336b..0a27ff2 100644 --- a/man/rev_geocode_OSM.Rd +++ b/man/rev_geocode_OSM.Rd @@ -27,10 +27,10 @@ rev_geocode_OSM( \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} } \value{ -A data frmame or a list with all atributes that are contained in the search result +A data frame or a list with all attributes that are contained in the search result } \description{ -Reverse geocodes a location (based on spatial coordinates) to an address. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{http://wiki.openstreetmap.org/wiki/Nominatim_usage_policy}). +Reverse geocodes a location (based on spatial coordinates) to an address. It uses OpenStreetMap Nominatim. For processing large amount of queries, please read the usage policy (\url{https://operations.osmfoundation.org/policies/nominatim/}). } \examples{ \dontrun{ From e7f9b637334b036f001f4d246a5c0bf585af2cf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Guillou?= Date: Tue, 15 Dec 2020 11:58:49 +1000 Subject: [PATCH 27/44] use https API server --- R/geocode_OSM.R | 4 ++-- man/geocode_OSM.Rd | 2 +- man/rev_geocode_OSM.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 808af44..0b2ba9c 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -17,7 +17,7 @@ #' @importFrom stars st_as_stars #' @example ./examples/geocode_OSM.R #' @seealso \code{\link{rev_geocode_OSM}}, \code{\link{bb}} -geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound = FALSE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="http://nominatim.openstreetmap.org") { +geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound = FALSE, details=FALSE, as.data.frame=NA, as.sf=FALSE, geometry=c("point", "bbox"), server="https://nominatim.openstreetmap.org") { n <- length(q) q2 <- gsub(" ", "+", enc2utf8(q), fixed = TRUE) addr <- paste0(server, "/search?q=", q2, "&format=xml&polygon=0&addressdetails=0") @@ -177,7 +177,7 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound #' @return A data frame or a list with all attributes that are contained in the search result #' @example ./examples/rev_geocode_OSM.R #' @seealso \code{\link{geocode_OSM}} -rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="http://nominatim.openstreetmap.org") { +rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="https://nominatim.openstreetmap.org") { project <- !missing(projection) diff --git a/man/geocode_OSM.Rd b/man/geocode_OSM.Rd index b017f7c..fb7de4f 100644 --- a/man/geocode_OSM.Rd +++ b/man/geocode_OSM.Rd @@ -13,7 +13,7 @@ geocode_OSM( as.data.frame = NA, as.sf = FALSE, geometry = c("point", "bbox"), - server = "http://nominatim.openstreetmap.org" + server = "https://nominatim.openstreetmap.org" ) } \arguments{ diff --git a/man/rev_geocode_OSM.Rd b/man/rev_geocode_OSM.Rd index 0a27ff2..0fdee5c 100644 --- a/man/rev_geocode_OSM.Rd +++ b/man/rev_geocode_OSM.Rd @@ -10,7 +10,7 @@ rev_geocode_OSM( zoom = NULL, projection = 4326, as.data.frame = NA, - server = "http://nominatim.openstreetmap.org" + server = "https://nominatim.openstreetmap.org" ) } \arguments{ From 0a143379aa793e678666986b3dad9c1c22ff6f4e Mon Sep 17 00:00:00 2001 From: Nowosad Date: Tue, 29 Dec 2020 11:32:15 +0100 Subject: [PATCH 28/44] adds missing documentation --- R/simplify_shape.R | 4 ++-- man/simplify_shape.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/simplify_shape.R b/R/simplify_shape.R index 6331b59..c5ac8e1 100644 --- a/R/simplify_shape.R +++ b/R/simplify_shape.R @@ -6,8 +6,8 @@ #' #' @param shp an \code{\link[sf:sf]{sf}} or \code{\link[sf:sfc]{sfc}} object. #' @param fact simplification factor, number between 0 and 1 (default is 0.1) -#' @param keep.units d -#' @param keep.subunits d +#' @param keep.units prevent small polygon features from disappearing at high simplification (default FALSE) +#' @param keep.subunits should multipart polygons be converted to singlepart polygons? This prevents small shapes from disappearing during simplification if keep.units = TRUE. Default FALSE #' @param ... other arguments passed on to the underlying function \code{\link[rmapshaper:ms_simplify]{ms_simplify}} (except for the arguments \code{input}, \code{keep}, \code{keep_shapes} and \code{explode}) #' @example ./examples/simplify_shape.R #' @return \code{\link[sf:sf]{sf}} object diff --git a/man/simplify_shape.Rd b/man/simplify_shape.Rd index 7ad308f..58f3ab9 100644 --- a/man/simplify_shape.Rd +++ b/man/simplify_shape.Rd @@ -11,9 +11,9 @@ simplify_shape(shp, fact = 0.1, keep.units = FALSE, keep.subunits = FALSE, ...) \item{fact}{simplification factor, number between 0 and 1 (default is 0.1)} -\item{keep.units}{d} +\item{keep.units}{prevent small polygon features from disappearing at high simplification (default FALSE)} -\item{keep.subunits}{d} +\item{keep.subunits}{should multipart polygons be converted to singlepart polygons? This prevents small shapes from disappearing during simplification if keep.units = TRUE. Default FALSE} \item{...}{other arguments passed on to the underlying function \code{\link[rmapshaper:ms_simplify]{ms_simplify}} (except for the arguments \code{input}, \code{keep}, \code{keep_shapes} and \code{explode})} } From 924f4dabcf907b3e8ac4f7afdf374d3cb3d9674e Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 19 Jan 2021 17:13:03 +0100 Subject: [PATCH 29/44] ready to submit CRAN 3.1-1 --- DESCRIPTION | 4 ++-- NEWS | 3 +++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5253d24..90f445a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,13 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 3.1 +Version: 3.1-1 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2020-07-01 +Date: 2021-01-19 Depends: R (>= 3.5), methods diff --git a/NEWS b/NEWS index 98bdaac..9cf82c9 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,6 @@ +version 3.1-1 +- fixed minor bugs (see github) + version 3.1 - bb takes asp.limit argument which controls the maximum aspect ratio - improved geocode_OSM when no results are found; also added argument keep.unfound From 0c8b0b1c68bb20c7561715011812ca39e2085132 Mon Sep 17 00:00:00 2001 From: Martijn Tennekes Date: Tue, 19 Jan 2021 18:48:39 +0100 Subject: [PATCH 30/44] resubmitted CRAN 3.1-1 --- DESCRIPTION | 1 - R/bb.R | 2 +- R/get_asp_ratio.R | 2 +- R/palette_explorer.R | 2 +- man/bb.Rd | 2 +- man/palette_explorer.Rd | 2 +- 6 files changed, 5 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90f445a..f5f1acd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,6 @@ Imports: stars (>= 0.4-1), units (>= 0.6-1), grid, - classInt, magrittr, RColorBrewer, viridisLite, diff --git a/R/bb.R b/R/bb.R index 368c07b..c504330 100755 --- a/R/bb.R +++ b/R/bb.R @@ -19,7 +19,7 @@ #' \itemize{ #' \item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. #' \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). -#' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} +#' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{https://wiki.openstreetmap.org/wiki/Nominatim/}.} #' If \code{x} is not specified, a bounding box can be created from scratch (see details). #' @param ext Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios. #' @param cx center x coordinate diff --git a/R/get_asp_ratio.R b/R/get_asp_ratio.R index 6b6e9e1..a2ee1aa 100644 --- a/R/get_asp_ratio.R +++ b/R/get_asp_ratio.R @@ -10,7 +10,7 @@ #' @param height See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @param res See details; only applicable if \code{x} is a \code{\link[tmap:tmap-element]{tmap}} object. #' @return aspect ratio -#' @importFrom grDevices colorRampPalette dev.off png rgb +#' @importFrom grDevices colorRampPalette dev.off png rgb col2rgb #' @importFrom methods as #' @importFrom stats aggregate na.omit #' @importFrom utils download.file diff --git a/R/palette_explorer.R b/R/palette_explorer.R index 9121a7e..aefc1b0 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -106,7 +106,7 @@ is_light <- function(col) { #' @rdname palette_explorer #' @example ./examples/palette_explorer.R #' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} -#' @references \url{http://www.color-blindness.com/types-of-color-blindness/} +#' @references \url{https://www.color-blindness.com/types-of-color-blindness/} palette_explorer <- function() { if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) if (!requireNamespace("shinyjs")) stop("shinyjs package needed for this function to work. Please install it.", call. = FALSE) diff --git a/man/bb.Rd b/man/bb.Rd index 085eb10..627717e 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -25,7 +25,7 @@ bb( \itemize{ \item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). -\item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{http://wiki.openstreetmap.org/wiki/Nominatim}.} +\item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{https://wiki.openstreetmap.org/wiki/Nominatim/}.} If \code{x} is not specified, a bounding box can be created from scratch (see details).} \item{ext}{Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios.} diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index b9f7a69..ce7dad0 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -24,7 +24,7 @@ if (require(shiny) && require(shinyjs)) { } } \references{ -\url{http://www.color-blindness.com/types-of-color-blindness/} +\url{https://www.color-blindness.com/types-of-color-blindness/} } \seealso{ \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} From 0e59c0bc7ac1fb9af342263ebf9b83259c0e7e4e Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Wed, 13 Sep 2023 14:06:09 -0400 Subject: [PATCH 31/44] Update links --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f5f1acd..d0f18d9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,6 +32,6 @@ Suggests: png, shiny, shinyjs -URL: https://github.com/mtennekes/tmaptools -BugReports: https://github.com/mtennekes/tmaptools/issues +URL: https://github.com/r-tmap/tmaptools +BugReports: https://github.com/r-tmap/tmaptools/issues RoxygenNote: 7.1.1 From f6c994ff5cf5765c61360b62dfa0c35f93cee85c Mon Sep 17 00:00:00 2001 From: noafterglow Date: Mon, 1 Jan 2024 20:22:49 -0800 Subject: [PATCH 32/44] Update geocode_OSM.R to allow additional params to be passed to server This adds a params input which passes additional parameters to the server. This is helpful as additional parameters can be used to further modify the results, for example to allow addresses to be returned in arbitrary languages. --- R/geocode_OSM.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/geocode_OSM.R b/R/geocode_OSM.R index 0b2ba9c..775e90d 100644 --- a/R/geocode_OSM.R +++ b/R/geocode_OSM.R @@ -172,12 +172,13 @@ geocode_OSM <- function(q, projection=NULL, return.first.only=TRUE, keep.unfound #' @param projection projection in which the coordinates \code{x} and \code{y} are provided. #' @param as.data.frame return as data.frame (\code{TRUE}) or list (\code{FALSE}). By default a list, unless multiple coordinates are provided. #' @param server OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server. +#' @param params Additional parameters to pass to server. (must start with &), ex: "&accept-language=en" to return english rather than local language results. #' @export #' @importFrom XML xmlChildren xmlRoot xmlAttrs xmlTreeParse xmlValue #' @return A data frame or a list with all attributes that are contained in the search result #' @example ./examples/rev_geocode_OSM.R #' @seealso \code{\link{geocode_OSM}} -rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="https://nominatim.openstreetmap.org") { +rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame=NA, server="https://nominatim.openstreetmap.org",params=NULL) { project <- !missing(projection) @@ -224,7 +225,7 @@ rev_geocode_OSM <- function(x, y=NULL, zoom=NULL, projection=4326, as.data.frame strzoom <- paste0(", zoom = ", zoom) } - addr <- paste0(server, "/reverse?format=xml&lat=", lat, "&lon=", lon, qzoom, "&addressdetails=1") + addr <- paste0(server, "/reverse?format=xml&lat=", lat, "&lon=", lon, qzoom, "&addressdetails=1",params) dfs <- lapply(1:n, function(i) { From a72653d6a1fc3b866fcb30aa586ab8a8b3c6d203 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Fri, 3 Jan 2025 09:57:39 -0500 Subject: [PATCH 33/44] Fix partial matching cc @mtennekes --- R/calc_densities.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/calc_densities.R b/R/calc_densities.R index b4d1578..cd414d2 100644 --- a/R/calc_densities.R +++ b/R/calc_densities.R @@ -20,7 +20,7 @@ calc_densities <- function(shp, var, target="metric", total.area=NULL, suffix=NA areas <- approx_areas(shp, target = target, total.area=total.area) - areas_unit <- attr(areas, "unit") + areas_unit <- attr(areas, "units") if (is.na(suffix)) suffix <- paste("_", sub(" ", replacement = "_", areas_unit), sep = "") From 9dc3d5f2a586654581bc5ca5d9c959f067851803 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 3 Jan 2025 11:25:38 -0500 Subject: [PATCH 34/44] upkeep --- .Rbuildignore | 4 +++ .github/.gitignore | 1 + .github/workflows/R-CMD-check.yaml | 51 ++++++++++++++++++++++++++++ .github/workflows/pkgdown.yaml | 49 +++++++++++++++++++++++++++ .gitignore | 1 + .travis.yml | 53 ------------------------------ DESCRIPTION | 4 +-- NEWS => NEWS.md | 20 +++++------ R/{pkg.R => tmaptools-package.R} | 6 +--- README.md | 19 ++++++----- _pkgdown.yml | 4 +++ appveyor.yml | 42 ----------------------- man/tmaptools-package.Rd | 14 ++++++-- tic.R | 20 ----------- tmaptools.Rproj | 1 + 15 files changed, 147 insertions(+), 142 deletions(-) create mode 100644 .github/.gitignore create mode 100644 .github/workflows/R-CMD-check.yaml create mode 100644 .github/workflows/pkgdown.yaml delete mode 100644 .travis.yml rename NEWS => NEWS.md (91%) rename R/{pkg.R => tmaptools-package.R} (95%) create mode 100644 _pkgdown.yml delete mode 100644 appveyor.yml delete mode 100644 tic.R diff --git a/.Rbuildignore b/.Rbuildignore index 2ae8b41..6c7143b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -11,3 +11,7 @@ tic.R appveyor.yml ^cran-comments\.md$ ^CRAN-RELEASE$ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ +^\.github$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..562fe0f --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,51 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: R-CMD-check.yaml + +permissions: read-all + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml new file mode 100644 index 0000000..bfc9f4d --- /dev/null +++ b/.github/workflows/pkgdown.yaml @@ -0,0 +1,49 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + release: + types: [published] + workflow_dispatch: + +name: pkgdown.yaml + +permissions: read-all + +jobs: + pkgdown: + runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::pkgdown, local::. + needs: website + + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages 🚀 + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: docs diff --git a/.gitignore b/.gitignore index a56ee89..c54b475 100644 --- a/.gitignore +++ b/.gitignore @@ -38,3 +38,4 @@ vignettes/*.pdf # R Profile .Rprofile +docs diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 49c267b..0000000 --- a/.travis.yml +++ /dev/null @@ -1,53 +0,0 @@ -language: r - -r: - - release - -deploy.skip_cleanup: true - -sudo: required -dist: trusty -cache: - - packages - - ccache - -latex: false - -addons: - apt: - sources: - - sourceline: 'ppa:opencpu/jq' - - sourceline: 'ppa:ubuntugis/ubuntugis-unstable' - packages: - - libgdal-dev - - libgeos-dev - - libproj-dev - - libudunits2-dev - - libv8-dev - - libjq-dev - - libprotobuf-dev - - protobuf-compiler - - libssl-dev - - libcairo2-dev - - libnetcdf-dev - - netcdf-bin - - libjson-c-dev - -before_install: - - R -e 'install.packages("rgdal", repos="http://R-Forge.R-project.org")' - - R -q -e 'install.packages("remotes"); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages()' - -install: R -q -e 'tic::install()' -script: R -q -e 'tic::script()' -before_deploy: R -q -e 'tic::before_deploy()' -deploy: - provider: script - script: R -q -e 'tic::deploy()' - on: - branch: master - condition: - - $TRAVIS_PULL_REQUEST = false - - $TRAVIS_EVENT_TYPE != cron - - $TRAVIS_R_VERSION_STRING = release - -after_success: R -q -e 'tic::after_success()' diff --git a/DESCRIPTION b/DESCRIPTION index d0f18d9..7d389ec 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,6 +32,6 @@ Suggests: png, shiny, shinyjs -URL: https://github.com/r-tmap/tmaptools +URL: https://github.com/r-tmap/tmaptools, https://r-tmap.github.io/tmaptools/ BugReports: https://github.com/r-tmap/tmaptools/issues -RoxygenNote: 7.1.1 +RoxygenNote: 7.3.2 diff --git a/NEWS b/NEWS.md similarity index 91% rename from NEWS rename to NEWS.md index 9cf82c9..beb44c4 100644 --- a/NEWS +++ b/NEWS.md @@ -1,44 +1,44 @@ -version 3.1-1 +# version 3.1-1 - fixed minor bugs (see github) -version 3.1 +# version 3.1 - bb takes asp.limit argument which controls the maximum aspect ratio - improved geocode_OSM when no results are found; also added argument keep.unfound - simplify_shape now works on sfc objects and sf objects with only a geometry column -version 3.0 +# version 3.0 - stars support - removed hardcoded proj4 shortcuts - geocode_OSM also returns a bounding box if as.sf=TRUE -version 2.0-2 +# version 2.0-2 - sp-based functions marked as deprecated - fixed bug in rev_geocode_OSM - fixed bug in poly_to_raster -version 2.0-1 +# version 2.0-1 - fixed bug in poly_to_raster - fixed smooth_map bugs related to sp/sf conversions - fixed bug in rev_geocode_OSM -version 2.0 +# version 2.0 - tmaptools migrated from sp to sf, all functions support sf, but some still rely on sp - bb now returns a vector instead of a matrix, similar to sf::st_bbox - palette_explorer expanded with viridis palettes - read_osm doens't support vector OSM data anymore, since the osmdata package is a better alternative -version 1.2-2 +# version 1.2-2 - improved smooth_map -version 1.2-1 +# version 1.2-1 - added threshold argument to smooth_map - fixed bug in approx_areas (all warnings now ignored when show.warnings=FALSE) - fixed bug in simplify_shape (ms_simplify is not case sensitive) -version 1.2 +# version 1.2 - added palette_explorer -version 1.0 +# version 1.0 - first CRAN release after package split of tmap - non-plotting functions of tmap 1.6-1 are contained in tmaptools - added aggregate_map diff --git a/R/pkg.R b/R/tmaptools-package.R similarity index 95% rename from R/pkg.R rename to R/tmaptools-package.R index 9b59d87..9a443b2 100644 --- a/R/pkg.R +++ b/R/tmaptools-package.R @@ -38,14 +38,10 @@ #' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr #' } #' -#' @name tmaptools-package -#' @aliases tmaptools -#' @docType package -#' @author Martijn Tennekes \email{mtennekes@@gmail.com} #' @concept GIS #' @concept thematic maps #' @concept spatial data -NULL +"_PACKAGE" #' Pipe operator #' diff --git a/README.md b/README.md index 7da876e..8eec732 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,16 @@ tmaptools: tools for thematic maps in R === -[![Build Status](https://travis-ci.org/mtennekes/tmaptools.png?branch=master)](https://travis-ci.org/mtennekes/tmaptools) -[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/mtennekes/tmaptools?branch=master&svg=true)](https://ci.appveyor.com/project/mtennekes/tmaptools) + + +[![R-CMD-check](https://github.com/r-tmap/tmaptools/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-tmap/tmaptools/actions/workflows/R-CMD-check.yaml) [![License](https://img.shields.io/badge/License-GPL%20v3-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-3.0.html) -[![CRAN](http://www.r-pkg.org/badges/version/tmap)](https://cran.r-project.org/package=tmaptools) -[![Downloads](http://cranlogs.r-pkg.org/badges/tmaptools?color=brightgreen)](http://www.r-pkg.org/pkg/tmaptools) +[![CRAN status](https://www.r-pkg.org/badges/version/tmaptools)](https://CRAN.R-project.org/package=tmaptools) +[![Downloads](https://cranlogs.r-pkg.org/badges/tmaptools?color=brightgreen)](https://www.r-pkg.org:443/pkg/tmaptools) + + -This package offers a set of handy tool functions for reading and processing spatial data. The aim of these functions is to supply the workflow to create thematic maps, e.g. read shape files, set map projections, append data, calculate areas and distances, and query OpenStreetMap. The visualization of thematic maps can be done with the [tmap](https://github.com/mtennekes/tmap) package. +This package offers a set of handy tool functions for reading and processing spatial data. The aim of these functions is to supply the workflow to create thematic maps, e.g. read shape files, set map projections, append data, calculate areas and distances, and query OpenStreetMap. The visualization of thematic maps can be done with the [tmap](https://github.com/r-tmap/tmap) package. Installation ------------ @@ -16,10 +19,10 @@ Installation ```r library(devtools) -install_github("mtennekes/tmaptools") +install_github("r-tmap/tmaptools") ``` -See [installation procedure](https://github.com/mtennekes/tmap#installation) +See [installation procedure](https://github.com/r-tmap/tmap#installation) Development @@ -29,5 +32,5 @@ The latest development version can be installed using `devtools`. ```r library(devtools) -install_github("mtennekes/tmaptools") +install_github("r-tmap/tmaptools") ``` diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..43fa612 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,4 @@ +url: https://r-tmap.github.io/tmaptools/ +template: + bootstrap: 5 + diff --git a/appveyor.yml b/appveyor.yml deleted file mode 100644 index e32d316..0000000 --- a/appveyor.yml +++ /dev/null @@ -1,42 +0,0 @@ -# DO NOT CHANGE the "init" and "install" sections below - -# Download script file from GitHub -init: - ps: | - $ErrorActionPreference = "Stop" - Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" - Import-Module '..\appveyor-tool.ps1' - -install: - ps: Bootstrap - -# Adapt as necessary starting from here - -build_script: - - travis-tool.sh install_deps - -test_script: - - travis-tool.sh run_tests - -on_failure: - - 7z a failure.zip *.Rcheck\* - - appveyor PushArtifact failure.zip - -artifacts: - - path: '*.Rcheck\**\*.log' - name: Logs - - - path: '*.Rcheck\**\*.out' - name: Logs - - - path: '*.Rcheck\**\*.fail' - name: Logs - - - path: '*.Rcheck\**\*.Rout' - name: Logs - - - path: '\*_*.tar.gz' - name: Bits - - - path: '\*_*.zip' - name: Bits diff --git a/man/tmaptools-package.Rd b/man/tmaptools-package.Rd index 72e7ced..9d601fb 100644 --- a/man/tmaptools-package.Rd +++ b/man/tmaptools-package.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/pkg.R \docType{package} \name{tmaptools-package} -\alias{tmaptools-package} \alias{tmaptools} +\alias{tmaptools-package} \title{Thematic Map Tools} \description{ This package offers a set of handy tool functions for reading and processing spatial data. The aim of these functions is to supply the workflow to create thematic maps, e.g. read shape files, set map projections, append data, calculate areas and distances, and query OpenStreetMap. The visualization of thematic maps can be done with the tmap package. @@ -53,8 +53,18 @@ This page provides a brief overview of all package functions. } } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/r-tmap/tmaptools} + \item \url{https://r-tmap.github.io/tmaptools/} + \item Report bugs at \url{https://github.com/r-tmap/tmaptools/issues} +} + +} \author{ -Martijn Tennekes \email{mtennekes@gmail.com} +\strong{Maintainer}: Martijn Tennekes \email{mtennekes@gmail.com} + } \concept{GIS} \concept{spatial data} diff --git a/tic.R b/tic.R deleted file mode 100644 index 35e3e2f..0000000 --- a/tic.R +++ /dev/null @@ -1,20 +0,0 @@ -add_package_checks() - -get_stage("install") %>% - # install lwgeom with its own library since linking again postgis source install fails sometimes - add_code_step(remotes::install_github("r-spatial/sf")) %>% - add_code_step(install.packages("lwgeom", configure.args="--without-liblwgeom"))# %>% - #add_code_step(remotes::install_github("mtennekes/tmaptools")) %>% - #add_code_step(remotes::install_github("mtennekes/tmap")) - -### -# deploy pkgdowm site -### -if (Sys.getenv("id_rsa") != "") { - - get_stage("before_deploy") %>% - add_step(step_setup_ssh()) - - get_stage("deploy") %>% - add_step(step_build_pkgdown()) -} diff --git a/tmaptools.Rproj b/tmaptools.Rproj index a648ce1..5837118 100644 --- a/tmaptools.Rproj +++ b/tmaptools.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: e1f6862d-5ab0-4e93-b054-29045af501f3 RestoreWorkspace: Default SaveWorkspace: Default From 9448c6db86429ff288b81f67f349baf167b6b615 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Fri, 3 Jan 2025 21:45:38 +0100 Subject: [PATCH 35/44] update to tmap4 --- DESCRIPTION | 5 +++-- R/palette_explorer.R | 6 +++++- examples/approx_areas.R | 5 +++-- examples/bb.R | 4 ++-- examples/calc_densities.R | 12 ++++++------ examples/crop_shape.R | 6 ++++-- examples/map_coloring.R | 13 ++++++++----- man/approx_areas.Rd | 5 +++-- man/bb.Rd | 4 ++-- man/calc_densities.Rd | 12 ++++++------ man/crop_shape.Rd | 6 ++++-- man/map_coloring.Rd | 13 ++++++++----- man/palette_explorer.Rd | 5 ++++- man/pipe.Rd | 2 +- man/tmaptools-package.Rd | 2 +- 15 files changed, 60 insertions(+), 40 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7d389ec..a01e178 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,13 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 3.1-1 +Version: 3.2 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 LazyData: true -Date: 2021-01-19 +Date: 2025-01-03 Depends: R (>= 3.5), methods @@ -25,6 +25,7 @@ Imports: XML Suggests: tmap (>= 3.0), + cols4all, rmapshaper, osmdata, OpenStreetMap, diff --git a/R/palette_explorer.R b/R/palette_explorer.R index aefc1b0..c3c09dc 100644 --- a/R/palette_explorer.R +++ b/R/palette_explorer.R @@ -95,7 +95,9 @@ is_light <- function(col) { -#' Explore color palettes +#' Explore color palettes (deprecated) +#' +#' This interactive tool has become deprecated and will not be maintained anymore. Please use \code{\link[cols4all:c4a_gui]{c4a_gui}} instead. #' #' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. #' @export @@ -111,6 +113,8 @@ palette_explorer <- function() { if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) if (!requireNamespace("shinyjs")) stop("shinyjs package needed for this function to work. Please install it.", call. = FALSE) + message("This tool is deprecated; please use cols4all::c4a_gui() instead") + shiny::shinyApp(ui = shiny::fluidPage( shinyjs::useShinyjs(), shiny::div( diff --git a/examples/approx_areas.R b/examples/approx_areas.R index bceb72a..d4a3a98 100644 --- a/examples/approx_areas.R +++ b/examples/approx_areas.R @@ -1,10 +1,11 @@ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(NLD_muni) NLD_muni$area <- approx_areas(NLD_muni, total.area = 33893) tm_shape(NLD_muni) + - tm_bubbles(size="area", title.size=expression("Area in " * km^2)) + tm_bubbles(size="area", + size.legend = tm_legend(title = expression("Area in " * km^2))) # function that returns min, max, mean and sum of area values diff --git a/examples/bb.R b/examples/bb.R index 970b078..50b2793 100644 --- a/examples/bb.R +++ b/examples/bb.R @@ -22,8 +22,8 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { \dontrun{ if (require(tmap)) { - bb("Limburg", projection = "rd") - bb_italy <- bb("Italy", projection = "eck4") + bb("Limburg", projection = 28992) + bb_italy <- bb("Italy", projection = "+proj=eck4") tm_shape(World, bbox=bb_italy) + tm_polygons() # shorter alternative: tm_shape(World, bbox="Italy") + tm_polygons() diff --git a/examples/calc_densities.R b/examples/calc_densities.R index 295fa73..f01ce1c 100644 --- a/examples/calc_densities.R +++ b/examples/calc_densities.R @@ -1,13 +1,13 @@ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(NLD_muni) NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, - target = "km km", var = c("pop_men", "pop_women")) + target = "km km", var = c("population", "dwelling_total")) NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_men_km.2", "pop_women_km.2"), - title=expression("Population per " * km^2), style="quantile") + - tm_facets(free.scales = FALSE) + - tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) + tm_polygons(c("population_km.2", "dwelling_total_km.2"), + fill.legend = list(tm_legend(expression("Population per " * km^2)), tm_legend(expression("Dwellings per " * km^2)))) + + tm_facets(free.scales = TRUE) + + tm_layout(panel.show = FALSE) } diff --git a/examples/crop_shape.R b/examples/crop_shape.R index 6e284bd..d7d18ad 100644 --- a/examples/crop_shape.R +++ b/examples/crop_shape.R @@ -1,4 +1,4 @@ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(World, NLD_muni, land, metro) #land_NLD <- crop_shape(land, NLD_muni) @@ -9,6 +9,8 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { qtm(World) + tm_shape(metro_Europe) + - tm_bubbles("pop2010", col="red", title.size="European cities") + + tm_bubbles("pop2010", + col="red", + size.legend = tm_legend("European cities")) + tm_legend(frame=TRUE) } diff --git a/examples/map_coloring.R b/examples/map_coloring.R index cd807ee..11ec146 100644 --- a/examples/map_coloring.R +++ b/examples/map_coloring.R @@ -1,4 +1,4 @@ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(World, metro) World$color <- map_coloring(World, palette="Pastel2") @@ -8,12 +8,15 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { data(NLD_prov, NLD_muni) tm_shape(NLD_prov) + - tm_fill("name", legend.show = FALSE) + + tm_fill("name", + fill.legend = tm_legend_hide()) + tm_shape(NLD_muni) + - tm_polygons("MAP_COLORS", palette="Greys", alpha = .25) + + tm_polygons("MAP_COLORS", + fill_alpha = .25, + fill.scale = tm_scale(values = "brewer.greys")) + tm_shape(NLD_prov) + tm_borders(lwd=2) + - tm_text("name", shadow=TRUE) + - tm_format("NLD", title="Dutch provinces and\nmunicipalities", bg.color="white") + tm_text("name", options = opt_tm_text(shadow = TRUE)) + + tm_title("Dutch provinces and\nmunicipalities", bg.color="white") } diff --git a/man/approx_areas.Rd b/man/approx_areas.Rd index c8a26aa..f8f5cbf 100644 --- a/man/approx_areas.Rd +++ b/man/approx_areas.Rd @@ -30,13 +30,14 @@ Approximate the area sizes of the polygons in real-world area units (such as sq Note that the method of determining areas is an approximation, since it depends on the used projection and the level of detail of the shape object. Projections with equal-area property are highly recommended. See \url{https://en.wikipedia.org/wiki/List_of_map_projections} for equal area world map projections. } \examples{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(NLD_muni) NLD_muni$area <- approx_areas(NLD_muni, total.area = 33893) tm_shape(NLD_muni) + - tm_bubbles(size="area", title.size=expression("Area in " * km^2)) + tm_bubbles(size="area", + size.legend = tm_legend(title = expression("Area in " * km^2))) # function that returns min, max, mean and sum of area values diff --git a/man/bb.Rd b/man/bb.Rd index 627717e..0d7a69c 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -102,8 +102,8 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { \dontrun{ if (require(tmap)) { - bb("Limburg", projection = "rd") - bb_italy <- bb("Italy", projection = "eck4") + bb("Limburg", projection = 28992) + bb_italy <- bb("Italy", projection = "+proj=eck4") tm_shape(World, bbox=bb_italy) + tm_polygons() # shorter alternative: tm_shape(World, bbox="Italy") + tm_polygons() diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index 5a8a067..e00a706 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -33,18 +33,18 @@ Vector or data.frame (depending on whether \code{length(var)==1} with density va Transpose quantitative variables to densitiy variables, which are often needed for choroplets. For example, the colors of a population density map should correspond population density counts rather than absolute population numbers. } \examples{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(NLD_muni) NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, - target = "km km", var = c("pop_men", "pop_women")) + target = "km km", var = c("population", "dwelling_total")) NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) tm_shape(NLD_muni) + - tm_polygons(c("pop_men_km.2", "pop_women_km.2"), - title=expression("Population per " * km^2), style="quantile") + - tm_facets(free.scales = FALSE) + - tm_layout(panel.show = TRUE, panel.labels=c("Men", "Women")) + tm_polygons(c("population_km.2", "dwelling_total_km.2"), + fill.legend = list(tm_legend(expression("Population per " * km^2)), tm_legend(expression("Dwellings per " * km^2)))) + + tm_facets(free.scales = TRUE) + + tm_layout(panel.show = FALSE) } } \keyword{densities} diff --git a/man/crop_shape.Rd b/man/crop_shape.Rd index 666e5b6..ccb88e8 100644 --- a/man/crop_shape.Rd +++ b/man/crop_shape.Rd @@ -25,7 +25,7 @@ Crop a shape object (from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as This function is similar to \code{crop} from the \code{raster} package. The main difference is that \code{crop_shape} also allows to crop using a polygon instead of a rectangle. } \examples{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(World, NLD_muni, land, metro) #land_NLD <- crop_shape(land, NLD_muni) @@ -36,7 +36,9 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { qtm(World) + tm_shape(metro_Europe) + - tm_bubbles("pop2010", col="red", title.size="European cities") + + tm_bubbles("pop2010", + col="red", + size.legend = tm_legend("European cities")) + tm_legend(frame=TRUE) } } diff --git a/man/map_coloring.Rd b/man/map_coloring.Rd index e79d1c2..48867cb 100644 --- a/man/map_coloring.Rd +++ b/man/map_coloring.Rd @@ -33,7 +33,7 @@ If \code{palette} is defined, a vector of colors is returned, otherwise a vector Color the polygons of a map such that adjacent polygons have different colors } \examples{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap) && packageVersion("tmap") >= "3.99") { data(World, metro) World$color <- map_coloring(World, palette="Pastel2") @@ -43,13 +43,16 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { data(NLD_prov, NLD_muni) tm_shape(NLD_prov) + - tm_fill("name", legend.show = FALSE) + + tm_fill("name", + fill.legend = tm_legend_hide()) + tm_shape(NLD_muni) + - tm_polygons("MAP_COLORS", palette="Greys", alpha = .25) + + tm_polygons("MAP_COLORS", + fill_alpha = .25, + fill.scale = tm_scale(values = "brewer.greys")) + tm_shape(NLD_prov) + tm_borders(lwd=2) + - tm_text("name", shadow=TRUE) + - tm_format("NLD", title="Dutch provinces and\nmunicipalities", bg.color="white") + tm_text("name", options = opt_tm_text(shadow = TRUE)) + + tm_title("Dutch provinces and\nmunicipalities", bg.color="white") } } diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd index ce7dad0..3dea467 100644 --- a/man/palette_explorer.Rd +++ b/man/palette_explorer.Rd @@ -4,7 +4,7 @@ \name{palette_explorer} \alias{palette_explorer} \alias{tmap.pal.info} -\title{Explore color palettes} +\title{Explore color palettes (deprecated)} \format{ An object of class \code{data.frame} with 40 rows and 4 columns. } @@ -14,6 +14,9 @@ palette_explorer() tmap.pal.info } \description{ +This interactive tool has become deprecated and will not be maintained anymore. Please use \code{\link[cols4all:c4a_gui]{c4a_gui}} instead. +} +\details{ \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. } \examples{ diff --git a/man/pipe.Rd b/man/pipe.Rd index c763717..f7e15b8 100644 --- a/man/pipe.Rd +++ b/man/pipe.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg.R +% Please edit documentation in R/tmaptools-package.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} diff --git a/man/tmaptools-package.Rd b/man/tmaptools-package.Rd index 9d601fb..e237df1 100644 --- a/man/tmaptools-package.Rd +++ b/man/tmaptools-package.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg.R +% Please edit documentation in R/tmaptools-package.R \docType{package} \name{tmaptools-package} \alias{tmaptools} From 0a0f62ff8c08c89ad92db85756064427833b3102 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Mon, 6 Jan 2025 13:22:40 -0500 Subject: [PATCH 36/44] Test if tmaptools checks pass cleanly with dev tmap --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a01e178..6fea3cc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Imports: dichromat, XML Suggests: - tmap (>= 3.0), + tmap (>= 3.99), cols4all, rmapshaper, osmdata, @@ -36,3 +36,4 @@ Suggests: URL: https://github.com/r-tmap/tmaptools, https://r-tmap.github.io/tmaptools/ BugReports: https://github.com/r-tmap/tmaptools/issues RoxygenNote: 7.3.2 +Remotes: r-tmap/tmap From 4d2385f77904c8d99bd9c467a15256ef7fc36cfe Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Mon, 6 Jan 2025 13:31:23 -0500 Subject: [PATCH 37/44] Revert --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6fea3cc..1a46da6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Imports: dichromat, XML Suggests: - tmap (>= 3.99), + tmap, cols4all, rmapshaper, osmdata, @@ -36,4 +36,3 @@ Suggests: URL: https://github.com/r-tmap/tmaptools, https://r-tmap.github.io/tmaptools/ BugReports: https://github.com/r-tmap/tmaptools/issues RoxygenNote: 7.3.2 -Remotes: r-tmap/tmap From caf1b298b678e45adc08849e248fe9a9d47e1d0f Mon Sep 17 00:00:00 2001 From: mtennekes Date: Mon, 13 Jan 2025 21:53:17 +0100 Subject: [PATCH 38/44] ready for CRAN submission --- .Rbuildignore | 1 + DESCRIPTION | 3 +-- NEWS.md | 4 ++++ R/calc_densities.R | 2 +- R/get_brewer_pal.R | 7 +++++-- examples/calc_densities.R | 22 +++++++++++++--------- man/calc_densities.Rd | 24 ++++++++++++++---------- man/get_brewer_pal.Rd | 4 ++-- 8 files changed, 41 insertions(+), 26 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 6c7143b..1db58fc 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,4 @@ appveyor.yml ^docs$ ^pkgdown$ ^\.github$ +^CRAN-SUBMISSION$ diff --git a/DESCRIPTION b/DESCRIPTION index 1a46da6..c5b91d8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -6,8 +6,7 @@ Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 -LazyData: true -Date: 2025-01-03 +Date: 2025-01-13 Depends: R (>= 3.5), methods diff --git a/NEWS.md b/NEWS.md index beb44c4..f17ddfb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# version 3.2 +- examples updated with tmap4 +- deprecated some functions + # version 3.1-1 - fixed minor bugs (see github) diff --git a/R/calc_densities.R b/R/calc_densities.R index cd414d2..2701d54 100644 --- a/R/calc_densities.R +++ b/R/calc_densities.R @@ -2,7 +2,7 @@ #' #' Transpose quantitative variables to densitiy variables, which are often needed for choroplets. For example, the colors of a population density map should correspond population density counts rather than absolute population numbers. #' -#' @param shp a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} from the \code{sp} package. +#' @param shp a shape object, i.e., an \code{\link[sf:sf]{sf}} object. #' @param var name(s) of a qualtity variable name contained in the \code{shp} data #' @param target the target unit, see \code{\link{approx_areas}}. Density values are calculated in \code{var/target^2}. #' @param total.area total area size of \code{shp} in number of target units (defined by \code{unit}), \code{\link{approx_areas}}. diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R index bd245b5..2a81873 100644 --- a/R/get_brewer_pal.R +++ b/R/get_brewer_pal.R @@ -1,6 +1,6 @@ -#' Get and plot a (modified) Color Brewer palette +#' Get and plot a (modified) Color Brewer palette (deprecated) #' -#' Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +#' Get and plot a (modified) palette from Color Brewer. This function is deprecated. Please use \code{\link[cols4all:c4a]{c4a}} instead. #' #' The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. #' @@ -16,6 +16,9 @@ #' @importFrom RColorBrewer brewer.pal brewer.pal.info #' @export get_brewer_pal <- function(palette, n=5, contrast=NA, stretch=TRUE, plot=TRUE) { + + message("This function is deprecated; please use cols4all::c4a() instead") + call <- names(match.call(expand.dots = TRUE)[-1]) reverse <- (substr(palette, 1, 1) == "-") diff --git a/examples/calc_densities.R b/examples/calc_densities.R index f01ce1c..0270766 100644 --- a/examples/calc_densities.R +++ b/examples/calc_densities.R @@ -1,13 +1,17 @@ if (require(tmap) && packageVersion("tmap") >= "3.99") { - data(NLD_muni) +data(NLD_muni) - NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, - target = "km km", var = c("population", "dwelling_total")) - NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) +NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, + target = "km km", var = c("population", "dwelling_total")) +NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) - tm_shape(NLD_muni) + - tm_polygons(c("population_km.2", "dwelling_total_km.2"), - fill.legend = list(tm_legend(expression("Population per " * km^2)), tm_legend(expression("Dwellings per " * km^2)))) + - tm_facets(free.scales = TRUE) + - tm_layout(panel.show = FALSE) +tm_shape(NLD_muni) + + tm_polygons( + fill = c("population_km.2", "dwelling_total_km.2"), + fill.legend = + list( + tm_legend(expression("Population per " * km^2)), + tm_legend(expression("Dwellings per " * km^2)))) + +tm_facets(free.scales = TRUE) + + tm_layout(panel.show = FALSE) } diff --git a/man/calc_densities.Rd b/man/calc_densities.Rd index e00a706..9135f3f 100644 --- a/man/calc_densities.Rd +++ b/man/calc_densities.Rd @@ -14,7 +14,7 @@ calc_densities( ) } \arguments{ -\item{shp}{a shape object, i.e., an \code{\link[sf:sf]{sf}} object or a \code{SpatialPolygons(DataFrame)} from the \code{sp} package.} +\item{shp}{a shape object, i.e., an \code{\link[sf:sf]{sf}} object.} \item{var}{name(s) of a qualtity variable name contained in the \code{shp} data} @@ -34,17 +34,21 @@ Transpose quantitative variables to densitiy variables, which are often needed f } \examples{ if (require(tmap) && packageVersion("tmap") >= "3.99") { - data(NLD_muni) +data(NLD_muni) - NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, - target = "km km", var = c("population", "dwelling_total")) - NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) +NLD_muni_pop_per_km2 <- calc_densities(NLD_muni, + target = "km km", var = c("population", "dwelling_total")) +NLD_muni <- sf::st_sf(data.frame(NLD_muni, NLD_muni_pop_per_km2)) - tm_shape(NLD_muni) + - tm_polygons(c("population_km.2", "dwelling_total_km.2"), - fill.legend = list(tm_legend(expression("Population per " * km^2)), tm_legend(expression("Dwellings per " * km^2)))) + - tm_facets(free.scales = TRUE) + - tm_layout(panel.show = FALSE) +tm_shape(NLD_muni) + + tm_polygons( + fill = c("population_km.2", "dwelling_total_km.2"), + fill.legend = + list( + tm_legend(expression("Population per " * km^2)), + tm_legend(expression("Dwellings per " * km^2)))) + +tm_facets(free.scales = TRUE) + + tm_layout(panel.show = FALSE) } } \keyword{densities} diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd index 11f68aa..e35f55b 100644 --- a/man/get_brewer_pal.Rd +++ b/man/get_brewer_pal.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_brewer_pal.R \name{get_brewer_pal} \alias{get_brewer_pal} -\title{Get and plot a (modified) Color Brewer palette} +\title{Get and plot a (modified) Color Brewer palette (deprecated)} \usage{ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) } @@ -21,7 +21,7 @@ get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) vector of color values. It is silently returned when \code{plot=TRUE}. } \description{ -Get and plot a (modified) palette from Color Brewer. In addition to the base function \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}}, a palette can be created for any number of classes. The contrast of the palette can be adjusted for sequential and diverging palettes. For categorical palettes, intermediate colors can be generated. An interactive tool that uses this function is \code{\link{palette_explorer}}. +Get and plot a (modified) palette from Color Brewer. This function is deprecated. Please use \code{\link[cols4all:c4a]{c4a}} instead. } \details{ The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. From b43c48b8712219b3c14a604912fd4db4b404ab6b Mon Sep 17 00:00:00 2001 From: mtennekes Date: Mon, 13 Jan 2025 23:01:06 +0100 Subject: [PATCH 39/44] updated bb (invalid url) --- R/bb.R | 4 ++-- man/bb.Rd | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/bb.R b/R/bb.R index c504330..0291104 100755 --- a/R/bb.R +++ b/R/bb.R @@ -19,8 +19,8 @@ #' \itemize{ #' \item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. #' \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). -#' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{https://wiki.openstreetmap.org/wiki/Nominatim/}.} -#' If \code{x} is not specified, a bounding box can be created from scratch (see details). +#' \item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}}}. +# If \code{x} is not specified, a bounding box can be created from scratch (see details). #' @param ext Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios. #' @param cx center x coordinate #' @param cy center y coordinate diff --git a/man/bb.Rd b/man/bb.Rd index 0d7a69c..8002b0c 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -25,8 +25,7 @@ bb( \itemize{ \item A shape from class \code{\link[sf:sf]{sf}}, \code{\link[stars:st_as_stars]{stars}}, \code{sp}, or \code{raster}. \item A bounding box (\code{\link[sf:st_bbox]{st_bbox}}, \code{Extent} (\code{raster} package, which will no longer be supported in the future versions), numeric vector of 4 (default order: xmin, ymin, xmax, ymax), or a 2x2 matrix). -\item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}} and \url{https://wiki.openstreetmap.org/wiki/Nominatim/}.} -If \code{x} is not specified, a bounding box can be created from scratch (see details).} +\item Open Street Map search query. The bounding is automatically generated by querying \code{x} from Open Street Map Nominatim. See \code{\link{geocode_OSM}}}.} \item{ext}{Extension factor of the bounding box. If 1, the bounding box is unchanged. Values smaller than 1 reduces the bounding box, and values larger than 1 enlarges the bounding box. This argument is a shortcut for both \code{width} and \code{height} with \code{relative=TRUE}. If a negative value is specified, then the shortest side of the bounding box (so width or height) is extended with \code{ext}, and the longest side is extended with the same absolute value. This is especially useful for bounding boxes with very low or high aspect ratios.} From 6af9a6131830e80d97206a013083e1fbba6026b7 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Mon, 7 Jul 2025 23:13:08 +0200 Subject: [PATCH 40/44] ... --- R/bb.R | 19 +++++++++++++++++-- man/bb.Rd | 3 +++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/R/bb.R b/R/bb.R index 0291104..df31489 100755 --- a/R/bb.R +++ b/R/bb.R @@ -29,6 +29,7 @@ #' @param xlim limits of the x-axis. These are either absolute or relative (depending on the argument \code{relative}). #' @param ylim limits of the y-axis. See \code{xlim}. #' @param relative boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}. +#' @param asp.target target aspect ratio, which is width/height, of the returned bounding box. #' @param asp.limit maximum aspect ratio, which is width/height. Number greater than or equal to 1. For landscape bounding boxes, \code{1/asp.limit} will be used. The returned bounding box will have an aspect ratio between \code{1/asp.limit} and \code{asp.limit}. #' @param current.projection projection that corresponds to the bounding box specified by \code{x}. #' @param projection projection to transform the bounding box to. @@ -44,7 +45,7 @@ #' @example ./examples/bb.R #' @seealso \code{\link{geocode_OSM}} #' @export -bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim=NULL, relative = FALSE, asp.limit = NULL, current.projection=NULL, projection=NULL, output = c("bbox", "matrix", "extent")) { +bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=NULL, ylim=NULL, relative = FALSE, asp.target = NULL, asp.limit = NULL, current.projection=NULL, projection=NULL, output = c("bbox", "matrix", "extent")) { # check projections if (!is.null(current.projection)) current.projection <- sf::st_crs(current.projection) @@ -188,7 +189,21 @@ bb <- function(x=NA, ext=NULL, cx=NULL, cy=NULL, width=NULL, height=NULL, xlim=N ## limit aspect ratio - if (!is.null(asp.limit)) { + if (!is.null(asp.target)) { + bbh <- unname(b[4] - b[2]) + bbw <- unname(b[3] - b[1]) + if (asp.target < (bbw / bbh)) { + # increase height + cy <- (b[2] + b[4]) / 2 + b[2] <- cy - bbw / (asp.target * 2) + b[4] <- cy + bbw / (asp.target * 2) + } else if (asp.target > (bbw / bbh)) { + # increase width + cx <- (b[1] + b[3]) / 2 + b[1] <- cx - bbh * (asp.target / 2) + b[3] <- cx + bbh * (asp.target / 2) + } + } else if (!is.null(asp.limit)) { bbh <- unname(b[4] - b[2]) bbw <- unname(b[3] - b[1]) if (bbh < 1e-8 || bbh < (bbw / asp.limit)) { diff --git a/man/bb.Rd b/man/bb.Rd index 8002b0c..e81ac30 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -14,6 +14,7 @@ bb( xlim = NULL, ylim = NULL, relative = FALSE, + asp.target = NULL, asp.limit = NULL, current.projection = NULL, projection = NULL, @@ -43,6 +44,8 @@ bb( \item{relative}{boolean that determines whether relative values are used for \code{width}, \code{height}, \code{xlim} and \code{ylim} or absolute. If \code{x} is unspecified, \code{relative} is set to \code{"FALSE"}.} +\item{asp.target}{target aspect ratio, which is width/height, of the returned bounding box.} + \item{asp.limit}{maximum aspect ratio, which is width/height. Number greater than or equal to 1. For landscape bounding boxes, \code{1/asp.limit} will be used. The returned bounding box will have an aspect ratio between \code{1/asp.limit} and \code{asp.limit}.} \item{current.projection}{projection that corresponds to the bounding box specified by \code{x}.} From 6558245c098dc22e8dfe48db2949bb8667f87e36 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Tue, 8 Jul 2025 09:21:23 +0200 Subject: [PATCH 41/44] ... --- man/rev_geocode_OSM.Rd | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/man/rev_geocode_OSM.Rd b/man/rev_geocode_OSM.Rd index 0fdee5c..d48626d 100644 --- a/man/rev_geocode_OSM.Rd +++ b/man/rev_geocode_OSM.Rd @@ -10,7 +10,8 @@ rev_geocode_OSM( zoom = NULL, projection = 4326, as.data.frame = NA, - server = "https://nominatim.openstreetmap.org" + server = "https://nominatim.openstreetmap.org", + params = NULL ) } \arguments{ @@ -25,6 +26,8 @@ rev_geocode_OSM( \item{as.data.frame}{return as data.frame (\code{TRUE}) or list (\code{FALSE}). By default a list, unless multiple coordinates are provided.} \item{server}{OpenStreetMap Nominatim server name. Could also be a local OSM Nominatim server.} + +\item{params}{Additional parameters to pass to server. (must start with &), ex: "&accept-language=en" to return english rather than local language results.} } \value{ A data frame or a list with all attributes that are contained in the search result From b6ff3ca37036a50062b906e03cf9e86b1fa60781 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Tue, 22 Jul 2025 20:56:00 +0200 Subject: [PATCH 42/44] removed deprecated funs --- DESCRIPTION | 4 +- NAMESPACE | 14 -- NEWS.md | 4 + R/approx_distances.R | 2 +- R/deprecated.R | 160 ---------------- R/get_brewer_pal.R | 73 -------- R/map_coloring.R | 28 +-- R/palette_explorer.R | 358 ------------------------------------ R/tmaptools-package.R | 14 -- examples/approx_areas.R | 12 +- examples/bb.R | 15 +- examples/get_brewer_pal.R | 12 -- examples/map_coloring.R | 19 +- examples/palette_explorer.R | 5 - examples/simplify_shape.R | 14 +- man/approx_areas.Rd | 12 +- man/approx_distances.Rd | 2 +- man/bb.Rd | 15 +- man/deprecated_functions.Rd | 60 ------ man/get_brewer_pal.Rd | 45 ----- man/map_coloring.Rd | 45 ++--- man/palette_explorer.Rd | 35 ---- man/pipe.Rd | 13 -- man/simplify_shape.Rd | 14 +- man/tmaptools-package.Rd | 2 - 25 files changed, 99 insertions(+), 878 deletions(-) delete mode 100644 R/deprecated.R delete mode 100644 R/get_brewer_pal.R delete mode 100644 R/palette_explorer.R delete mode 100644 examples/get_brewer_pal.R delete mode 100644 examples/palette_explorer.R delete mode 100644 man/deprecated_functions.Rd delete mode 100644 man/get_brewer_pal.Rd delete mode 100644 man/palette_explorer.Rd delete mode 100644 man/pipe.Rd diff --git a/DESCRIPTION b/DESCRIPTION index c5b91d8..823f417 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,12 @@ Package: tmaptools Type: Package Title: Thematic Map Tools -Version: 3.2 +Version: 3.3 Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c("aut", "cre")) Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 -Date: 2025-01-13 +Date: 2025-07-22 Depends: R (>= 3.5), methods diff --git a/NAMESPACE b/NAMESPACE index 7272eb3..8f251d2 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export("%>%") export(approx_areas) export(approx_distances) export(bb) @@ -10,30 +9,19 @@ export(calc_densities) export(crop_shape) export(geocode_OSM) export(get_asp_ratio) -export(get_brewer_pal) export(get_neighbours) -export(get_proj4) -export(get_projection) -export(is_projected) export(map_coloring) -export(palette_explorer) export(read_GPX) export(read_osm) export(rev_geocode_OSM) -export(set_projection) export(simplify_shape) -export(tmap.pal.info) import(RColorBrewer) -import(grid) import(sf) -importFrom(RColorBrewer,brewer.pal) -importFrom(RColorBrewer,brewer.pal.info) importFrom(XML,xmlAttrs) importFrom(XML,xmlChildren) importFrom(XML,xmlRoot) importFrom(XML,xmlTreeParse) importFrom(XML,xmlValue) -importFrom(dichromat,dichromat) importFrom(grDevices,col2rgb) importFrom(grDevices,colorRampPalette) importFrom(grDevices,dev.off) @@ -41,7 +29,6 @@ importFrom(grDevices,png) importFrom(grDevices,rgb) importFrom(lwgeom,st_geod_area) importFrom(lwgeom,st_transform_proj) -importFrom(magrittr,"%>%") importFrom(methods,as) importFrom(stars,st_as_stars) importFrom(stats,aggregate) @@ -49,4 +36,3 @@ importFrom(stats,na.omit) importFrom(units,as_units) importFrom(units,set_units) importFrom(utils,download.file) -importFrom(viridisLite,viridis) diff --git a/NEWS.md b/NEWS.md index f17ddfb..013cb4f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# version 3.3 +- deprecated functions removed +- bb target aspect ration added + # version 3.2 - examples updated with tmap4 - deprecated some functions diff --git a/R/approx_distances.R b/R/approx_distances.R index 5782e32..370a493 100755 --- a/R/approx_distances.R +++ b/R/approx_distances.R @@ -4,7 +4,7 @@ #' #' @param x object that can be coerced to a bounding box with \code{\link{bb}}, or a pair of coordintes (vector of two). In the former case, the distance across the horizontal and vertical centerlines of the bounding box are approximated. In the latter case, \code{y} is also required; the distance between points \code{x} and \code{y} is approximated. #' @param y a pair of coordintes, vector of two. Only required when \code{x} is also a pair of coordintes. -#' @param projection projection code, needed in case \code{x} is a bounding box or when \code{x} and \code{y} are pairs of coordinates. See \code{\link{get_proj4}} +#' @param projection projection code, needed in case \code{x} is a bounding box or when \code{x} and \code{y} are pairs of coordinates. #' @param target target unit, one of: \code{"m"}, \code{"km"}, \code{"mi"}, and \code{"ft"}. #' @return If \code{y} is specifyed, a list of two: unit and dist. Else, a list of three: unit, hdist (horizontal distance) and vdist (vertical distance). #' @importFrom units set_units diff --git a/R/deprecated.R b/R/deprecated.R deleted file mode 100644 index a5688eb..0000000 --- a/R/deprecated.R +++ /dev/null @@ -1,160 +0,0 @@ -#' Deprecated tmaptools functions -#' -#' The following functions are not used anymore or deprecated as of tmaptools version 3.0. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} -#' -#' @param x see documentation in tmaptools 2.x for details -#' @param shp see documentation in tmaptools 2.x for details -#' @param output see documentation in tmaptools 2.x for details -#' @param projection see documentation in tmaptools 2.x for details -#' @param current.projection see documentation in tmaptools 2.x for details -#' @param overwrite.current.projection see documentation in tmaptools 2.x for details -#' @param guess.longlat see documentation in tmaptools 2.x for details -#' -#' Deprecated as of version 2.0 -#' \itemize{ -#' \item \code{append_data}, \code{aggregate_map}, \code{double_line}, \code{points_to_raster}, \code{poly_to_raster}, \code{sample_dots}, \code{sbind}, \code{smooth_map}, \code{smooth_raster_cover}, \code{read_shape}, \code{write_shape}. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} -#' \item \code{osm_poly}, \code{osm_line}, \code{osm_point}. Please use the package \code{osmdata} -#' } -#' -#' Deprecated as of version 3.0 -#' \itemize{ -#' \item \code{get_proj4}: for projections, please use the function \code{\link[sf:st_crs]{st_crs}} -#' \item \code{set_projection} for setting map projections, use \code{\link[sf:st_crs]{st_crs}} or \code{\link[sf:st_transform]{st_transform}} -#' \item \code{get_projection} for getting map projections, use \code{\link[sf:st_crs]{st_crs}} -#' \item \code{is_projected} for checking if projections are long lat coordinates, use \code{\link[sf:st_is_longlat]{st_is_longlat}} -#' } -#' -#' @rdname deprecated_functions -#' @name deprecated_functions -NULL - -#' @rdname deprecated_functions -#' @name get_proj4 -#' @keywords internal -#' @export -get_proj4 <- function(x, output = c("crs", "character", "epsg", "CRS")) { - if (sys.nframe()==1L) warning("get_proj4 is deprecated; for projections, please use the function st_crs from the sf package") - - output <- match.arg(output) - y <- if (is.null(x)) { - return(NULL) - } else if (is.na(x)) { - sf::st_crs() - } else if (inherits(x, "crs")) { - x - } else if (inherits(x, "CRS")) { - sf::st_crs(attr(x, "projargs")) - } else if (!is.numeric(x) && !is.character(x)) { - stop("x is not a character, crs object, CRS object, nor a number", call.=FALSE) - } else { - if (x %in% names(.proj_epsg)) { - create_crs(unname(.proj_epsg[x])) - } else if (x %in% names(.proj_sc)) { - create_crs(unname(.proj_sc[x])) - } else if (is_num_string(x)) { - sf::st_crs(x) - } else if (substr(x, 1, 3)=="utm") { - if (!(nchar(x) %in% c(5,6))) stop("\"utm\" shortcut code should be utmXX or utmXXs where XX refers to the utm zone") - sf::st_crs(paste("+proj=utm +zone=", substr(x, 4, 5), ifelse(substr(x, 6, 6)=="s", " +south", ""), " +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", sep="")) - } else { - sf::st_crs(x) - } - } - - if (output == "CRS") stop("output CRS not supported anymore") - - switch(output, - character = y$proj4string, - crs = y, - epsg = y$epsg) -} - -create_crs <- function(x) { - if (is.numeric(x)) { - sf::st_crs(x) - } else { - structure(list(epsg = as.integer(NA), proj4string = x), class = "crs") - } -} - -is_num_string <- function(x) { - suppressWarnings(!is.na(as.numeric(x))) -} - -.proj_epsg <- c(longlat = 4326, - latlong = 4326, - WGS84 = 4326, - NAD83 = 4269, - NAD27 = 4267, - merc = 3857, - laea_Eur = 3035, - laea_NA = 2163, - rd = 28992) - -.proj_sc <- c(wintri="+proj=wintri +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - robin="+proj=robin +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eck4="+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - hd="+proj=cea +lat_ts=37.5 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - gall="+proj=cea +lon_0=0 +lat_ts=45 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - mill="+proj=mill +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +R_A +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc0="+proj=eqc +lat_ts=0 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc30="+proj=eqc +lat_ts=30 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0", - eqc45="+proj=eqc +lat_ts=45 +lat_0=0 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0") - - - -#' @rdname deprecated_functions -#' @name set_projection -#' @keywords internal -#' @export -set_projection <- function(shp, projection=NA, current.projection=NA, overwrite.current.projection=FALSE) { - if (sys.nframe()==1L) warning("set_projection is deprecated; for projections, please use the functions st_crs or st_transform from the sf package") - - if (inherits(shp, "Raster")) shp <- stars::st_as_stars(shp) - - if (!is.na(current.projection)) { - if (!is.na(sf::st_crs(shp)) && !overwrite.current.projection) stop("Current projection already known. Use overwrite.current.projection = TRUE") - sf::st_crs(shp) <- sf::st_crs(current.projection) - } - - - if (!is.na(projection)) { - shp <- sf::st_transform(shp, crs = sf::st_crs(projection)) - } - shp -} - -#' @rdname deprecated_functions -#' @name get_projection -#' @keywords internal -#' @export -get_projection <- function(shp, guess.longlat=FALSE, - output = c("character", "crs", "epsg", "CRS")) { - if (sys.nframe()==1L) warning("get_projection is deprecated; for projections, please use the function st_crs from the sf package") - - p <- if (inherits(shp, c("sf", "sfc", "stars"))) { - sf::st_crs(shp) - } else if (inherits(shp, "Spatial")) { - sf::st_crs(attr(attr(shp, "proj4string"), "projargs")) - } else if (inherits(shp, "Raster")) { - sf::st_crs(attr(attr(shp, "crs"), "projargs")) - } else { - stop("shp is neither an sf, sp, raster, nor a stars object") - } - - output <- match.arg(output) - if (output == "CRS") stop("output CRS not supported anymore") - switch(output, - character = p$proj4string, - crs = p, - epsg = p$epsg) -} - -#' @rdname deprecated_functions -#' @name is_projected -#' @keywords internal -#' @export -is_projected <- function(x) { - if (sys.nframe()==1L) warning("is_projected is deprecated; for projections, please use the function st_is_longlat from the sf package") - !sf::st_is_longlat(x) -} diff --git a/R/get_brewer_pal.R b/R/get_brewer_pal.R deleted file mode 100644 index 2a81873..0000000 --- a/R/get_brewer_pal.R +++ /dev/null @@ -1,73 +0,0 @@ -#' Get and plot a (modified) Color Brewer palette (deprecated) -#' -#' Get and plot a (modified) palette from Color Brewer. This function is deprecated. Please use \code{\link[cols4all:c4a]{c4a}} instead. -#' -#' The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. -#' -#' @param palette name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}} for options. -#' @param n number of colors -#' @param contrast a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details. -#' @param stretch logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors. -#' @param plot should the palette be plot, or only returned? If \code{TRUE} the palette is silently returned. -#' @return vector of color values. It is silently returned when \code{plot=TRUE}. -#' @example ./examples/get_brewer_pal.R -#' @seealso \code{\link{palette_explorer}} -#' @import grid -#' @importFrom RColorBrewer brewer.pal brewer.pal.info -#' @export -get_brewer_pal <- function(palette, n=5, contrast=NA, stretch=TRUE, plot=TRUE) { - - message("This function is deprecated; please use cols4all::c4a() instead") - - call <- names(match.call(expand.dots = TRUE)[-1]) - - reverse <- (substr(palette, 1, 1) == "-") - - if (reverse) palette <- substr(palette, 2, nchar(palette)) - - nmax <- RColorBrewer::brewer.pal.info[palette, "maxcolors"] - if (RColorBrewer::brewer.pal.info[palette, "category"]=="qual") { - if ("contrast" %in% call) warning("contrast not used in qualitative color palettes") - brewerpal <- RColorBrewer::brewer.pal(min(nmax, max(n, 3)), name=palette) - if (stretch && n > length(brewerpal)) { - p <- colorRampPalette(brewerpal)(n) - } else { - p <- rep(brewerpal, length.out=n) - } - } else if (RColorBrewer::brewer.pal.info[palette, "category"]=="seq") { - if ("stretch" %in% call) warning("stretch not used in sequential color palettes") - if (is.na(contrast[1])) contrast <- default_contrast_seq(n) - if (length(contrast)==1) contrast <- c(0, contrast) - brewerpal <- RColorBrewer::brewer.pal(nmax, name=palette) - contrastIDs <- round(seq(contrast[1]*100, contrast[2]*100, length.out=n))+1 - p <- colorRampPalette(brewerpal)(101)[contrastIDs] - } else { - if ("stretch" %in% call) warning("stretch not used in diverging color palettes") - if (is.na(contrast[1])) contrast <- default_contrast_div(n) - if (length(contrast)==1) contrast <- c(0, contrast) - brewerpal <- RColorBrewer::brewer.pal(nmax, name=palette) - contrastIDs <- map2divscaleID(breaks=seq(-10,10, length.out=n+1), contrast=contrast) - p <- colorRampPalette(brewerpal)(101)[contrastIDs] - } - - if (reverse) p <- rev(p) - - if (plot) { - grid.newpage() - fontsize <- min(1, (.8/n) / convertWidth(stringWidth("#ABCDEF"), unitTo = "npc", valueOnly = TRUE)) - pushViewport(viewport(layout = grid.layout(nrow=4, ncol=n+2, widths = unit(c(.1, rep(1, n), .1), c("npc", rep("null", n), "npc")), - heights = unit(c(1, 2, 1.5*fontsize, 1), c("null", "lines", "lines", "null"))))) - lapply(1L:n, function(i) { - pushViewport(viewport(layout.pos.row = 2, layout.pos.col = i+1)) - grid.rect(gp=gpar(fill=p[i])) - popViewport() - pushViewport(viewport(layout.pos.row = 3, layout.pos.col = i+1)) - grid.text(p[i], gp=gpar(cex=fontsize)) - popViewport() - }) - popViewport() - invisible(p) - } else { - p - } -} diff --git a/R/map_coloring.R b/R/map_coloring.R index 2273314..5ce51dd 100644 --- a/R/map_coloring.R +++ b/R/map_coloring.R @@ -1,18 +1,19 @@ #' Map coloring #' -#' Color the polygons of a map such that adjacent polygons have different colors +#' Color the polygons of a map such that adjacent polygons have different colors. This function returns the color indices +#' +#' As of tmaptools 3.3, the deprecated color functions \code{get_brewer_pal} and \code{palette_explorer}, have been removed. These have been replaced \code{c4a} and \code{c4a_gui} respectively from the package cols4all. Therefore, \code{map_coloring} will return color indices and will ignore the input arguments \code{palette} and \code{contrast}. See example. #' #' @param x Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list. #' @param algorithm currently, only "greedy" is implemented. #' @param ncols number of colors. By default it is 8 when \code{palette} is undefined. Else, it is set to the length of \code{palette} #' @param minimize logical that determines whether \code{algorithm} will search for a minimal number of colors. If \code{FALSE}, the \code{ncols} colors will be picked by a random procedure. -#' @param palette color palette. -#' @param contrast vector of two numbers that determine the range that is used for sequential and diverging palettes (applicable when \code{auto.palette.mapping=TRUE}). Both numbers should be between 0 and 1. The first number determines where the palette begins, and the second number where it ends. For sequential palettes, 0 means the brightest color, and 1 the darkest color. For diverging palettes, 0 means the middle color, and 1 both extremes. If only one number is provided, this number is interpreted as the endpoint (with 0 taken as the start). -#' @return If \code{palette} is defined, a vector of colors is returned, otherwise a vector of color indices. +#' @param ... to catch deprecated arguments \code{palette} and \code{contrast}. See details. +#' @return A vector of color indices. #' @example ./examples/map_coloring.R #' @import RColorBrewer #' @export -map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palette=NULL, contrast=1) { +map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, ...) { if (inherits(x, "Spatial")) x <- as(x, "sf") if (inherits(x, "sf")) { # get adjacency list @@ -21,21 +22,10 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, palett adj <- x } else stop("Unknown x argument") - if (!is.null(palette)) { - # reverse palette - if (length(palette)==1 && substr(palette[1], 1, 1)=="-") { - revPal <- function(p)rev(p) - palette <- substr(palette, 2, nchar(palette)) - } else revPal <- function(p)p + args= list(...) + if (any(c("palette", "contrast") %in% names(args))) warning("palette and contrast are not used anymore as of tmaptools 3.3. Please use cols4all: see manual") - if (palette[1] %in% rownames(RColorBrewer::brewer.pal.info)) { - if (is.na(ncols)) ncols <- RColorBrewer::brewer.pal.info[palette, "maxcolors"] - palette2 <- revPal(suppressWarnings(get_brewer_pal(palette, ncols, contrast, plot = FALSE))) - } else { - if (is.na(ncols)) ncols <- length(palette) - palette2 <- rep(palette, length.out=ncols) - } - } else if (is.na(ncols)) ncols <- 8 + if (is.na(ncols)) ncols <- 8 k <- length(adj) diff --git a/R/palette_explorer.R b/R/palette_explorer.R deleted file mode 100644 index c3c09dc..0000000 --- a/R/palette_explorer.R +++ /dev/null @@ -1,358 +0,0 @@ -tmap.pal.info <- local({ - br <- RColorBrewer::brewer.pal.info[, 1:2] - br$origin <- factor("brewer", levels = c("brewer", "viridis")) - - vr <- data.frame(maxcolors = rep.int(0, 5), category = factor("seq", levels = c("div", "qual", "seq")), origin = factor("viridis", levels = c("brewer", "viridis")), row.names = c("viridis", "magma", "plasma", "inferno", "cividis")) - - rbind(br, vr) -}) - - -get_default_contrast <- function(type, m) { - if (type=="seq") { - default_contrast_seq(m) - } else { - default_contrast_div(m) - } -} - - -plot_tmap_pals <- function(type, origin, m, contrast=NULL, stretch=NULL, cex =.9, cex_line = .8, print.hex = FALSE, col.blind="normal") { - pal_info <- tmap.pal.info - - pal_nm <- row.names(pal_info)[pal_info$category==type & pal_info$origin == origin] - pal_labels <- pal_nm - - n <- length(pal_nm) - - if (col.blind!="normal") { - cb <- pal_info[pal_nm, ]$colorblind - pal_labels[pal_labels %in% c("Dark2", "Paired", "Set2")] <- c("Dark2 (3)", "Paired (4)", "Set2 (3)") - } else { - cb <- rep(TRUE, n) - } - - - grid.newpage() - label_width <- convertWidth(stringWidth("Acbdefghijk"), "in", valueOnly = TRUE) * cex - lH <- convertHeight(unit(1, "lines"), "in", valueOnly=TRUE) * cex_line - vp <- viewport(layout = grid.layout(nrow = 2*n + 1, ncol=m+2, - widths = unit(c(label_width, rep(1, m), label_width/4), c("in", rep("null", m), "in")), - heights = unit(c(lH, rep(c(lH, .33*lH), length.out=2*n+1), 1), c(rep("in", 2*n), "null")))) - pushViewport(vp) - - lapply(1L:m, function(j) { - pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1+j)) - grid.text(j, gp=gpar(cex=cex)) - popViewport() - }) - - lapply(1L:n, function(i) { - pushViewport(viewport(layout.pos.row = i*2, layout.pos.col = 1)) - #if (cb[i]) grid.rect(gp=gpar(col=NA, fill="yellow")) - grid.text(pal_labels[i], x = .1, just = "left", gp=gpar(cex=cex, col=ifelse(cb[i], "#000000", "#999999"))) - #if (!cb[i]) grid.lines(x=c(.1,.9), y=c(.5, .5), gp=gpar(col="#AAAAAA")) - popViewport() - - if (origin == "brewer") { - if (type=="qual") { - pal <- get_brewer_pal(pal_nm[i], n=m, stretch=stretch, plot=FALSE) - ids <- which(pal==pal[1])[-1] - } else { - pal <- get_brewer_pal(pal_nm[i], n=m, contrast=contrast, plot=FALSE) - ids <- numeric(0) - } - } else { - pal <- viridis(m, option = pal_nm[i], begin = contrast[1], end = contrast[2]) - ids <- numeric(0) - } - - if (col.blind != "normal") pal <- dichromat(pal, type=col.blind) - - - fontcol <- ifelse(is_light(pal), "black", "white") - fontwidth <- convertWidth(stringWidth("#FFFFFFAA"), unitTo = "npc", valueOnly = TRUE) - fontsize <- min(cex, (1/fontwidth) / m) - - - lapply(1L:m, function(j) { - pushViewport(viewport(layout.pos.row = i*2, layout.pos.col = 1+j)) - grid.rect(gp=gpar(fill=pal[j])) - if (print.hex) grid.text(pal[j], gp=gpar(cex=fontsize, col=fontcol[j])) - if (j %in% ids) { - grid.circle(x=0, y=.5, r=.25, gp=gpar(fill="white", lwd=1)) - } - popViewport() - }) - }) - popViewport() -} - -is_light <- function(col) { - colrgb <- col2rgb(col) - apply(colrgb * c(.299, .587, .114), MARGIN=2, sum) >= 128 -} - - - -#' Explore color palettes (deprecated) -#' -#' This interactive tool has become deprecated and will not be maintained anymore. Please use \code{\link[cols4all:c4a_gui]{c4a_gui}} instead. -#' -#' \code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. -#' @export -#' @importFrom grDevices col2rgb -#' @importFrom dichromat dichromat -#' @importFrom viridisLite viridis -#' @name palette_explorer -#' @rdname palette_explorer -#' @example ./examples/palette_explorer.R -#' @seealso \code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} -#' @references \url{https://www.color-blindness.com/types-of-color-blindness/} -palette_explorer <- function() { - if (!requireNamespace("shiny")) stop("shiny package needed for this function to work. Please install it.", call. = FALSE) - if (!requireNamespace("shinyjs")) stop("shinyjs package needed for this function to work. Please install it.", call. = FALSE) - - message("This tool is deprecated; please use cols4all::c4a_gui() instead") - - shiny::shinyApp(ui = shiny::fluidPage( - shinyjs::useShinyjs(), - shiny::div( - style = "font-size:75%;line-height:20px", - shiny::fluidRow( - shiny::column(3, - shiny::br(), - shiny::br(), - shiny::br(), - shiny::h4("Brewer"), - shiny::sliderInput("m_seq", "Number of colors", - min = 3, max = 20, value = 7)), - shiny::column(3, - shiny::br(), - shiny::br(), - shiny::br(), - shiny::h4("Sequential"), - shiny::strong("Contrast range"), - shiny::checkboxInput("auto_seq", label = "Automatic", value = TRUE), - shiny::uiOutput("contrast_seq_slider")), - shiny::column(6, - shiny::plotOutput("plot_seq", height = "285px"), - shiny::uiOutput("code_seq")) - ), - shiny::fluidRow( - shiny::column(3, - shiny::h4("Brewer"), - shiny::sliderInput("m_cat", "Number of colors", - min = 3, max = 20, value = 8) - ), - shiny::column(3, - shiny::h4("Categorical"), - shiny::checkboxInput("stretch", "Stretch", value=TRUE) - ), - shiny::column(6, - shiny::plotOutput("plot_cat", height = "131px"), - shiny::uiOutput("code_cat") - ) - ), - shiny::fluidRow( - shiny::column(3, - shiny::h4("Brewer"), - shiny::sliderInput("m_div", "Number of colors", - min = 3, max = 20, value = 9) - ), - shiny::column(3, - shiny::h4("Diverging"), - shiny::strong("Contrast range"), - shiny::checkboxInput("auto_div", label = "Automatic", value = TRUE), - shiny::uiOutput("contrast_div_slider") - ), - shiny::column(6, - shiny::plotOutput("plot_div", height = "147px"), - shiny::uiOutput("code_div") - ) - ), - shiny::fluidRow( - shiny::column(3, - shiny::h4("Viridis"), - shiny::sliderInput("m_vir", "Number of colors", - min = 3, max = 20, value = 20)), - shiny::column(3, - shiny::h4("Sequential"), - shiny::sliderInput("contrast_vir", "Contrast range", - min = 0, max = 1, value = c(0, 1), step = .01)), - shiny::column(6, - shiny::h4(), - shiny::plotOutput("plot_vir", height = "85px"), - shiny::uiOutput("code_vir")) - ), - shiny::wellPanel( - shiny::fluidRow( - shiny::column(4, - shiny::h4("Options"), - shiny::checkboxInput("hex", "Print color values", value = FALSE) - ), - shiny::column(4, - shiny::radioButtons("direct_tmap", "Code generator", choices = c("Direct code", "tmap layer function code"), selected = "Direct code", inline = FALSE) - ), - shiny::column(4, - shiny::radioButtons("col_blind", "Color blindness simulator", choices = c("Normal" ="normal", "Deuteranopia" = "deutan", "Protanopia" = "protan", "Tritanopia" = "tritan"), selected = "normal", inline = FALSE) - ) - )) - )), - server = function(input, output) { - - output$contrast_seq_slider <- shiny::renderUI({ - rng <- get_default_contrast("seq", input$m_seq) - if (is.null(input$auto_seq) || input$auto_seq) { - shiny::isolate({ - shiny::div( - style = "font-size:0;margin-top:-20px", - shiny::sliderInput("contrast_seq", "", - min = 0, max = 1, value = c(rng[1], rng[2]), step = .01) - - ) - }) - } else { - shiny::isolate({ - crng <- input$contrast_seq - shiny::div( - style = "font-size:0;margin-top:-20px", - shiny::sliderInput("contrast_seq", "", - min = 0, max = 1, value = c(crng[1], crng[2]), step = .01) - ) - }) - } - }) - output$contrast_div_slider <- shiny::renderUI({ - rng <- get_default_contrast("div", input$m_div) - if (is.null(input$auto_div) || input$auto_div) { - shiny::isolate({ - shiny::div( - style = "font-size:0;margin-top:-20px", - shiny::sliderInput("contrast_div", "", - min = 0, max = 1, value = c(rng[1], rng[2]), step = .01) - ) - }) - } else { - shiny::isolate({ - crng <- input$contrast_div - shiny::div( - style = "font-size:0;margin-top:-20px", - shiny::sliderInput("contrast_div", "", - min = 0, max = 1, value = c(crng[1], crng[2]), step = .01) - ) - }) - } - }) - - shiny::observe({ - input$m_seq - if (input$auto_seq) { - shinyjs::delay(0, { - shinyjs::toggleState("contrast_seq", !input$auto_seq) - }) - } - }) - - shiny::observe({ - input$m_div - if (input$auto_div) { - shinyjs::delay(0, { - shinyjs::toggleState("contrast_div", !input$auto_div) - }) - } - }) - - - output$plot_seq <- shiny::renderPlot({ - if (is.null(input$m_seq) || is.null(input$contrast_seq)) return(NULL) - plot_tmap_pals(type="seq", origin = "brewer", m = input$m_seq, contrast = input$contrast_seq, print.hex = input$hex, col.blind = input$col_blind) - }) - output$plot_cat <- shiny::renderPlot({ - if (is.null(input$m_cat) || is.null(input$stretch)) return(NULL) - plot_tmap_pals(type="qual", origin = "brewer", m = input$m_cat, stretch = input$stretch, print.hex = input$hex, col.blind = input$col_blind) - }) - output$plot_div <- shiny::renderPlot({ - if (is.null(input$m_div) || is.null(input$contrast_div)) return(NULL) - plot_tmap_pals(type="div", origin = "brewer", m = input$m_div, contrast = input$contrast_div, print.hex = input$hex, col.blind = input$col_blind) - }) - - output$plot_vir <- shiny::renderPlot({ - if (is.null(input$m_vir) || is.null(input$contrast_vir)) return(NULL) - plot_tmap_pals(type="seq", origin = "viridis", m = input$m_vir, contrast = input$contrast_vir, print.hex = input$hex, col.blind = input$col_blind) - }) - - - output$code_seq <- shiny::renderUI({ - text <- get_palette_code(type="seq", origin = "brewer", m=input$m_seq, contrast=input$contrast_seq, auto=input$auto_seq, tmap=(input$direct_tmap == "tmap layer function code")) - - shiny::div( - style = "font-family: Lucida Console,Lucida Sans Typewriter,monaco,Bitstream Vera Sans Mono,monospace;text-align:right;", - shiny::p(text) - ) - }) - - output$code_div <- shiny::renderUI({ - text <- get_palette_code(type="div", origin = "brewer", m=input$m_div, contrast=input$contrast_div, auto=input$auto_div, tmap=(input$direct_tmap == "tmap layer function code")) - shiny::div( - style = "font-family: Lucida Console,Lucida Sans Typewriter,monaco,Bitstream Vera Sans Mono,monospace;text-align:right;", - shiny::p(text) - ) - }) - - output$code_cat <- shiny::renderUI({ - text <- get_palette_code(type="cat", origin = "brewer", m=input$m_cat, auto=input$stretch, tmap= (input$direct_tmap == "tmap layer function code")) - shiny::div( - style = "font-family: Lucida Console,Lucida Sans Typewriter,monaco,Bitstream Vera Sans Mono,monospace;text-align:right;", - shiny::p(text) - ) - }) - - output$code_vir <- shiny::renderUI({ - text <- get_palette_code(type="seq", origin = "viridis", m=input$m_vir, contrast=input$contrast_vir, tmap= (input$direct_tmap == "tmap layer function code")) - shiny::div( - style = "font-family: Lucida Console,Lucida Sans Typewriter,monaco,Bitstream Vera Sans Mono,monospace;text-align:right;", - shiny::p(text) - ) - }) - - } - ) -} - -#' @name tmap.pal.info -#' @rdname palette_explorer -#' @export -tmap.pal.info <- local({ - br <- RColorBrewer::brewer.pal.info - br$origin <- factor("brewer", levels = c("brewer", "viridis")) - - vr <- data.frame(maxcolors = rep.int(Inf, 5), category = factor("seq", levels = c("div", "qual", "seq")), origin = factor("viridis", levels = c("brewer", "viridis")), colorblind = c(FALSE, FALSE, FALSE, FALSE, TRUE), row.names = c("viridis", "magma", "plasma", "inferno", "cividis")) - - rbind(br, vr) -}) - - -get_palette_code <- function(type, origin, m, contrast=NULL, auto=FALSE, tmap=FALSE) { - - if (origin == "brewer") { - header <- ifelse(tmap, "tm_polygons(..., palette = ", "get_brewer_pal(") - pal <- ifelse(type=="seq", "\"Blues\"", ifelse(type=="cat", "\"Accent\"", "\"BrBG\"")) - mtext <- paste(", n = ", m, sep="") - cntr <- ifelse(auto || is.null(contrast), "", paste(", contrast = c(", contrast[1], ", ", contrast[2], ")", sep = "")) - apm <- ifelse(type!="cat" || auto, "", ifelse(tmap, ", stretch.palette = FALSE", ", stretch = FALSE")) - tailer <- ifelse(tmap, ", ...)", ")") - - paste(header, pal, mtext, cntr, apm, tailer, sep="") - } else { - header <- ifelse(tmap, "tm_polygons(..., palette = \"viridis\"", "viridisLite::viridis(") - mtext <- ifelse(tmap, paste(", n =", m), m) - cntr <- ifelse(is.null(contrast) || (contrast[1] == 0 && contrast[2] == 1), "", - ifelse(tmap, - paste(", contrast = c(", contrast[1], ", ", contrast[2], ")", sep = ""), - paste0(", begin = ", contrast[1], ", end = ", contrast[2]))) - tailer <- ifelse(tmap, ", ...)", ")") - paste(header, mtext, cntr, tailer, sep="") - } -} - diff --git a/R/tmaptools-package.R b/R/tmaptools-package.R index 9a443b2..0213b21 100644 --- a/R/tmaptools-package.R +++ b/R/tmaptools-package.R @@ -16,9 +16,7 @@ #' #' @section Tool functions (colors): #' \tabular{ll}{ -#' \code{\link{get_brewer_pal}}\tab Get and plot a (modified) Color Brewer palette \cr #' \code{\link{map_coloring}}\tab Find different colors for adjacent polygons \cr -#' \code{\link{palette_explorer}}\tab Explore Color Brewer palettes \cr #' --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr #' } #' @@ -42,15 +40,3 @@ #' @concept thematic maps #' @concept spatial data "_PACKAGE" - -#' Pipe operator -#' -#' The pipe operator from magrittr, \code{\%>\%}, can also be used in functions from \code{tmaptools}. -#' -#' @importFrom magrittr %>% -#' @name %>% -#' @rdname pipe -#' @export -#' @param lhs Left-hand side -#' @param rhs Right-hand side -NULL diff --git a/examples/approx_areas.R b/examples/approx_areas.R index d4a3a98..87b50cb 100644 --- a/examples/approx_areas.R +++ b/examples/approx_areas.R @@ -1,4 +1,4 @@ -if (require(tmap) && packageVersion("tmap") >= "3.99") { +if (require(tmap)) { data(NLD_muni) NLD_muni$area <- approx_areas(NLD_muni, total.area = 33893) @@ -17,17 +17,17 @@ if (require(tmap) && packageVersion("tmap") >= "3.99") { } # area of the polygons - approx_areas(NLD_muni) %>% summary_areas() + summary_areas(approx_areas(NLD_muni)) # area of the polygons, adjusted corrected for a specified total area size - approx_areas(NLD_muni, total.area=33893) %>% summary_areas() + summary_areas(approx_areas(NLD_muni, total.area=33893)) # proportional area of the polygons - approx_areas(NLD_muni, target = "prop") %>% summary_areas() + summary_areas(approx_areas(NLD_muni, target = "prop")) # area in squared miles - approx_areas(NLD_muni, target = "mi mi") %>% summary_areas() + summary_areas(approx_areas(NLD_muni, target = "mi mi")) # area of the polygons when unprojected - approx_areas(NLD_muni %>% sf::st_transform(crs = 4326)) %>% summary_areas() + summary_areas(approx_areas(NLD_muni %>% sf::st_transform(crs = 4326))) } diff --git a/examples/bb.R b/examples/bb.R index 50b2793..b4bb2a9 100644 --- a/examples/bb.R +++ b/examples/bb.R @@ -1,4 +1,4 @@ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap)) { ## load shapes data(NLD_muni) @@ -10,14 +10,17 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { ## extent it by factor 1.10 bb(NLD_muni, ext=1.10) - ## convert to longlat - bb(NLD_muni, projection=4326) - - ## change existing bounding box - bb(NLD_muni, ext=1.5) + ## double the width bb(NLD_muni, width=2, relative = TRUE) + + ## crop both dimensions from 0.25 to 0.75 bb(NLD_muni, xlim=c(.25, .75), ylim=c(.25, .75), relative = TRUE) + ## extent it such that aspect ratio is 1 + bb(NLD_muni, asp.target = 1) + + ## convert to longlat (EPSG 4326) + bb(NLD_muni, projection=4326) } \dontrun{ diff --git a/examples/get_brewer_pal.R b/examples/get_brewer_pal.R deleted file mode 100644 index d0ec856..0000000 --- a/examples/get_brewer_pal.R +++ /dev/null @@ -1,12 +0,0 @@ -get_brewer_pal("Blues") -get_brewer_pal("Blues", contrast=c(.4, .8)) -get_brewer_pal("Blues", contrast=c(0, 1)) -get_brewer_pal("Blues", n=15, contrast=c(0, 1)) - -get_brewer_pal("RdYlGn") -get_brewer_pal("RdYlGn", n=11) -get_brewer_pal("RdYlGn", n=11, contrast=c(0, .4)) -get_brewer_pal("RdYlGn", n=11, contrast=c(.4, 1)) - -get_brewer_pal("Set2", n = 12) -get_brewer_pal("Set2", n = 12, stretch = FALSE) diff --git a/examples/map_coloring.R b/examples/map_coloring.R index 11ec146..7e97f31 100644 --- a/examples/map_coloring.R +++ b/examples/map_coloring.R @@ -1,11 +1,20 @@ -if (require(tmap) && packageVersion("tmap") >= "3.99") { - data(World, metro) +if (require(tmap) && require(cols4all)) { + data(World) - World$color <- map_coloring(World, palette="Pastel2") - qtm(World, fill = "color") + ## using cols4all directly + indices <- map_coloring(World) + pal <- c4a("brewer.set2", n = max(indices)) + World$color = pal[indices] + tm_shape(World) + + tm_polygons("color", fill.scale = tm_scale_asis()) + + tm_crs("auto") - # map_coloring used indirectly: qtm(World, fill = "MAP_COLORS") + # using map_coloring via "MAP_COLORS" in tmap + tm_shape(World) + + tm_polygons("MAP_COLORS", tm_scale(values = "brewer.set2")) + + tm_crs("auto") + # other example data(NLD_prov, NLD_muni) tm_shape(NLD_prov) + tm_fill("name", diff --git a/examples/palette_explorer.R b/examples/palette_explorer.R deleted file mode 100644 index 6d644af..0000000 --- a/examples/palette_explorer.R +++ /dev/null @@ -1,5 +0,0 @@ -\dontrun{ -if (require(shiny) && require(shinyjs)) { - palette_explorer() -} -} diff --git a/examples/simplify_shape.R b/examples/simplify_shape.R index f98b0a0..94385d1 100644 --- a/examples/simplify_shape.R +++ b/examples/simplify_shape.R @@ -3,18 +3,18 @@ if (require(tmap)) { data(World) # show different simplification factors - tm1 <- qtm(World %>% simplify_shape(fact = 0.05), title="Simplify 0.05") - tm2 <- qtm(World %>% simplify_shape(fact = 0.1), title="Simplify 0.1") - tm3 <- qtm(World %>% simplify_shape(fact = 0.2), title="Simplify 0.2") - tm4 <- qtm(World %>% simplify_shape(fact = 0.5), title="Simplify 0.5") + tm1 <- qtm(simplify_shape(World, fact = 0.05), title="Simplify 0.05") + tm2 <- qtm(simplify_shape(World, fact = 0.1), title="Simplify 0.1") + tm3 <- qtm(simplify_shape(World, fact = 0.2), title="Simplify 0.2") + tm4 <- qtm(simplify_shape(World, fact = 0.5), title="Simplify 0.5") tmap_arrange(tm1, tm2, tm3, tm4) # show different options for keeping smaller (sub)units - tm5 <- qtm(World %>% simplify_shape(keep.units = TRUE, keep.subunits = TRUE), + tm5 <- qtm(simplify_shape(World, keep.units = TRUE, keep.subunits = TRUE), title="Keep units and subunits") - tm6 <- qtm(World %>% simplify_shape(keep.units = TRUE, keep.subunits = FALSE), + tm6 <- qtm(simplify_shape(World, keep.units = TRUE, keep.subunits = FALSE), title="Keep units, ignore small subunits") - tm7 <- qtm(World %>% simplify_shape(keep.units = FALSE), + tm7 <- qtm(simplify_shape(World, keep.units = FALSE), title="Ignore small units and subunits") tmap_arrange(tm5, tm6, tm7) } diff --git a/man/approx_areas.Rd b/man/approx_areas.Rd index f8f5cbf..13b37f1 100644 --- a/man/approx_areas.Rd +++ b/man/approx_areas.Rd @@ -30,7 +30,7 @@ Approximate the area sizes of the polygons in real-world area units (such as sq Note that the method of determining areas is an approximation, since it depends on the used projection and the level of detail of the shape object. Projections with equal-area property are highly recommended. See \url{https://en.wikipedia.org/wiki/List_of_map_projections} for equal area world map projections. } \examples{ -if (require(tmap) && packageVersion("tmap") >= "3.99") { +if (require(tmap)) { data(NLD_muni) NLD_muni$area <- approx_areas(NLD_muni, total.area = 33893) @@ -49,19 +49,19 @@ if (require(tmap) && packageVersion("tmap") >= "3.99") { } # area of the polygons - approx_areas(NLD_muni) \%>\% summary_areas() + summary_areas(approx_areas(NLD_muni)) # area of the polygons, adjusted corrected for a specified total area size - approx_areas(NLD_muni, total.area=33893) \%>\% summary_areas() + summary_areas(approx_areas(NLD_muni, total.area=33893)) # proportional area of the polygons - approx_areas(NLD_muni, target = "prop") \%>\% summary_areas() + summary_areas(approx_areas(NLD_muni, target = "prop")) # area in squared miles - approx_areas(NLD_muni, target = "mi mi") \%>\% summary_areas() + summary_areas(approx_areas(NLD_muni, target = "mi mi")) # area of the polygons when unprojected - approx_areas(NLD_muni \%>\% sf::st_transform(crs = 4326)) \%>\% summary_areas() + summary_areas(approx_areas(NLD_muni \%>\% sf::st_transform(crs = 4326))) } } \seealso{ diff --git a/man/approx_distances.Rd b/man/approx_distances.Rd index 00d1e5a..589fe62 100644 --- a/man/approx_distances.Rd +++ b/man/approx_distances.Rd @@ -11,7 +11,7 @@ approx_distances(x, y = NULL, projection = NULL, target = NULL) \item{y}{a pair of coordintes, vector of two. Only required when \code{x} is also a pair of coordintes.} -\item{projection}{projection code, needed in case \code{x} is a bounding box or when \code{x} and \code{y} are pairs of coordinates. See \code{\link{get_proj4}}} +\item{projection}{projection code, needed in case \code{x} is a bounding box or when \code{x} and \code{y} are pairs of coordinates.} \item{target}{target unit, one of: \code{"m"}, \code{"km"}, \code{"mi"}, and \code{"ft"}.} } diff --git a/man/bb.Rd b/man/bb.Rd index e81ac30..0081995 100644 --- a/man/bb.Rd +++ b/man/bb.Rd @@ -80,7 +80,7 @@ A new bounding box can be created from scratch as follows: } } \examples{ -if (require(tmap) && packageVersion("tmap") >= "2.0") { +if (require(tmap)) { ## load shapes data(NLD_muni) @@ -92,14 +92,17 @@ if (require(tmap) && packageVersion("tmap") >= "2.0") { ## extent it by factor 1.10 bb(NLD_muni, ext=1.10) - ## convert to longlat - bb(NLD_muni, projection=4326) - - ## change existing bounding box - bb(NLD_muni, ext=1.5) + ## double the width bb(NLD_muni, width=2, relative = TRUE) + + ## crop both dimensions from 0.25 to 0.75 bb(NLD_muni, xlim=c(.25, .75), ylim=c(.25, .75), relative = TRUE) + ## extent it such that aspect ratio is 1 + bb(NLD_muni, asp.target = 1) + + ## convert to longlat (EPSG 4326) + bb(NLD_muni, projection=4326) } \dontrun{ diff --git a/man/deprecated_functions.Rd b/man/deprecated_functions.Rd deleted file mode 100644 index 9f36dee..0000000 --- a/man/deprecated_functions.Rd +++ /dev/null @@ -1,60 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deprecated.R -\name{deprecated_functions} -\alias{deprecated_functions} -\alias{get_proj4} -\alias{set_projection} -\alias{get_projection} -\alias{is_projected} -\title{Deprecated tmaptools functions} -\usage{ -get_proj4(x, output = c("crs", "character", "epsg", "CRS")) - -set_projection( - shp, - projection = NA, - current.projection = NA, - overwrite.current.projection = FALSE -) - -get_projection( - shp, - guess.longlat = FALSE, - output = c("character", "crs", "epsg", "CRS") -) - -is_projected(x) -} -\arguments{ -\item{x}{see documentation in tmaptools 2.x for details} - -\item{output}{see documentation in tmaptools 2.x for details} - -\item{shp}{see documentation in tmaptools 2.x for details} - -\item{projection}{see documentation in tmaptools 2.x for details} - -\item{current.projection}{see documentation in tmaptools 2.x for details} - -\item{overwrite.current.projection}{see documentation in tmaptools 2.x for details} - -\item{guess.longlat}{see documentation in tmaptools 2.x for details - -Deprecated as of version 2.0 -\itemize{ - \item \code{append_data}, \code{aggregate_map}, \code{double_line}, \code{points_to_raster}, \code{poly_to_raster}, \code{sample_dots}, \code{sbind}, \code{smooth_map}, \code{smooth_raster_cover}, \code{read_shape}, \code{write_shape}. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} - \item \code{osm_poly}, \code{osm_line}, \code{osm_point}. Please use the package \code{osmdata} -} - -Deprecated as of version 3.0 -\itemize{ - \item \code{get_proj4}: for projections, please use the function \code{\link[sf:st_crs]{st_crs}} - \item \code{set_projection} for setting map projections, use \code{\link[sf:st_crs]{st_crs}} or \code{\link[sf:st_transform]{st_transform}} - \item \code{get_projection} for getting map projections, use \code{\link[sf:st_crs]{st_crs}} - \item \code{is_projected} for checking if projections are long lat coordinates, use \code{\link[sf:st_is_longlat]{st_is_longlat}} -}} -} -\description{ -The following functions are not used anymore or deprecated as of tmaptools version 3.0. These functions are based on the \code{sp} package and are not supported anymore. They have been migrated to \url{https://github.com/mtennekes/oldtmaptools} -} -\keyword{internal} diff --git a/man/get_brewer_pal.Rd b/man/get_brewer_pal.Rd deleted file mode 100644 index e35f55b..0000000 --- a/man/get_brewer_pal.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_brewer_pal.R -\name{get_brewer_pal} -\alias{get_brewer_pal} -\title{Get and plot a (modified) Color Brewer palette (deprecated)} -\usage{ -get_brewer_pal(palette, n = 5, contrast = NA, stretch = TRUE, plot = TRUE) -} -\arguments{ -\item{palette}{name of the color brewer palette. Run \code{\link{palette_explorer}} or see \code{\link[RColorBrewer:ColorBrewer]{brewer.pal}} for options.} - -\item{n}{number of colors} - -\item{contrast}{a vector of two numbers between 0 and 1 that defines the contrast range of the palette. Applicable to sequential and diverging palettes. For sequential palettes, 0 stands for the leftmost color and 1 the rightmost color. For instance, when \code{contrast=c(.25, .75)}, then the palette ranges from 1/4 to 3/4 of the available color range. For diverging palettes, 0 stands for the middle color and 1 for both outer colors. If only one number is provided, the other number is set to 0. The default value depends on \code{n}. See details.} - -\item{stretch}{logical that determines whether intermediate colors are used for a categorical palette when \code{n} is greater than the number of available colors.} - -\item{plot}{should the palette be plot, or only returned? If \code{TRUE} the palette is silently returned.} -} -\value{ -vector of color values. It is silently returned when \code{plot=TRUE}. -} -\description{ -Get and plot a (modified) palette from Color Brewer. This function is deprecated. Please use \code{\link[cols4all:c4a]{c4a}} instead. -} -\details{ -The default contrast of the palette depends on the number of colors, \code{n}, in the following way. The default contrast is maximal, so \code{(0, 1)}, when \code{n = 9} for sequential palettes and \code{n = 11} for diverging palettes. The default contrast values for smaller values of \code{n} can be extracted with some R magic: \code{sapply(1:9, tmaptools:::default_contrast_seq)} for sequential palettes and \code{sapply(1:11, tmaptools:::default_contrast_div)} for diverging palettes. -} -\examples{ -get_brewer_pal("Blues") -get_brewer_pal("Blues", contrast=c(.4, .8)) -get_brewer_pal("Blues", contrast=c(0, 1)) -get_brewer_pal("Blues", n=15, contrast=c(0, 1)) - -get_brewer_pal("RdYlGn") -get_brewer_pal("RdYlGn", n=11) -get_brewer_pal("RdYlGn", n=11, contrast=c(0, .4)) -get_brewer_pal("RdYlGn", n=11, contrast=c(.4, 1)) - -get_brewer_pal("Set2", n = 12) -get_brewer_pal("Set2", n = 12, stretch = FALSE) -} -\seealso{ -\code{\link{palette_explorer}} -} diff --git a/man/map_coloring.Rd b/man/map_coloring.Rd index 48867cb..4fd488f 100644 --- a/man/map_coloring.Rd +++ b/man/map_coloring.Rd @@ -4,14 +4,7 @@ \alias{map_coloring} \title{Map coloring} \usage{ -map_coloring( - x, - algorithm = "greedy", - ncols = NA, - minimize = FALSE, - palette = NULL, - contrast = 1 -) +map_coloring(x, algorithm = "greedy", ncols = NA, minimize = FALSE, ...) } \arguments{ \item{x}{Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list.} @@ -22,25 +15,35 @@ map_coloring( \item{minimize}{logical that determines whether \code{algorithm} will search for a minimal number of colors. If \code{FALSE}, the \code{ncols} colors will be picked by a random procedure.} -\item{palette}{color palette.} - -\item{contrast}{vector of two numbers that determine the range that is used for sequential and diverging palettes (applicable when \code{auto.palette.mapping=TRUE}). Both numbers should be between 0 and 1. The first number determines where the palette begins, and the second number where it ends. For sequential palettes, 0 means the brightest color, and 1 the darkest color. For diverging palettes, 0 means the middle color, and 1 both extremes. If only one number is provided, this number is interpreted as the endpoint (with 0 taken as the start).} +\item{...}{to catch deprecated arguments \code{palette} and \code{contrast}. See details.} } \value{ -If \code{palette} is defined, a vector of colors is returned, otherwise a vector of color indices. +A vector of color indices. } \description{ -Color the polygons of a map such that adjacent polygons have different colors +Color the polygons of a map such that adjacent polygons have different colors. This function returns the color indices +} +\details{ +As of tmaptools 3.3, the deprecated color functions \code{get_brewer_pal} and \code{palette_explorer}, have been removed. These have been replaced \code{c4a} and \code{c4a_gui} respectively from the package cols4all. Therefore, \code{map_coloring} will return color indices and will ignore the input arguments \code{palette} and \code{contrast}. See example. } \examples{ -if (require(tmap) && packageVersion("tmap") >= "3.99") { - data(World, metro) - - World$color <- map_coloring(World, palette="Pastel2") - qtm(World, fill = "color") - - # map_coloring used indirectly: qtm(World, fill = "MAP_COLORS") - +if (require(tmap) && require(cols4all)) { + data(World) + + ## using cols4all directly + indices <- map_coloring(World) + pal <- c4a("brewer.set2", n = max(indices)) + World$color = pal[indices] + tm_shape(World) + + tm_polygons("color", fill.scale = tm_scale_asis()) + + tm_crs("auto") + + # using map_coloring via "MAP_COLORS" in tmap + tm_shape(World) + + tm_polygons("MAP_COLORS", tm_scale(values = "brewer.set2")) + + tm_crs("auto") + + # other example data(NLD_prov, NLD_muni) tm_shape(NLD_prov) + tm_fill("name", diff --git a/man/palette_explorer.Rd b/man/palette_explorer.Rd deleted file mode 100644 index 3dea467..0000000 --- a/man/palette_explorer.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/palette_explorer.R -\docType{data} -\name{palette_explorer} -\alias{palette_explorer} -\alias{tmap.pal.info} -\title{Explore color palettes (deprecated)} -\format{ -An object of class \code{data.frame} with 40 rows and 4 columns. -} -\usage{ -palette_explorer() - -tmap.pal.info -} -\description{ -This interactive tool has become deprecated and will not be maintained anymore. Please use \code{\link[cols4all:c4a_gui]{c4a_gui}} instead. -} -\details{ -\code{palette_explorer()} starts an interactive tool shows all Color Brewer and viridis palettes, where the number of colors can be adjusted as well as the constrast range. Categorical (qualitative) palettes can be stretched when the number of colors exceeds the number of palette colors. Output code needed to get the desired color values is generated. Finally, all colors can be tested for color blindness. The data.frame \code{tmap.pal.info} is similar to \code{\link[RColorBrewer:ColorBrewer]{brewer.pal.info}}, but extended with the color palettes from viridis. -} -\examples{ -\dontrun{ -if (require(shiny) && require(shinyjs)) { - palette_explorer() -} -} -} -\references{ -\url{https://www.color-blindness.com/types-of-color-blindness/} -} -\seealso{ -\code{\link{get_brewer_pal}}, \code{\link[dichromat:dichromat]{dichromat}}, \code{\link[RColorBrewer:ColorBrewer]{RColorBrewer}} -} -\keyword{datasets} diff --git a/man/pipe.Rd b/man/pipe.Rd deleted file mode 100644 index f7e15b8..0000000 --- a/man/pipe.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tmaptools-package.R -\name{\%>\%} -\alias{\%>\%} -\title{Pipe operator} -\arguments{ -\item{lhs}{Left-hand side} - -\item{rhs}{Right-hand side} -} -\description{ -The pipe operator from magrittr, \code{\%>\%}, can also be used in functions from \code{tmaptools}. -} diff --git a/man/simplify_shape.Rd b/man/simplify_shape.Rd index 58f3ab9..41708ae 100644 --- a/man/simplify_shape.Rd +++ b/man/simplify_shape.Rd @@ -32,18 +32,18 @@ if (require(tmap)) { data(World) # show different simplification factors - tm1 <- qtm(World \%>\% simplify_shape(fact = 0.05), title="Simplify 0.05") - tm2 <- qtm(World \%>\% simplify_shape(fact = 0.1), title="Simplify 0.1") - tm3 <- qtm(World \%>\% simplify_shape(fact = 0.2), title="Simplify 0.2") - tm4 <- qtm(World \%>\% simplify_shape(fact = 0.5), title="Simplify 0.5") + tm1 <- qtm(simplify_shape(World, fact = 0.05), title="Simplify 0.05") + tm2 <- qtm(simplify_shape(World, fact = 0.1), title="Simplify 0.1") + tm3 <- qtm(simplify_shape(World, fact = 0.2), title="Simplify 0.2") + tm4 <- qtm(simplify_shape(World, fact = 0.5), title="Simplify 0.5") tmap_arrange(tm1, tm2, tm3, tm4) # show different options for keeping smaller (sub)units - tm5 <- qtm(World \%>\% simplify_shape(keep.units = TRUE, keep.subunits = TRUE), + tm5 <- qtm(simplify_shape(World, keep.units = TRUE, keep.subunits = TRUE), title="Keep units and subunits") - tm6 <- qtm(World \%>\% simplify_shape(keep.units = TRUE, keep.subunits = FALSE), + tm6 <- qtm(simplify_shape(World, keep.units = TRUE, keep.subunits = FALSE), title="Keep units, ignore small subunits") - tm7 <- qtm(World \%>\% simplify_shape(keep.units = FALSE), + tm7 <- qtm(simplify_shape(World, keep.units = FALSE), title="Ignore small units and subunits") tmap_arrange(tm5, tm6, tm7) } diff --git a/man/tmaptools-package.Rd b/man/tmaptools-package.Rd index e237df1..102d6fc 100644 --- a/man/tmaptools-package.Rd +++ b/man/tmaptools-package.Rd @@ -26,9 +26,7 @@ This page provides a brief overview of all package functions. \section{Tool functions (colors)}{ \tabular{ll}{ -\code{\link{get_brewer_pal}}\tab Get and plot a (modified) Color Brewer palette \cr \code{\link{map_coloring}}\tab Find different colors for adjacent polygons \cr -\code{\link{palette_explorer}}\tab Explore Color Brewer palettes \cr --------------------------- \tab --------------------------------------------------------------------------------------------------- \cr } } From c26fe8156afe73a7f9af6ce5100cd5a02bd61e4b Mon Sep 17 00:00:00 2001 From: mtennekes Date: Wed, 23 Jul 2025 10:35:45 +0200 Subject: [PATCH 43/44] cleaned up --- DESCRIPTION | 10 +--- NAMESPACE | 1 - R/map_coloring.R | 13 +--- R/xxx_scales.R | 128 ---------------------------------------- examples/approx_areas.R | 2 +- man/approx_areas.Rd | 2 +- man/map_coloring.Rd | 4 +- 7 files changed, 8 insertions(+), 152 deletions(-) delete mode 100644 R/xxx_scales.R diff --git a/DESCRIPTION b/DESCRIPTION index 823f417..a86780e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,12 +15,7 @@ Imports: lwgeom (>= 0.1-4), stars (>= 0.4-1), units (>= 0.6-1), - grid, - magrittr, - RColorBrewer, - viridisLite, stats, - dichromat, XML Suggests: tmap, @@ -28,10 +23,7 @@ Suggests: rmapshaper, osmdata, OpenStreetMap, - raster, - png, - shiny, - shinyjs + raster URL: https://github.com/r-tmap/tmaptools, https://r-tmap.github.io/tmaptools/ BugReports: https://github.com/r-tmap/tmaptools/issues RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 8f251d2..6a521b4 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,7 +15,6 @@ export(read_GPX) export(read_osm) export(rev_geocode_OSM) export(simplify_shape) -import(RColorBrewer) import(sf) importFrom(XML,xmlAttrs) importFrom(XML,xmlChildren) diff --git a/R/map_coloring.R b/R/map_coloring.R index 5ce51dd..a2a09fb 100644 --- a/R/map_coloring.R +++ b/R/map_coloring.R @@ -6,14 +6,13 @@ #' #' @param x Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list. #' @param algorithm currently, only "greedy" is implemented. -#' @param ncols number of colors. By default it is 8 when \code{palette} is undefined. Else, it is set to the length of \code{palette} +#' @param ncols number of colors. By default 8. #' @param minimize logical that determines whether \code{algorithm} will search for a minimal number of colors. If \code{FALSE}, the \code{ncols} colors will be picked by a random procedure. #' @param ... to catch deprecated arguments \code{palette} and \code{contrast}. See details. #' @return A vector of color indices. #' @example ./examples/map_coloring.R -#' @import RColorBrewer #' @export -map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, ...) { +map_coloring <- function(x, algorithm="greedy", ncols=8, minimize=FALSE, ...) { if (inherits(x, "Spatial")) x <- as(x, "sf") if (inherits(x, "sf")) { # get adjacency list @@ -25,8 +24,6 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, ...) { args= list(...) if (any(c("palette", "contrast") %in% names(args))) warning("palette and contrast are not used anymore as of tmaptools 3.3. Please use cols4all: see manual") - if (is.na(ncols)) ncols <- 8 - k <- length(adj) if (algorithm=="greedy") { @@ -56,11 +53,7 @@ map_coloring <- function(x, algorithm="greedy", ncols=NA, minimize=FALSE, ...) { if (showWarn) warning("Unable to color with ", ncols, " colors. Adjacent polygons may have the same color.", call. = FALSE) - if (!is.null(palette)) { - palette2[cols] - } else { - cols - } + cols } #' Get neighbours list from spatial objects diff --git a/R/xxx_scales.R b/R/xxx_scales.R deleted file mode 100644 index 015e3a1..0000000 --- a/R/xxx_scales.R +++ /dev/null @@ -1,128 +0,0 @@ -are_breaks_diverging <- function(brks) { - # if !divx then c-Inf, 2, 5, 10) is considered sequential - negb <- any(brks[brks!=-Inf]<0) || (brks[1] == -Inf && brks[2]<=0) - nb <- length(brks) - posb <- any(brks[brks!=Inf]>0) || (brks[nb] == Inf && brks[nb-1]>=0) - negb && posb -} - - -# Map breaks to index numbers of a diverging colour scale -# -# Determines index numbers of a potential diverging colour scale given a vector of breaks. -# -# @param breaks vector of breaks -# @param n number of classes, i.e. the length of a diverging colour palette. This should preferable be an odd number, since it contains a neutral middle color. -# @param contrast value between 0 and 1 that determines how much of the \code{(1, n)} range is used. Value \code{contrast=1} means that the most extreme break value, i.e. \code{max(abs(breaks))} is maped to either 1 or n (depending on whether it is a minimum or maximum). There is no contrast at all for \code{contrast=0}, i.e. all index numbers will correspond to the middle class (which has index number \code{((n-1)/2)+1}. -# @return vector of index numbers -map2divscaleID <- function(breaks, n=101, contrast=1) { - nbrks <- length(breaks) - - if (length(contrast)==1) { - contrast <- c(0, contrast) - } - crange <- contrast[2] - contrast[1] - - lw <- breaks[1] - hg <- breaks[nbrks] - - # omit infinity values - if (lw==-Inf) lw <- breaks[2] - if (hg==Inf) hg <- breaks[nbrks-1] - mx <- max(abs(c(lw, hg))) - - - is.div <- any(breaks<0) && any(breaks>0) - - cat0 <- !any(breaks==0) - - h <- ((n-1)/2)+1 - - if (is.div && !cat0) { - npos <- sum(breaks>0) - nneg <- sum(breaks<0) - step <- round((h-1)*crange/((max(npos, nneg)-.5)*2)) - } else { - npos <- sum(breaks>=0) - !is.div - nneg <- sum(breaks<=0) - !is.div - step <- 0 - } - - pid <- h + step - nid <- h - step - - ids <- rep(h, nbrks-1) - if (npos>0) ids[(nbrks-npos):(nbrks-1)] <- pid + - seq((n-pid)/mx*hg*contrast[1], (n-pid)/mx*hg*contrast[2], length.out=npos) - if (nneg>0) ids[1:nneg] <- seq(nid-((nid-1)/mx*-lw*contrast[2]), nid-((nid-1)/mx*-lw*contrast[1]), - length.out=nneg) - if (is.div && cat0) ids[nneg] <- h - round(ids) -} - - - -# Map breaks to index numbers of a sequential colour scale -# -# Determines index numbers of a potential sequential colour scale given a vector of breaks. -# -# @param breaks vector of breaks -# @param n number of classes, i.e. the length of a sequential colour palette. -# @param contrast value between 0 and 1 that determines how much of the \code{(1, n)} range is used. Value \code{contrast=1} means that the most extreme break value, i.e. \code{max(abs(breaks))} is maped to n. There is no contrast at all for \code{contrast=0}, i.e. all index numbers will correspond to the first class (which has index number \code{1}. -# @param breaks.specified logical that determines whether breaks have been specified by the user. If so a warning is shown if breaks are diverging. -# @return vector of index numbers -map2seqscaleID <- function(breaks, n=101, contrast=1, breaks.specified=TRUE, impute=TRUE) { - if (are_breaks_diverging(breaks) && breaks.specified) warning("Breaks contains positive and negative values. Better is to use diverging scale instead, or set auto.palette.mapping to FALSE.", call. = FALSE) - m <- (n*2)-1 - mh <- ((m-1)/2)+1 - ids <- map2divscaleID(breaks, n=m, contrast=contrast) - - ids <- if (any(breaks>0)) { - ids - mh + 1 - } else { - (mh+1) - ids - } - - # checks: - if (any(ids>n)) { - if (impute) { - ids[ids>n] <- n - } else { - warning("Some index numbers exceed n and are replaced by NA", call. = FALSE) - ids[ids>n] <- NA - } - - } else if (any(ids<1)) { - if (impute) { - ids[ids<1] <- 1 - } else { - warning("Some index numbers exceed 0 and are replaced by NA", call. = FALSE) - ids[ids<1] <- NA - } - } - round(ids) -} - - - -# function to determine whether a diverging of sequential palette is used given the values and the breaks -use_diverging_palette <- function(v, brks) { - x <- na.omit(v) - divx <- any(x<0) && any(x>0) - - if (divx || is.null(brks)) { - return(divx) - } else { - are_breaks_diverging(brks) - } -} - -default_contrast_seq <- function(k) { - c1 <- max((9-k) * (.15/6), 0) - c2 <- min(.7 + (k-3) * (.3/6), 1) - c(c1,c2) -} - -default_contrast_div <- function(k) { - c(0, min(.6 + (k-3) * (.4/8), 1)) -} diff --git a/examples/approx_areas.R b/examples/approx_areas.R index 87b50cb..028b9b9 100644 --- a/examples/approx_areas.R +++ b/examples/approx_areas.R @@ -29,5 +29,5 @@ if (require(tmap)) { summary_areas(approx_areas(NLD_muni, target = "mi mi")) # area of the polygons when unprojected - summary_areas(approx_areas(NLD_muni %>% sf::st_transform(crs = 4326))) + summary_areas(approx_areas(sf::st_transform(NLD_muni, crs = 4326))) } diff --git a/man/approx_areas.Rd b/man/approx_areas.Rd index 13b37f1..8430346 100644 --- a/man/approx_areas.Rd +++ b/man/approx_areas.Rd @@ -61,7 +61,7 @@ if (require(tmap)) { summary_areas(approx_areas(NLD_muni, target = "mi mi")) # area of the polygons when unprojected - summary_areas(approx_areas(NLD_muni \%>\% sf::st_transform(crs = 4326))) + summary_areas(approx_areas(sf::st_transform(NLD_muni, crs = 4326))) } } \seealso{ diff --git a/man/map_coloring.Rd b/man/map_coloring.Rd index 4fd488f..f52a179 100644 --- a/man/map_coloring.Rd +++ b/man/map_coloring.Rd @@ -4,14 +4,14 @@ \alias{map_coloring} \title{Map coloring} \usage{ -map_coloring(x, algorithm = "greedy", ncols = NA, minimize = FALSE, ...) +map_coloring(x, algorithm = "greedy", ncols = 8, minimize = FALSE, ...) } \arguments{ \item{x}{Either a shape (i.e. a \code{\link[sf:sf]{sf}} or \code{SpatialPolygons(DataFrame)} (\code{sp} package) object), or an adjacency list.} \item{algorithm}{currently, only "greedy" is implemented.} -\item{ncols}{number of colors. By default it is 8 when \code{palette} is undefined. Else, it is set to the length of \code{palette}} +\item{ncols}{number of colors. By default 8.} \item{minimize}{logical that determines whether \code{algorithm} will search for a minimal number of colors. If \code{FALSE}, the \code{ncols} colors will be picked by a random procedure.} From cbab775654492bf82f5bd7c70ee91da42a96f046 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Thu, 24 Jul 2025 16:40:38 +0200 Subject: [PATCH 44/44] submitted to CRAN 3.3 --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a86780e..4c17b58 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -6,7 +6,6 @@ Authors@R: person("Martijn", "Tennekes", email = "mtennekes@gmail.com", role = c Description: Set of tools for reading and processing spatial data. The aim is to supply the workflow to create thematic maps. This package also facilitates 'tmap', the package for visualizing thematic maps. License: GPL-3 Encoding: UTF-8 -Date: 2025-07-22 Depends: R (>= 3.5), methods