R/proj.R

Defines functions validate_proj to_proj is_ll

is_ll <- function(x) {
  if (is.factor(x)) x <- levels(x)[x]
  x <- tolower(trimws(as.character(x)))
  ss <- substr(trimws(x), 1, 1)
  out <- (grepl("longlat", x) && ss == "+") | (grepl("lonlat", x) && ss == "+") | (grepl("ogc:crs84", x))
  if (isTRUE(out)) {
    return(out)  ## shortcut
  } else {
    ## I await my punishment
    codes <- as.character(.epsg_code)  ## internal data
    for (i in seq_along(codes)) {
      ## we might have the code, or an init string, or a new style EPSG:code string
      out <- codes[i] == x ||
        grepl(sprintf("^\\+init=epsg:%s", codes[i]), x) ||
        grepl(sprintf("^epsg:%s", codes[i]), x)
      #print(codes[i])
      if (out) {
        ## we only grepped above so
        codecode <- as.integer(gsub("[^0-9.-]", "", x))
        if (!is.finite(codecode) || codecode >= 10000) {
          out <- FALSE
        }
        return(out)
      }
    }
  }
  FALSE  ## we tried
}
to_proj <- function(x) {


  ## integer of 4 or 5 digits,
  ## or is a character string
  if (is.numeric(x) || (nchar(x) %in% c(4, 5, 6) && grepl("^[0-9]{1,5}$", x))) {
    ## here we need PROJ::ok_proj6() pivot
    if (!PROJ::ok_proj6()) {
      ## we are PROJ library version < 6
      x <- sprintf("+init=epsg:%i", as.integer(x))
    } else {
      ## we are PROJ library version >= 6
      x <- sprintf("EPSG:%i", as.integer(x))
    }
  }
  x <- trimws(x, which = "left")
  ## TODO: otherwise doesn't look like a proj string ...
  ## only in older versions, because this might be WKT2 now
  if (!PROJ::ok_proj6() && !substr(x, 1, 1) == "+") warning("not a proj-like string")
  x
}
validate_proj <- function(x) {
  if (!is.character(x)) stop("coordinate system must be character")
  TRUE
}

Try the reproj package in your browser

Any scripts or data that you put into this service are public.

reproj documentation built on Oct. 29, 2022, 1:09 a.m.