/
aw_verify.R
87 lines (71 loc) · 2.98 KB
/
aw_verify.R
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
#' Verify Correct Extensive-Sum Interpolation
#'
#' @details \code{aw_verify} ensures that the sum of the resulting interpolated
#' value is equal to the sum of the original source value. This functionality
#' only works for interpolations that are extensive and use the \code{sum}
#' approach to calculating areal weights.
#'
#' @usage aw_verify(source, sourceValue, result, resultValue)
#'
#' @param source A \code{sf} object with data to be interpolated
#' @param sourceValue A column within \code{source} to be interpolated
#' @param result A \code{sf} object with interpolated data
#' @param resultValue A column within \code{result} with the interpolated values
#'
#' @return A logical scalar; if \code{TRUE}, these two values are equal.
#'
#' @examples
#' result <- aw_interpolate(ar_stl_wards, tid = WARD, source = ar_stl_race, sid = GEOID,
#' weight = "sum", output = "tibble", extensive = "TOTAL_E")
#'
#' aw_verify(source = ar_stl_race, sourceValue = TOTAL_E, result = result, resultValue = TOTAL_E)
#'
#' @importFrom glue glue
#'
#' @export
aw_verify <- function(source, sourceValue, result, resultValue){
# save parameters to list
paramList <- as.list(match.call())
# check for missing parameters
if (missing(source)) {
stop("A sf object containing source data must be specified for the 'source' argument.")
}
if (missing(sourceValue)) {
stop("A variable name must be specified for the 'sourceValue' argument.")
}
if (missing(result)) {
stop("A sf object containing interpolated data must be specified for the 'result' argument.")
}
if (missing(resultValue)) {
stop("A variable name must be specified for the 'resultValue' argument.")
}
# nse
if (!is.character(paramList$sourceValue)) {
sourceValueQ <- rlang::enquo(sourceValue)
} else if (is.character(paramList$sourceValue)) {
sourceValueQ <- rlang::quo(!! rlang::sym(sourceValue))
}
sourceValueQN <- rlang::quo_name(rlang::enquo(sourceValue))
if (!is.character(paramList$resultValue)) {
resultValueQ <- rlang::enquo(resultValue)
} else if (is.character(paramList$resultValue)) {
resultValueQ <- rlang::quo(!! rlang::sym(resultValue))
}
resultValueQN <- rlang::quo_name(rlang::enquo(resultValue))
# check variables
if(!!sourceValueQN %in% colnames(source) == FALSE) {
stop(glue::glue("Variable '{var}', given for the source value, cannot be found in the given source object. Make sure only one existing variable is given.",
var = sourceValueQN))
}
if(!!resultValueQN %in% colnames(result) == FALSE) {
stop(glue::glue("Variable '{var}', given for the result value, cannot be found in the given result object. Make sure only one existing variable is given.",
var = resultValueQN))
}
# store sum of original and interpolated values
sourceSum <- sum(source[[sourceValueQN]])
resultSum <- sum(result[[resultValueQN]])
# logic test
out <- sourceSum == resultSum
# return output
return(out)
}