R/get_bounds.R

In jeanmathieupotvin/scr: Spatial scoring algorithms :: scorer

get_bounds <- function(x, api = "epsg.io")
{
    if (!requireNamespace("curl", TRUE) ||
        !requireNamespace("xml2", TRUE) ||
        !requireNamespace("rvest", TRUE) ||
        !requireNamespace("stringr", TRUE)) {
        stop("packages 'curl', 'rvest', 'stringr' ",
             "and 'xml2' are needed.", call. = FALSE)
    }

    stopifnot(is.numeric(x))

    on.exit(closeAllConnections())

    x <- as.integer(x)

    api <- match.arg(api)
    url <- switch(api, "epsg.io" = "https://epsg.io/", NULL)

    if (identical(api, "epsg.io")) {
        con <- curl::curl(paste0(url, x))
        htm <- tryCatch(xml2::read_html(con),
                        error = function(e) return(NULL))
        res <- .get_bounds.epsg.io(htm)
    }

    res
}

.get_bounds.epsg.io <- function(htm)
{
    prot <- matrix(NA, 2L, 4L)

    if (!is.null(htm)) {
        txt <- rvest::html_text(rvest::html_nodes(htm, "p"))
        txt <- stringr::str_squish(txt)
        txt <- txt[stringr::str_detect(txt, "bounds")]

        if (length(txt)) {
            txt <- stringr::str_extract(txt, "(?<=:[:space:]).*")

            res <- stringr::str_split(txt, "[:space:]", simplify = TRUE)
            res <- apply(res, c(1L, 2L), as.numeric)

            nr <- nrow(res)

            if (identical(nr, 1L)) {
                res <- rbind(matrix(NA, 1L, 4L), res)
            }

            if (nr > 2L) {
                res <- prot
            }
        } else {
            res <- prot
        }
    } else {
        res <- prot
    }

    rownames(res) <- c("proj", "lonlat")
    colnames(res) <- c("xmin", "ymin", "xmax", "ymax")

    res
}