Initial importv0.1.0

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)
+}