-
-
Notifications
You must be signed in to change notification settings - Fork 6
/
point-pattern-centers.R
85 lines (75 loc) · 2.48 KB
/
point-pattern-centers.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#' Calculate Center Mean Point
#'
#' Given an sfc object containing points, calculate a measure of central tendency.
#'
#' @param geometry an sfc object. If a polygon, uses [`sf::st_point_on_surface()`].
#' @param weights an optional vector of weights to apply to the coordinates before calculation.
#' @family point-pattern
#' @details
#'
#' - `center_mean()` calculates the mean center of a point pattern
#' - `euclidean_median()` calculates the euclidean median center of a point pattern using the `pracma` package
#' - `center_median()` calculates the median center it is recommended to use the euclidean median over the this function.
#'
#' @export
#' @examples
#' # Make a grid to sample from
#' grd <- sf::st_make_grid(n = c(1, 1), cellsize = c(100, 100), offset = c(0,0))
#'
#' # sample 100 points
#' pnts <- sf::st_sample(grd, 100)
#'
#' cm <- center_mean(pnts)
#' em <- euclidean_median(pnts)
#' cmed <- center_median(pnts)
#'
#' plot(pnts)
#' plot(cm, col = "red", add = TRUE)
#' plot(em, col = "blue", add = TRUE)
#' plot(cmed, col = "green", add = TRUE)
center_mean <- function(geometry, weights = NULL) {
geometry <- check_polygon(geometry)
crs <- sf::st_crs(geometry)
coords <- sf::st_coordinates(geometry)
n <- nrow(coords)
if (!is.null(weights)) {
res <- colSums(coords * weights) / n
} else {
res <- colSums(coords) / n
}
sf::st_sfc(sf::st_point(res), crs = crs)
}
#' @family point-pattern
#' @rdname center_mean
#' @export
center_median <- function(geometry) {
crs <- sf::st_crs(geometry)
coords <- sf::st_coordinates(geometry)
res <- apply(coords, 2, stats::median)
sf::st_sfc(sf::st_point(res), crs = crs)
}
#' @param tolerance a tolerance level to terminate the process. This is passed to [`pracma::geo_median()`].
#' @rdname center_mean
#' @export
euclidean_median <- function(geometry, tolerance = 1e-09) {
check_pkg_suggests("pracma")
crs <- sf::st_crs(geometry)
coords <- sf::st_coordinates(geometry)
res <- pracma::geo_median(coords)
sf::st_sfc(sf::st_point(res[["p"]]), crs = crs)
}
# Testing data
# df <- sf::read_sf('/Users/josiahparry/Library/r-miniconda-arm64/envs/geo/lib/python3.8/site-packages/libpysal/examples/virginia/vautm17n_points.shp')
#
# geometry <- sf::st_geometry(df)
# center_mean(geometry)
# center_median(geometry)
# euclidean_median(geometry)
# cent <- euclidean_median(geometry)
# cent_xy <- sf::st_coordinates(cent)
#
# coords <- sf::st_coordinates(geometry)
#
# dists <- sf::st_distance(geometry, cent, by_element = TRUE)
#
# mean(dists)