path: root/R/models.R

#' 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 municipality a CEP that does not exist would have belonged to
#'
#' @description
#' The `faixa` field of a [cepis_not_found][cepis_conditions] condition, a
#' plain list of class `cepis_faixa`. It is **context for an error, not an
#' address**: the CEP asked for does not exist, and nothing here says
#' otherwise. What it does say is which municipality owns the band of numbers
#' the CEP fell into.
#'
#' It exists because a CEP that fails is rarely random — it is usually
#' someone who knows the city and guessed the number, and the classic guess is
#' the `-000` that 957 municipalities never received.
#'
#' @section Fields:
#' \describe{
#'   \item{`localidade`, `uf`, `estado`, `regiao`}{municipality, state code,
#'     state name, region — the same names, and the same meaning, as in a
#'     [cepis_address].}
#'   \item{`ibge`}{the municipality's IBGE code, so the answer can be joined
#'     to other data without matching on the name.}
#'   \item{`cep_ini`, `cep_fim`}{the smallest and the largest CEP that
#'     **actually exists** in that municipality. Not the range the Correios
#'     publish: the DNE's own start for Areal/RJ is `25845000`, which is
#'     precisely the CEP that just failed.}
#'   \item{`ceps`}{how many CEPs the municipality really has.}
#' }
#'
#' @section The range is sparse:
#' Areal's 118 CEPs are scattered over the ~4900 numbers between `25845001`
#' and `25849899`. `cep_ini` and `cep_fim` are two endpoints that exist, not a
#' promise about anything in between — never present the pair as a list of
#' valid CEPs, and never iterate from one to the other. `ceps` is there so the
#' emptiness of the interval is visible: 118 out of 4899.
#'
#' @section When there is no faixa:
#' `NULL`, and not a list of empty strings, when the CEP falls in a band no
#' municipality owns. The API **omits** the field rather than sending null,
#' and this package keeps that distinction intact: `is.null(x$faixa)` means
#' the number is close to nothing, not that the fields came back blank.
#'
#' Only [cep_lookup()] reports it. In [cep_lookup_many()] a CEP that does not
#' exist is still `NULL` at its position: the endpoint behind a batch is CSV
#' and says nothing about ranges.
#'
#' @name cepis_faixa
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)
}

count_field <- function(data, name) {
  value <- data[[name]]
  if (!is.numeric(value) && !is.character(value)) {
    return(0L)
  }
  value <- suppressWarnings(as.numeric(value))
  if (length(value) != 1L || is.na(value)) 0L else as.integer(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"
  )
}

# Never signals. A faixa is decoration on a 404, and a malformed one must not
# turn a clean "this CEP does not exist" into a parse failure: anything that
# is not an object naming a municipality is simply no faixa at all.
new_faixa <- function(block) {
  if (!is.list(block) || is.null(names(block))) {
    return(NULL)
  }

  localidade <- text_field(block, "localidade")
  uf <- text_field(block, "uf")
  if (!nzchar(localidade) || !nzchar(uf)) {
    return(NULL)
  }

  structure(
    list(
      localidade = localidade,
      uf = uf,
      estado = text_field(block, "estado"),
      regiao = text_field(block, "regiao"),
      ibge = text_field(block, "ibge"),
      cep_ini = text_field(block, "cep_ini"),
      cep_fim = text_field(block, "cep_fim"),
      ceps = count_field(block, "ceps")
    ),
    class = "cepis_faixa"
  )
}

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) {
  status <- text_field(data, "status")

  structure(
    list(
      status = status,
      ok = identical(status, "ok"),
      dne = text_field(data, "dne"),
      ceps = count_field(data, "ceps"),
      geo = count_field(data, "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_faixa <- function(x, ...) {
  cat("<cepis_faixa> ", x$localidade, "/", x$uf, " (IBGE ", x$ibge, ")\n",
      sep = "")
  cat("  ", x$ceps, " CEP(s), the first ", formatted_cep(x$cep_ini),
      " and the last ", formatted_cep(x$cep_fim), "\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)
}