/
spq_add.R
139 lines (129 loc) · 4.38 KB
/
spq_add.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
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
#' Add a triple pattern statement to a query
#' @param .query query
#' @param .triple_pattern the triple pattern statement
#' (replaces arguments subject verb and object)
#' @param .subject an anonymous variable
#' (for instance, and by default, "?subject") or item (for instance "wd:Q456"))
#' @param .verb the property (for instance "wdt:P190")
#' @param .object an anonymous variable (for instance,
#' and by default, "?object") or item (for instance "wd:Q456"))
#' @param .required whether the existence of a value for the triple is required
#' or not (defaults to TRUE).
#' If set to FALSE, then other triples in the query are returned even
#' if this particular triple is missing)
#' @param .label `r lifecycle::badge("deprecated")` See [`spq_label()`].
#' @param .within_box if provided, rectangular bounding box for the triple query.
#' Provided as list(southwest=c(long=...,lat=...),northeast=c(long=...,lat=...))
#' @param .within_distance if provided, circular bounding box for the triple query.
#' Provided as list(center=c(long=...,lat=...), radius=...),
#' with radius in kilometers.
#' The center can also be provided as a variable (for instance, "?location")
#' for the center coordinates to be retrieved directly from the query.
#' @param .prefixes Custom prefixes
#' @param .filter Filter for the triple. Only use this with `.required=FALSE`
#' @param .sibling_triple_pattern Triple this triple is to be grouped with,
#' especially (only?) useful if the sibling triple is optional.
#' @export
#' @section Examples:
#' ```r
#' # find the cities
#' spq_init() %>%
#' spq_add("?city wdt:P31/wdt:P279* wd:Q486972") %>%
#' spq_label(city) %>%
#' spq_mutate(coords = wdt::P625(city),
#' .within_distance=list(center=c(long=4.84,lat=45.76),
#' radius=5)) %>%
#' spq_perform()
#'
#' # find the individuals of the species
#' spq_init() %>%
#' spq_add("?mayor wdt:P31 ?species") %>%
#' # dog, cat or chicken
#' spq_set(species = c('wd:Q144','wd:Q146', 'wd:Q780')) %>%
#' # who occupy the function
#' spq_add("?mayor p:P39 ?node") %>%
#' # of mayor
#' spq_add("?node ps:P39 wd:Q30185") %>%
#' # of some places
#' spq_add("?node pq:P642 ?place") %>%
#' spq_perform()
#'
#' ```
#' @details
#' The arguments `.subject`, `.verb`, `.object` are most useful for programmatic
#' usage, they are actually used within glitter code itself.
spq_add = function(.query = NULL,
.triple_pattern = NULL,
.subject = NULL,
.verb = NULL,
.object = NULL,
.prefixes = NULL,
.required = TRUE,
.label = NA,
.within_box = c(NA, NA),
.within_distance = c(NA, NA),
.filter = NULL,
.sibling_triple_pattern = NA) {
.query = .query %||% spq_init()
elts = decompose_triple_pattern(
triple_pattern = .triple_pattern,
subject = .subject,
verb = .verb,
object = .object
)
if (elts[["subject"]] == ".") {
elts[["subject"]] = .query[["previous_subject"]]
}
.query[["previous_subject"]] = elts[1][["subject"]]
# standardized spacing :-)
triple = paste(elts, collapse = " ")
.query = track_triples(
.query,
triple = triple,
required = .required,
within_box = list(.within_box),
within_distance = list(.within_distance),
filter = .filter,
sibling_triple = .sibling_triple_pattern
)
# variable tracking ----
vars = purrr::keep(elts, \(x) !is.na(x) && startsWith(x, "?"))
.query <- purrr::reduce(
vars,
add_one_var,
triple = triple,
.init = .query
)
# labelling ----
if (!is.na(.label)) {
lifecycle::deprecate_warn(
when = "0.2.0",
what = "spq_add(.label)",
details = "Ability to use `.label` will be dropped in next release, use `spq_label()` instead."
)
.label <- gsub("^\\?", "", .label)
.query <- spq_label(.query, !!!.label)
}
# prefixed elements ----
.query[["prefixes_used"]] = union(
.query[["prefixes_used"]],
purrr::map(unname(elts), keep_prefix) %>%
unlist() %>%
purrr::discard(is.na)
) %>%
stats::na.omit()
.query
}
add_one_var <- function(.query, var, triple) {
.query = track_vars(
.query,
name = var,
triple = triple
)
.query = track_structure(
.query,
name = var,
selected = TRUE
)
.query
}