summaryrefslogtreecommitdiffstats
path: root/R/models.R
diff options
context:
space:
mode:
Diffstat (limited to 'R/models.R')
-rw-r--r--R/models.R212
1 files changed, 212 insertions, 0 deletions
diff --git a/R/models.R b/R/models.R
new file mode 100644
index 0000000..076db48
--- /dev/null
+++ b/R/models.R
@@ -0,0 +1,212 @@
+#' A CEP and everything the database knows about it
+#'
+#' @description
+#' The object returned by [cep_lookup()] and by each element of
+#' [cep_lookup_many()]. It is a plain list of class `cepis_address`, so
+#' `address$localidade` and `str(address)` work as usual.
+#'
+#' **The data fields keep the API's Portuguese names.** Fields the database
+#' does not have for a CEP come back as empty strings, never `NA` — that is
+#' what the API returns, and changing it here would create a difference
+#' between reading the JSON and reading this package.
+#'
+#' @section Fields:
+#' \describe{
+#' \item{`cep`}{the 8 digits, always unmasked. [formatted_cep()] adds the
+#' mask.}
+#' \item{`logradouro`, `complemento`, `unidade`, `bairro`}{the street and
+#' its qualifiers.}
+#' \item{`localidade`, `uf`, `estado`, `regiao`}{municipality, state code,
+#' state name, region.}
+#' \item{`ibge`, `gia`, `ddd`, `siafi`}{the codes the database carries.}
+#' \item{`geo`}{a [cepis_geo] object, or `NULL` when the database has no
+#' coordinate for that CEP. `NULL` and not a row of `NA`s because the API
+#' **omits** the whole field in that case (about 43% of CEPs) rather than
+#' sending null.}
+#' \item{`raw`}{the response exactly as it arrived, uninterpreted, so a
+#' field the API grows before this package is updated is not lost.}
+#' }
+#'
+#' @name cepis_address
+NULL
+
+#' The coordinate of a CEP, when the database has one
+#'
+#' @description
+#' The `geo` field of a [cepis_address], a plain list of class `cepis_geo`.
+#' The point is the **median** of the coordinates of that CEP's addresses,
+#' not the mean: one badly geocoded address 40 km away shifts a mean and does
+#' not move a median.
+#'
+#' @section Fields:
+#' \describe{
+#' \item{`lat`, `lon`}{decimal degrees, WGS 84.}
+#' \item{`raio_m`}{the radius, in metres, containing 90% of that CEP's
+#' addresses.}
+#' \item{`precisao`}{`"logradouro"` or `"localidade"` — see below.}
+#' \item{`is_precise`}{`TRUE` when `precisao` is `"logradouro"`. Derived,
+#' not sent by the API.}
+#' }
+#'
+#' @section Always check precisao before measuring distance:
+#' There are two kinds of point, and the difference between them is tens of
+#' kilometres:
+#'
+#' | `precisao` | typical `raio_m` | what the point is |
+#' | --- | --- | --- |
+#' | `logradouro` | 110-140 m | the stretch of street: good for maps and for distance |
+#' | `localidade` | 7-40 km | the municipality centroid, because the CEP *is* the whole city |
+#'
+#' `raio_m` exists precisely so that error cannot pass unnoticed.
+#'
+#' @name cepis_geo
+NULL
+
+#' The answer of `GET /health`
+#'
+#' @description
+#' A plain list of class `cepis_health`, returned by [cep_health()]. Good for
+#' two things: checking that the API answers, and knowing **which version of
+#' the database** is live. The DNE database changes every two weeks; `dne`
+#' identifies it.
+#'
+#' @section Fields:
+#' \describe{
+#' \item{`status`}{`"ok"` when the API reports itself healthy.}
+#' \item{`ok`}{`status == "ok"`. Derived, not sent by the API.}
+#' \item{`dne`}{identifier of the fortnightly database.}
+#' \item{`ceps`}{how many CEPs it holds.}
+#' \item{`geo`}{how many of those carry a coordinate.}
+#' \item{`base_gerada_em`}{when the base was generated, UTC.}
+#' }
+#'
+#' @name cepis_health
+NULL
+
+ADDRESS_FIELDS <- c(
+ "cep", "logradouro", "complemento", "unidade", "bairro", "localidade",
+ "uf", "estado", "regiao", "ibge", "gia", "ddd", "siafi"
+)
+
+text_field <- function(data, name) {
+ value <- data[[name]]
+ if (is.null(value) || length(value) != 1L || is.na(value)) {
+ return("")
+ }
+ as.character(value)
+}
+
+new_geo <- function(block) {
+ lat <- suppressWarnings(as.numeric(block[["lat"]]))
+ lon <- suppressWarnings(as.numeric(block[["lon"]]))
+ raio <- suppressWarnings(as.numeric(block[["raio_m"]]))
+ precisao <- block[["precisao"]]
+
+ usable <- length(lat) == 1L && length(lon) == 1L && length(raio) == 1L &&
+ length(precisao) == 1L && !anyNA(c(lat, lon, raio)) &&
+ is.character(precisao) && !is.na(precisao)
+ if (!usable) {
+ return(NULL)
+ }
+
+ structure(
+ list(
+ lat = lat,
+ lon = lon,
+ raio_m = as.integer(round(raio)),
+ precisao = precisao,
+ is_precise = identical(precisao, "logradouro")
+ ),
+ class = "cepis_geo"
+ )
+}
+
+new_address <- function(data) {
+ geo <- NULL
+ block <- data[["geo"]]
+ if (is.list(block)) {
+ geo <- new_geo(block)
+ }
+
+ fields <- lapply(ADDRESS_FIELDS, function(name) text_field(data, name))
+ names(fields) <- ADDRESS_FIELDS
+
+ structure(c(fields, list(geo = geo, raw = data)), class = "cepis_address")
+}
+
+new_health <- function(data) {
+ count <- function(name) {
+ value <- suppressWarnings(as.numeric(data[[name]]))
+ if (length(value) != 1L || is.na(value)) 0L else as.integer(value)
+ }
+ status <- text_field(data, "status")
+
+ structure(
+ list(
+ status = status,
+ ok = identical(status, "ok"),
+ dne = text_field(data, "dne"),
+ ceps = count("ceps"),
+ geo = count("geo"),
+ base_gerada_em = text_field(data, "base_gerada_em")
+ ),
+ class = "cepis_health"
+ )
+}
+
+#' Add the mask to a CEP
+#'
+#' @description
+#' `"01001000"` becomes `"01001-000"`. The API always answers unmasked;
+#' formatting is presentation, and it lives here so it does not become a
+#' repeated `paste0()` in every project that uses this package.
+#'
+#' @param x A [cepis_address] or a character vector of CEPs.
+#'
+#' @return A character vector of masked CEPs. A value that is not 8 digits is
+#' returned unchanged, because this is a formatting helper and not a
+#' validator — [normalize_cep()] is the validator.
+#'
+#' @examples
+#' formatted_cep("01001000")
+#'
+#' @export
+formatted_cep <- function(x) {
+ if (inherits(x, "cepis_address")) {
+ x <- x$cep
+ }
+ x <- as.character(x)
+ masked <- paste0(substr(x, 1L, 5L), "-", substr(x, 6L, 8L))
+ ifelse(grepl("^[0-9]{8}$", x), masked, x)
+}
+
+#' @export
+print.cepis_address <- function(x, ...) {
+ cat("<cepis_address>", formatted_cep(x$cep), "\n")
+ street <- paste(c(x$logradouro, x$complemento, x$bairro), collapse = ", ")
+ cat(" ", street, "\n", sep = "")
+ cat(" ", x$localidade, "/", x$uf, " (IBGE ", x$ibge, ", DDD ", x$ddd,
+ ")\n", sep = "")
+ if (is.null(x$geo)) {
+ cat(" geo: none\n")
+ } else {
+ cat(" geo: ", x$geo$lat, ", ", x$geo$lon, " (raio ", x$geo$raio_m,
+ " m, ", x$geo$precisao, ")\n", sep = "")
+ }
+ invisible(x)
+}
+
+#' @export
+print.cepis_geo <- function(x, ...) {
+ cat("<cepis_geo> ", x$lat, ", ", x$lon, " (raio ", x$raio_m, " m, ",
+ x$precisao, ")\n", sep = "")
+ invisible(x)
+}
+
+#' @export
+print.cepis_health <- function(x, ...) {
+ cat("<cepis_health> ", x$status, "\n", sep = "")
+ cat(" dne: ", x$dne, " (generated ", x$base_gerada_em, ")\n", sep = "")
+ cat(" ceps: ", x$ceps, ", with geo: ", x$geo, "\n", sep = "")
+ invisible(x)
+}