From b54d500976b931ff81be4e97fa9a88fbc3813909 Mon Sep 17 00:00:00 2001 From: Jan Caha Date: Thu, 16 Apr 2020 11:30:02 +0000 Subject: [PATCH] version 0.6.1 --- DESCRIPTION | 10 ++-- MD5 | 22 ++++---- NAMESPACE | 3 +- NEWS.md | 5 ++ R/RcppExports.R | 4 +- R/kde.R | 32 ++++++++--- build/vignette.rds | Bin 210 -> 210 bytes inst/doc/SpatialKDE.html | 114 +++++++++++++++++++++----------------- man/kde.Rd | 3 + src/RcppExports.cpp | 9 +-- src/kde.cpp | 19 +++++-- tests/testthat/test-kde.R | 13 +++++ 12 files changed, 147 insertions(+), 87 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 685fc41..458cfc7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SpatialKDE Type: Package Title: Kernel Density Estimation for Spatial Data -Version: 0.5.0 +Version: 0.6.1 URL: https://jancaha.github.io/SpatialKDE/index.html, https://github.com/JanCaha/SpatialKDE Authors@R: @@ -18,14 +18,14 @@ Description: Calculate Kernel Density Estimation (KDE) for spatial data. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 7.0.2 +RoxygenNote: 7.1.0 VignetteBuilder: knitr LinkingTo: Rcpp Imports: Rcpp, sf, dplyr, glue, magrittr, rlang, methods, raster -Suggests: tmap, sp, knitr, testthat (>= 2.1.0) +Suggests: tmap, sp, knitr, rgdal, testthat (>= 2.1.0) NeedsCompilation: yes -Packaged: 2019-12-16 08:14:56 UTC; Caha +Packaged: 2020-04-16 12:09:30 UTC; Cahik Author: Jan Caha [aut, cre] () Maintainer: Jan Caha Repository: CRAN -Date/Publication: 2019-12-16 11:40:06 UTC +Date/Publication: 2020-04-16 12:30:02 UTC diff --git a/MD5 b/MD5 index aa1a0f0..8946973 100644 --- a/MD5 +++ b/MD5 @@ -1,26 +1,26 @@ -45dac6d9b8643dcc67e022fdc27f2026 *DESCRIPTION +c75c9c1416bbd11badabcf0c3bc5e112 *DESCRIPTION 82179e94a9c57510eeb0dfa196cd97cb *LICENSE -f9384b67978f362e89b618ef0b1b5a48 *NAMESPACE -156fd5b034e4172f87effa1677d5cc1b *NEWS.md -46ff90eda42db6d37a5a20a97cecc8d1 *R/RcppExports.R +09594a0a342b8d125bd90783bd40fc58 *NAMESPACE +bc1288350d26e12bc7c34f4deb461799 *NEWS.md +261b4ed94b2c65db40b1346ea1b5f8b8 *R/RcppExports.R e11ac6cfc676e4a3d0ebc35c4492e8de *R/create_grid.R bb39c117653c3bf19fcde4d7aea1dd6c *R/create_raster.R -eefb7801ac5594fea1f9bad03ccfc4a8 *R/kde.R +ce451a459864bb5ee71ba1e215d3c8a6 *R/kde.R ad3f3c64fcdb96e66b1859bd35c48478 *R/utils-pipe.R ea034c24e4e96a741e65721835b733cf *R/utils.R 6e0dc28feda82e7c39bb6b1638ad036b *R/zzz.R fc09e35d33437d635f6361e42c35696e *README.md -0e95615d823df27d4b2a94e7be3a749a *build/vignette.rds +ec9a9453d1de23a3d825296f5a447668 *build/vignette.rds 512913a6d2935ccb9dc5d5dc73640404 *inst/doc/SpatialKDE.R abf6cca3ed36a52d85d0c50a4c33a8d2 *inst/doc/SpatialKDE.Rmd -f70b055123458caa7ef0afa06fc47d4b *inst/doc/SpatialKDE.html +f36f8bece0e36a12e5db5be9951bf64f *inst/doc/SpatialKDE.html fc333f44de04b8cb7aec0ce9c2d3ff15 *man/create_grid.Rd 89e5d758105098f7ca26068280fd22ad *man/create_raster.Rd -00277ed05f610057238f0007553ded4e *man/kde.Rd +bb5149c39556450a9a8b53c1a39bf04a *man/kde.Rd 1f7896a1b866ff9ae89ba35be7c7b6f1 *man/pipe.Rd -c8e651984bf03903e92a85a54f4e79b4 *src/RcppExports.cpp -746686d03189a416b9c16fb0536c1489 *src/kde.cpp +a5a0dbeb761d861d47a0af14d890dcf3 *src/RcppExports.cpp +8cb810d2b3ca2f4a7f7dd7a2a11707a3 *src/kde.cpp 70b197edb62a1a7250b6a1aa009a5ecd *tests/testthat.R 78b8bef43e80f100e302e047fabaa9af *tests/testthat/test-create_grids_raster.R -9ba68f18046da3b5bd6f4474671a677b *tests/testthat/test-kde.R +2fda00f85833aad168b7a1bc926f1f49 *tests/testthat/test-kde.R abf6cca3ed36a52d85d0c50a4c33a8d2 *vignettes/SpatialKDE.Rmd diff --git a/NAMESPACE b/NAMESPACE index bb1348c..3ac823d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,4 @@ -# Generated by roxygen2: do not edit by hand +# Generated by roxygen2: do not edit by hand export("%>%") export(create_grid_hexagonal) @@ -20,6 +20,7 @@ importFrom(raster,values) importFrom(raster,xyFromCell) importFrom(rlang,.data) importFrom(rlang,enquo) +importFrom(rlang,is_double) importFrom(rlang,quo_text) importFrom(sf,st_as_sf) importFrom(sf,st_bbox) diff --git a/NEWS.md b/NEWS.md index 8118129..6058019 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# SpatialKDE 0.6.0 + +* added `weights` parameter to `kde()` + + # SpatialKDE 0.4.0 * rename of `create_raster_rectangular()` to `create_grid_rectangular()` and `create_raster_hexagonal()` to `create_grid_hexagonal()` to avoid confusion about the type of outcome. diff --git a/R/RcppExports.R b/R/RcppExports.R index fb55986..b08c76b 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,7 +1,7 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 -kde_estimate <- function(fishnet, points, bw, kernel, scaled = FALSE, decay = 1) { - .Call('_SpatialKDE_kde_estimate', PACKAGE = 'SpatialKDE', fishnet, points, bw, kernel, scaled, decay) +kde_estimate <- function(fishnet, points, bw, kernel, scaled = FALSE, decay = 1, weights = numeric(0)) { + .Call('_SpatialKDE_kde_estimate', PACKAGE = 'SpatialKDE', fishnet, points, bw, kernel, scaled, decay, weights) } diff --git a/R/kde.R b/R/kde.R index 16c1df5..ecd0e49 100644 --- a/R/kde.R +++ b/R/kde.R @@ -20,6 +20,7 @@ #' uknown kernel name is used it falls back to the default value. #' @param scaled \code{logical} specifing if the output values should be scaled. Default value is #' \code{FALSE}. +#' @param weights \code{numeric} vector of weights for individual \code{points}. #' @param grid either \code{\link[sf]{sf}} \code{data.frame} (outcome of function #' \code{\link{create_grid_rectangular}} or \code{\link{create_grid_hexagonal}}) or #' \code{\link[raster]{Raster-class}} (outcome of function \code{\link{create_raster}}). @@ -37,7 +38,7 @@ #' @importFrom dplyr mutate #' @importFrom glue glue glue_collapse #' @importFrom Rcpp evalCpp -#' @importFrom rlang .data +#' @importFrom rlang .data is_double #' #' @useDynLib SpatialKDE #' @@ -55,6 +56,7 @@ kde <- function(points, decay = 1, kernel = "quartic", scaled = FALSE, + weights = c(), grid, cell_size){ @@ -66,6 +68,16 @@ kde <- function(points, .validate_points(points) + if (length(weights) == 0) { + weights = rep(1, nrow(points)) + } + + if (!is_double(weights, n = nrow(points), finite = TRUE)) { + stop(glue::glue("All values of `weights` must be numerical and finite vector (no `NA`s, `Inf` or `-Inf`).", + "The length of the vector must be equal to number of rows in `points`.", + "Length weights is `{length(weights)}` and number of rows in poitns is `{nrow(points)}`.")) + } + if (missing(grid) & missing(cell_size)) { stop("Both variables `grid` and `cellsize` are not specified. Don't know how to create grid for KDE estimation.") } @@ -95,7 +107,8 @@ kde <- function(points, band_width = band_width, decay = decay, kernel = kernel, - scaled = scaled) + scaled = scaled, + weights = weights) return(kde_calculated) } @@ -106,7 +119,8 @@ kde <- function(points, band_width, decay, kernel, - scaled) { + scaled, + weights) { UseMethod(".kde") } @@ -117,7 +131,8 @@ kde <- function(points, band_width, decay, kernel, - scaled) { + scaled, + weights) { .validate_sf(grid) @@ -142,7 +157,8 @@ kde <- function(points, bw = band_width, kernel = kernel, scaled = scaled, - decay = decay) + decay = decay, + weights = weights) grid <- grid %>% dplyr::mutate(kde_value = kde_values) @@ -160,7 +176,8 @@ setMethod(".kde", band_width, decay, kernel, - scaled) { + scaled, + weights) { .validate_raster_projected(grid) @@ -173,7 +190,8 @@ setMethod(".kde", bw = band_width, kernel = kernel, scaled = scaled, - decay = decay) + decay = decay, + weights = weights) raster::values(grid) <- kde_values diff --git a/build/vignette.rds b/build/vignette.rds index c592467ba7bfb8c0ad82878e195219b553c97c32..8c370259a689eaa29d180381e3222cec07d7773c 100644 GIT binary patch delta 20 ccmcb_c!_a>2xHnr(XAZ){C=koFfuRz085AljQ{`u delta 20 ccmcb_c!_a>2xH1b(XAXR>)479FfuRz07(Z19{>OV diff --git a/inst/doc/SpatialKDE.html b/inst/doc/SpatialKDE.html index f33a03e..ab5868d 100644 --- a/inst/doc/SpatialKDE.html +++ b/inst/doc/SpatialKDE.html @@ -8,37 +8,51 @@ - + SpatialKDE quickstart + @@ -302,7 +314,7 @@

SpatialKDE quickstart

Jan Caha

-

2019-12-16 09:14:47

+

2020-04-16 14:09:24

@@ -313,51 +325,51 @@

Inspiration

Example

First we load all necessary packages.

- +
library(SpatialKDE)
+library(sp)
+library(sf)
+library(dplyr)
+library(tmap)

Then we load the example dataset and prepare it into expected format of sf data.frame.

- +
data(meuse)
+
+meuse <- meuse %>% 
+  st_as_sf(coords = c("x", "y"), dim = "XY") %>% 
+  st_set_crs(28992) %>% 
+  select()

Let’s define variables necessary for KDE estimation, cell size of the resulting grid and band width of points.

- +
cell_size <- 100
+band_width <- 150

Vector grid

Now we can prepare grid for KDE estimation. We prepare rectangular grid (hexagonal is the second option) with given cell size which is slightly bigger than convex hull of the data.

- +
grid_meuse <- meuse %>% 
+  create_grid_rectangular(cell_size = cell_size, side_offset = band_width)

At this moment it is possible to calculate KDE using kde() function with specified settings.

- +
kde <- meuse %>% 
+  kde(band_width = band_width, kernel = "quartic", grid = grid_meuse)
## Using centroids instead of provided `grid` geometries to calculate KDE estimates.

The result can be visualized using tmap package.

- +
tm_shape(kde) + 
+  tm_polygons(col = "kde_value", palette = "viridis", title = "KDE Estimate") +
+tm_shape(meuse) +
+  tm_bubbles(size = 0.1, col = "red")

Raster

Now we can prepare raster for KDE estimation. We prepare raster with given cell size which is slightly bigger than convex hull of the data.

- +
raster_meuse <- meuse %>% 
+  create_raster(cell_size = cell_size, side_offset = band_width)

At this moment it is possible to calculate KDE using kde() function with specified settings.

- +
kde <- meuse %>% 
+  kde(band_width = band_width, kernel = "triweight", grid = raster_meuse)

The result can be visualized using tmap package.

- +
tm_shape(kde) + 
+  tm_raster(palette = "viridis", title = "KDE Estimate") +
+tm_shape(meuse) +
+  tm_bubbles(size = 0.1, col = "red") + 
+tm_layout(legend.outside = TRUE)

diff --git a/man/kde.Rd b/man/kde.Rd index b99d34d..ebf90ed 100644 --- a/man/kde.Rd +++ b/man/kde.Rd @@ -10,6 +10,7 @@ kde( decay = 1, kernel = "quartic", scaled = FALSE, + weights = c(), grid, cell_size ) @@ -29,6 +30,8 @@ uknown kernel name is used it falls back to the default value.} \item{scaled}{\code{logical} specifing if the output values should be scaled. Default value is \code{FALSE}.} +\item{weights}{\code{numeric} vector of weights for individual \code{points}.} + \item{grid}{either \code{\link[sf]{sf}} \code{data.frame} (outcome of function \code{\link{create_grid_rectangular}} or \code{\link{create_grid_hexagonal}}) or \code{\link[raster]{Raster-class}} (outcome of function \code{\link{create_raster}}). diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index eb3a03a..9efadae 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -6,8 +6,8 @@ using namespace Rcpp; // kde_estimate -NumericVector kde_estimate(NumericMatrix fishnet, NumericMatrix points, double bw, String kernel, bool scaled, double decay); -RcppExport SEXP _SpatialKDE_kde_estimate(SEXP fishnetSEXP, SEXP pointsSEXP, SEXP bwSEXP, SEXP kernelSEXP, SEXP scaledSEXP, SEXP decaySEXP) { +NumericVector kde_estimate(NumericMatrix fishnet, NumericMatrix points, double bw, String kernel, bool scaled, double decay, NumericVector weights); +RcppExport SEXP _SpatialKDE_kde_estimate(SEXP fishnetSEXP, SEXP pointsSEXP, SEXP bwSEXP, SEXP kernelSEXP, SEXP scaledSEXP, SEXP decaySEXP, SEXP weightsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -17,13 +17,14 @@ BEGIN_RCPP Rcpp::traits::input_parameter< String >::type kernel(kernelSEXP); Rcpp::traits::input_parameter< bool >::type scaled(scaledSEXP); Rcpp::traits::input_parameter< double >::type decay(decaySEXP); - rcpp_result_gen = Rcpp::wrap(kde_estimate(fishnet, points, bw, kernel, scaled, decay)); + Rcpp::traits::input_parameter< NumericVector >::type weights(weightsSEXP); + rcpp_result_gen = Rcpp::wrap(kde_estimate(fishnet, points, bw, kernel, scaled, decay, weights)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { - {"_SpatialKDE_kde_estimate", (DL_FUNC) &_SpatialKDE_kde_estimate, 6}, + {"_SpatialKDE_kde_estimate", (DL_FUNC) &_SpatialKDE_kde_estimate, 7}, {NULL, NULL, 0} }; diff --git a/src/kde.cpp b/src/kde.cpp index aa36006..937919b 100644 --- a/src/kde.cpp +++ b/src/kde.cpp @@ -103,7 +103,8 @@ NumericVector kde_estimate(NumericMatrix fishnet, double bw, String kernel, bool scaled = false, - double decay = 1) { + double decay = 1, + NumericVector weights = NumericVector(0)) { int nrow = fishnet.nrow(); @@ -120,11 +121,17 @@ NumericVector kde_estimate(NumericMatrix fishnet, NumericVector v3 = v1-v2; - d += kde_element(sqrt(sum(pow(v3, 2.0))), - bw, - kernel, - scaled, - decay); + double w = 1; + + if (weights.length() != 0) { + w = weights[j]; + } + + d += (w * kde_element(sqrt(sum(pow(v3, 2.0))), + bw, + kernel, + scaled, + decay)); } diff --git a/tests/testthat/test-kde.R b/tests/testthat/test-kde.R index 3e794f6..390d3a6 100644 --- a/tests/testthat/test-kde.R +++ b/tests/testthat/test-kde.R @@ -39,6 +39,15 @@ test_that("kde - wrong inputs", { regexp = "Unknown `kernel` used.") }) +test_that("kde - wrong inputs - weights", { + expect_error(kde(test_data, cell_size = 100, band_width = 100, kernel = "quartic", + grid = test_grid, weights = c("test")), + regexp = "All values of `weights` must be numerical and finite vector") + expect_error(kde(test_data, cell_size = 100, band_width = 100, kernel = "quartic", + grid = test_grid, weights = c(5, 15, 30)), + regexp = "All values of `weights` must be numerical and finite vector") +}) + test_that("kde - wrong inputs - grid input", { expect_error(kde(test_data, cell_size = 100, band_width = 100, kernel = "quartic", grid = test_grid_not_projected), @@ -56,6 +65,10 @@ test_that("results", { grid = test_grid), "sf") + expect_s3_class(kde(test_data, cell_size = 100, band_width = 100, kernel = "quartic", + grid = test_grid, weights = rnorm(nrow(test_data))), + "sf") + expect_s4_class(kde(test_data, cell_size = 100, band_width = 100, kernel = "quartic", grid = test_raster), "RasterLayer")