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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
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)
}
|