#' Lawn print methods to provide summary view
#'
#' @name print-methods
#' @param x Input.
#' @param n (integer) Number of rows to print, when properties is large object.
#' @param ... Print options.
#' @examples
#' # point
#' lawn_point(c(-74.5, 40))
#'
#' # polygon
#' rings <- list(list(
#' c(-2.275543, 53.464547),
#' c(-2.275543, 53.489271),
#' c(-2.215118, 53.489271),
#' c(-2.215118, 53.464547),
#' c(-2.275543, 53.464547)
#' ))
#' lawn_polygon(rings, properties = list(name = 'poly1', population = 400))
#'
#' # linestring
#' linestring1 <- '[
#' [-21.964416, 64.148203],
#' [-21.956176, 64.141316],
#' [-21.93901, 64.135924],
#' [-21.927337, 64.136673]
#' ]'
#' lawn_linestring(linestring1)
#' lawn_linestring(linestring1, properties = list(name = 'line1',
#' distance = 145))
#'
#' # featurecollection
#' lawn_featurecollection(lawn_data$featurecollection_eg1)
#'
#' # feature
#' serbia <- '{
#' "type": "Feature",
#' "properties": {"color": "red"},
#' "geometry": {
#' "type": "Point",
#' "coordinates": [20.566406, 43.421008]
#' }
#' }'
#' lawn_flip(serbia)
#'
#' # multipoint
#' mpt <- '{
#' "type": "FeatureCollection",
#' "features": [
#' {
#' "type": "Feature",
#' "properties": {},
#' "geometry": {
#' "type": "Point",
#' "coordinates": [19.026432, 47.49134]
#' }
#' }, {
#' "type": "Feature",
#' "properties": {},
#' "geometry": {
#' "type": "Point",
#' "coordinates": [19.074497, 47.509548]
#' }
#' }
#' ]
#' }'
#' x <- lawn_combine(mpt)
#' x$properties <- data.frame(color = c("red", "green"),
#' size = c("small", "large"),
#' popultion = c(5000, 10000L))
#' x
#'
#' # multilinestring
#' mlstring <- '{
#' "type": "FeatureCollection",
#' "features": [
#' {
#' "type": "Feature",
#' "properties": {},
#' "geometry": {
#' "type": "LineString",
#' "coordinates": [
#' [-21.964416, 64.148203],
#' [-21.956176, 64.141316],
#' [-21.93901, 64.135924],
#' [-21.927337, 64.136673]
#' ]
#' }
#' }, {
#' "type": "Feature",
#' "properties": {},
#' "geometry": {
#' "type": "LineString",
#' "coordinates": [
#' [-21.929054, 64.127985],
#' [-21.912918, 64.134726],
#' [-21.916007, 64.141016],
#' [-21.930084, 64.14446]
#' ]
#' }
#' }
#' ]
#' }'
#' x <- lawn_combine(mlstring)
#' x$properties <- data.frame(color = c("red", "green"),
#' size = c("small", "large"),
#' popultion = c(5000, 10000L))
#' x
NULL
# print functions -------------------------
#' @export
#' @noRd
print.point <- function(x, ...) {
cat("<Point>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
pt <- x$geometry$coordinates
cat(sprintf(" Coordinates: %s", sprintf("%.1f %.1f", pt[1], pt[2])),
sep = "\n")
cat_props(x)
}
#' @export
#' @noRd
print.multipoint <- function(x, n = 10, ...) {
cat("<MultiPoint>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. points: %s", NROW(x$geometry$coordinates)), sep = "\n")
cat_props_df2(x, n)
}
#' @export
#' @noRd
print.polygon <- function(x, ...) {
cat("<Polygon>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. points: %s", length(x$geometry$coordinates[,,1])),
sep = "\n")
cat_props(x)
}
#' @export
#' @noRd
print.multipolygon <- function(x, n = 10, ...) {
cat("<MultiPolygon>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. polygons: %s", length(x$coordinates)), sep = "\n")
cat(sprintf(" No. points: %s", length(unlist(x$coordinates))), sep = "\n")
cat_props_df2(x, n)
}
#' @export
#' @noRd
print.linestring <- function(x, ...) {
cat("<LineString>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. points: %s", length(x$geometry$coordinates)), sep = "\n")
cat_props(x)
}
#' @export
#' @noRd
print.multilinestring <- function(x, n = 10, ...) {
cat("<MultiLineString>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. lines: %s", NROW(x$geometry$coordinates)), sep = "\n")
cat(sprintf(" No. points: %s", length(x$geometry$coordinates)), sep = "\n")
cat_props_df2(x, n)
}
#' @export
#' @noRd
print.featurecollection <- function(x, n = 10, ...) {
cat("<FeatureCollection>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. features: %s", length(x$features$geometry$coordinates)),
sep = "\n")
cat(sprintf(" No. points: %s", length(unlist(x$features$geometry$coordinates,
recursive = TRUE))), sep = "\n")
cat_props_df(x, n)
}
#' @export
#' @noRd
print.geometrycollection <- function(x, n = 10, ...) {
cat("<GeometryCollection>", sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. geometries: %s", NROW(x$geometry$geometries)), sep = "\n")
cat(sprintf(" No. points: %s",
length(unlist(x$geometry$geometries$coordinates,
recursive = TRUE))), sep = "\n")
cat_props_df2(x, n)
}
#' @export
#' @noRd
print.feature <- function(x, n = 10, ...) {
cat("<Feature>", sep = "\n")
cat(sprintf(" Type: %s", x$geometry$type), sep = "\n")
cat(sprintf(" Bounding box: %s", cat_bbox(x)), sep = "\n")
cat(sprintf(" No. points: %s", length(unlist(x$geometry$coordinates,
recursive = TRUE))), sep = "\n")
cat_props(x)
}
# helper print functions -------------------------
cat_props <- function(x) {
if (length(x$properties) != 0) {
cat(" Properties: ", sep = "\n")
for (i in seq_along(x$properties)) {
cat(sprintf(" %s: %s", names(x$properties[i]),
x$properties[[i]]), sep = "\n")
}
} else {
props_null()
}
}
cat_props_df2 <- function(x, n) {
if (length(x$properties) != 0) {
cat(" Properties: ", sep = "\n")
if (inherits(x$properties, "data.frame")) {
trunc_mat(x$properties, n = n)
} else {
for (i in seq_along(x$properties)) {
cat(sprintf(" %s: %s", names(x$properties[i]),
x$properties[[i]]), sep = "\n")
}
}
} else {
props_null()
}
}
cat_props_df <- function(x, n) {
if (length(x$features$properties) != 0) {
cat(" Properties: ", sep = "\n")
if (inherits(x$features$properties, "data.frame")) {
trunc_mat(x$features$properties, n = n)
} else {
for (i in seq_along(x$features$properties)) {
cat(sprintf(" %s: %s", names(x$features$properties[i]),
x$features$properties[[i]]), sep = "\n")
}
}
} else {
props_null()
}
}
cat_bbox <- function(x) {
b <- lawn_extent(x)
sprintf("%.1f %.1f %.1f %.1f", b[1], b[2], b[3], b[4])
}
props_null <- function() {
cat(" Properties: NULL", sep = "\n")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.