# Class Geocodes: store and manipulate spatial coordinates ---------------------
# Virtual class NullNumChar ----------------------------------------------------
# Used to allow flexibility in slot keys of class Geocodes.
setClassUnion("NullNumChar", c("NULL", "numeric", "character"))
# Definition -------------------------------------------------------------------
setClass("Geocodes",
slots = list(
coords = "data.table",
keys = "NullNumChar",
crs = "CRS"),
prototype = list(
coords = data.table(x = numeric(),
y = numeric()),
keys = NULL,
crs = new("CRS", projargs = NA_character_)))
# Validator --------------------------------------------------------------------
.validGeocodes.coords <- function(coords)
{
txt <- character(2L)
if (ncol(coords) > 2L) {
txt[1L] <- "@coords must contain two fields only."
}
if (!identical(names(coords)[1L], "x") ||
!identical(names(coords)[2L], "y")) {
txt[2L] <- "@coords names must be c('x', 'y')."
}
txt
}
.validGeocodes.keys <- function(keys, n.coords)
{
txt <- character(2L)
if (!is.null(keys)) {
if (!identical(n.coords, length(keys))) {
txt[1L] <- "@keys length must be equal to @coords rows."
}
if (!identical(length(unique(keys)),
length(keys))) {
txt[2L] <- "@keys elements must be unique."
}
}
txt
}
.validGeocodes.crs <- function(crs)
{
.validCRS(crs)
}
.validGeocodes <- function(object)
{
txt <- c(.validGeocodes.coords(object@coords),
.validGeocodes.keys(object@keys,
NROW(object@coords)),
.validGeocodes.crs(object@crs))
txt <- txt[nchar(txt) > 0L]
if (length(txt)) {
res <- txt
} else {
res <- TRUE
}
res
}
setValidity("Geocodes", .validGeocodes)
# Constructor ------------------------------------------------------------------
Geocodes <- function(coords, keys, crs)
{
if (!is.data.table(coords)) {
coords <- as.data.table(coords)
}
methods::new("Geocodes", coords, keys, crs)
}
# Helpers and lambda functions -------------------------------------------------
.validCRS <- function(crs)
{
if (!is.na(crs@projargs) &&
!checkCRSArgs(crs@projargs)[[1L]]) {
txt <- "@crs must contain a PROJ.4 recognizable CRS. See ?sp::CRS-class."
} else {
txt <- ""
}
txt
}
# Tests ------------------------------------------------------------------------
getClass("Geocodes")
new("Geocodes", coords = data.table(a = 1, y = 2, z = 3),
keys = c("lol", "lol"), crs = CRS("+init=epsg:4", FALSE))
new("Geocodes", coords = data.table(x = c(1, 2), y = c(3, 4)),
keys = c("R1", "R2"), crs = CRS("+init=epsg:4326"))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.