Nothing
# ---- text auxiliary functions ----
text_quote <- function(x) {
paste0("'", x, "'")
}
text_lst <- function(v) {
paste0("(", paste0(v, collapse = ","), ")")
}
escape <- function(x) {
gsub("'", "''", x)
}
# ---- convert to text ----
to_text <- function(x) {
UseMethod("to_text", x)
}
#' @export
to_text.character <- function(x) {
if (length(x) == 1)
text_quote(escape(x))
else
to_text(as.list(x))
}
#' @export
to_text.numeric <- function(x) {
if (length(x) == 1) {
num_format(x)
} else {
to_text(as.list(x))
}
}
#' @export
to_text.integer <- function(x) {
to_text.numeric(x)
}
#' @export
to_text.logical <- function(x) {
if (length(x) == 1)
if (x) "true" else "false"
else
to_text(as.list(x))
}
#' @export
to_text.cql2_spatial <- function(x) {
if (is_str(x)) {
return(x) # input WKT string
}
to_wkt(x) # input list representing a GeoJSON
}
#' @export
to_text.sf <- function(x) {
to_wkt(get_spatial(x))
}
#' @export
to_text.sfc <- function(x) {
to_wkt(get_spatial(x))
}
#' @export
to_text.sfg <- function(x) {
to_wkt(get_spatial(x))
}
#' @export
to_text.list <- function(x) {
if (is_lst(x))
text_lst(lapply(x, to_text))
else if (is_spatial(x))
to_wkt(get_spatial(x))
else
stop("cannot convert list object to cql2 text", call. = FALSE)
}
#' @export
to_text.cql2_logic_op <- function(x) {
paste(to_text(x$args[[1]]), toupper(x$op), to_text(x$args[[2]]))
}
#' @export
to_text.cql2_not_op <- function(x) {
text_not_op(x)
}
#' @export
to_text.cql2_spatial_op <- function(x) {
paste0(
toupper(x$op), "(",
to_text(x$args[[1]]), ",",
to_text(x$args[[2]]),
")"
)
}
#' @export
to_text.cql2_temporal_op <- function(x) {
paste0(
toupper(x$op), "(",
to_text(x$args[[1]]), ",",
to_text(x$args[[2]]),
")"
)
}
#' @export
to_text.cql2_array_op <- function(x) {
paste0(
toupper(x$op), "(",
to_text(x$args[[1]]), ",",
to_text(x$args[[2]]),
")"
)
}
#' @export
to_text.cql2_func <- function(x) {
args <- paste0(lapply(x$`function`$args, to_text), collapse = ",")
paste0(x$`function`$name, "(", args, ")")
}
#' @export
to_text.cql2_comp_op <- function(x) {
paste(to_text(x$args[[1]]), x$op, to_text(x$args[[2]]))
}
#' @export
to_text.cql2_like_op <- function(x) {
paste(to_text(x$args[[1]]), toupper(x$op), to_text(x$args[[2]]))
}
#' @export
to_text.cql2_between_op <- function(x) {
paste(to_text(x$args[[1]]), "BETWEEN",
to_text(x$args[[2]]), "AND", to_text(x$args[[3]]))
}
#' @export
to_text.cql2_in_op <- function(x) {
paste(to_text(x$args[[1]]), "IN", to_text(x$args[[2]]))
}
#' @export
to_text.cql2_isnull_op <- function(x) {
paste(to_text(x$args[[1]]), "IS NULL")
}
#' @export
to_text.cql2_math_op <- function(x) {
paste(to_text(x$args[[1]]), x$op, to_text(x$args[[2]]))
}
#' @export
to_text.cql2_minus_op <- function(x) {
if (length(x$args) == 1)
paste0(x$op, to_text(x$args[[1]]))
else
paste(to_text(x$args[[1]]), x$op, to_text(x$args[[2]]))
}
#' @export
to_text.cql2_prop_ref <- function(x) {
x$property[[1]]
}
#' @export
to_text.cql2_timestamp <- function(x) {
paste0("TIMESTAMP(", to_text(x$timestamp), ")")
}
#' @export
to_text.cql2_date <- function(x) {
paste0("DATE(", to_text(x$date), ")")
}
#' @export
to_text.cql2_casei_op <- function(x) {
paste0("CASEI(", to_text(x$casei), ")")
}
#' @export
to_text.cql2_accenti_op <- function(x) {
paste0("ACCENTI(", to_text(x$accenti), ")")
}
#' @export
to_text.cql2_interval <- function(x) {
paste0("INTERVAL(", to_text(x$interval[[1]]), ",",
to_text(x$interval[[2]]), ")")
}
#' @export
to_text.cql2 <- function(x) {
to_text(cql2_filter(x))
}
#' @export
to_text.default <- function(x) {
stop(paste("cannot handle value of class", class(x)), call. = FALSE)
}
# ---- not_op + some operator ----
text_not_op <- function(x) {
UseMethod("text_not_op", x$args[[1]])
}
#' @export
text_not_op.cql2_isnull_op <- function(x) {
paste(to_text(x$args[[1]]$args[[1]]), "IS NOT NULL")
}
# is there infix NOT operator?
# like_op
#' @export
text_not_op.cql2_like_op <- function(x) {
paste(to_text(x$args[[1]]$args[[1]]), "NOT LIKE",
to_text(x$args[[1]]$args[[2]]))
}
# between_op
#' @export
text_not_op.cql2_between_op <- function(x) {
paste(to_text(x$args[[1]]$args[[1]]), "NOT BETWEEN",
to_text(x$args[[1]]$args[[2]]), "AND",
to_text(x$args[[1]]$args[[3]]))
}
# in_op
#' @export
text_not_op.cql2_in_op <- function(x) {
paste(to_text(x$args[[1]]$args[[1]]), "NOT IN",
to_text(x$args[[1]]$args[[2]]))
}
#' @export
text_not_op.default <- function(x) {
paste("NOT", to_text(x$args[[1]]))
}
# ---- convert to wkt ----
wkt_spatial_type <- function(x) {
if (!"type" %in% names(x) ||
!any(c("coordinates", "geometries") %in% names(x)))
.error("Not a valid GeoJSON geometry.")
x$type
}
wkt_spatial_switch <- function(x, ...) {
switch(wkt_spatial_type(x), ...,
.error("WKT type '%s' is not supported.", wkt_spatial_type(x)))
}
wkt_collection <- function(x) {
paste0(map_chr(x$geometries, to_wkt), collapse = ",")
}
wkt_coords_chr <- function(x) {
if (is.list(x)) {
x <- unlist(x, recursive = FALSE)
if (!is.numeric(x))
.error("Invalid coordinates values")
x <- matrix(x, ncol = 2, byrow = TRUE)
}
paste(apply(x, 1, wkt_coord0, simplify = TRUE), collapse = ",")
}
wkt_coord0 <- function(x) {
paste(num_format(x), collapse = " ")
}
wkt_coord1 <- function(x) {
wkt_coords_chr(x)
}
wkt_coord2 <- function(x) {
paste0("(", map_chr(x, wkt_coords_chr), ")", collapse = ",")
}
wkt_coord3 <- function(x) {
paste0("(", map_chr(x, wkt_coord2), ")", collapse = ",")
}
to_wkt <- function(x) {
wkt_spatial_switch(
x,
"Point" = paste0(
"POINT(", wkt_coord0(x$coordinates), ")"
),
"MultiPoint" = paste0(
"MULTIPOINT(", wkt_coord1(x$coordinates) , ")"
),
"LineString" = paste0(
"LINESTRING(", wkt_coord1(x$coordinates) , ")"
),
"MultiLineString" = paste0(
"MULTILINESTRING(", wkt_coord2(x$coordinates) , ")"
),
"Polygon" = paste0(
"POLYGON(", wkt_coord2(x$coordinates) , ")"
),
"MultiPolygon" = paste0(
"MULTIPOLYGON(", wkt_coord3(x$coordinates) , ")"
),
"GeometryCollection" = paste0(
"GEOMETRYCOLLECTION(", wkt_collection(x), ")"
)
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.