R/coord_conv_wrapper.R

In madlogos/aseshms: Toolkit for ASES HMS Team

#' Generic Function to Convert coordinates
#'
#' The general function that converts lat/lon coordintes from one GCS to another
#' GCS including WGS-84, GCJ-02 and BD-09 either locally or by calling Baidu
#' Maps API.
#' 
#' The original function turns on \code{api}, which calls Google or Baidu APIs and
#' may thus be slow. This version by default turns off \code{api} and applies 
#' built-in conversion functions to do the trick and thus performs faster.
#' @param lat a numeric latitude
#' @param lon a numeric longitude
#' @param from the inputting GCS
#' @param to the outputting GCS
#' @param api use baidu maps api. Note that baidu maps api only supports the
#' transformations from WGS-84 or GCJ-02 to BD-09. Other coodinate conversions
#' must be done locally. As the conversion result is the same, it's recommended
#' to perform conversions locally.
#' @return a 2-col data.frame ([lng, lat]) of transformed coordinates.
#' @author Jun Cai (\email{cai-j12@@mails.tsinghua.edu.cn}), PhD student from
#' Center for Earth System Science, Tsinghua University
#' @details Note that the baidu maps api limits to 20 lat/lon coordinates per query.
#' Since the coordinate conversion results of Baidu Maps API and local algorithms
#' are the same, it is recommended to use local algorithms.
#' @seealso \code{\link{convWGS2GCJ}}, \code{\link{convWGS2BD}}, \code{\link{convGCJ2WGS}},
#' \code{\link{convGCJ2BD}}, \code{\link{convBD2WGS}}, \code{\link{convBD2GCJ}}.
#' @export
#' @aliases conv_coord
#' @importFrom curl curl
#' @importFrom jsonlite fromJSON
#' @examples
#' \dontrun{
#' # latitude/longitude coordinates of Beijing railway station
#' # WGS-84: (39.90105, 116.42079)
#' # GCJ-02: (39.90245, 116.42703)
#' # BD-09:  (39.90851, 116.43351)
#' convCoord(39.90105, 116.42079, from = 'WGS-84', to = 'GCJ-02')
#' convCoord(39.90105, 116.42079, from = 'WGS-84', to = 'GCJ-02', api = TRUE)
#' convCoord(39.90105, 116.42079, from = 'WGS-84', to = 'BD-09')
#' convCoord(39.90105, 116.42079, from = 'WGS-84', to = 'BD-09', api = TRUE)
#' convCoord(39.90245, 116.42703, from = 'GCJ-02', to = 'WGS-84')
#' 
#' # not supported by baidu map api, return NAs
#' convCoord(39.90245, 116.42703, from = 'GCJ-02', to = 'WGS-84', api = TRUE)
#' convCoord(39.90245, 116.42703, from = 'GCJ-02', to = 'BD-09')
#' convCoord(39.90245, 116.42703, from = 'GCJ-02', to = 'BD-09', api = TRUE)
#' convCoord(39.90851, 116.43351, from = 'BD-09', to = 'GCJ-02')
#'
#' # not supported by baidu map api, return NAs
#' convCoord(39.90851, 116.43351, from = 'BD-09', to = 'GCJ-02', api = TRUE)
#' convCoord(39.90851, 116.43351, from = 'BD-09', to = 'WGS-84')
#'
#' # not supported by baidu map api, return NAs
#' convCoord(39.90851, 116.43351, from = 'BD-09', to = 'WGS-84', api = TRUE)
#'
#' # convert multiple coordinates
#' lat = c(39.99837, 39.98565)
#' lng = c(116.3203, 116.2998)
#' convCoord(lat, lng, from = 'WGS-84', to = 'GCJ-02')
#' }
convCoord <- function(lat, lon, from = c('WGS-84', 'GCJ-02', 'BD-09'),
                 to = c('WGS-84', 'GCJ-02', 'BD-09'), api = FALSE){
    # check parameters
    stopifnot(is.numeric(lat))
    stopifnot(is.numeric(lon))
    from <- match.arg(from)
    to <- match.arg(to)
    stopifnot(is.logical(api))

    # vectorize
    if(length(lat) > 1){
        return(ldply(seq_along(lat), function(i){
            convCoord(lat[i], lon[i], from = from, to = to, api = api) }))
    }

    if (from == to){
        return(data.frame(lat = lat, lng = lon))
    } else{
        if(api){
            # coordinate system lookup table
            code <- c(0, 2, 4)
            names(code) <- c('WGS-84', 'GCJ-02', 'BD-09')
            f <- code[from]
            t <- code[to]

            # format url
            # http://api.map.baidu.com/ag/coord/convert?x=lon&y=lat&from=FROM&to=TO
            url_string <- paste('http://api.map.baidu.com/ag/coord/convert?x=', lon,
                                '&y=', lat, '&from=', f, '&to=', t, sep = '')
            message(paste('calling ', url_string, ' ... ', sep = ''), appendLF = F)

            # convert
            con <- curl(URLencode(url_string))
            cv <- fromJSON(paste(readLines(con, warn = FALSE), collapse = ''), drop = FALSE)
            message('done.')
            close(con)

            # did convert fail?
            if(is.list(cv)){
                if(cv$error == 0){
                    cvdf <- with(cv, {data.frame(lat = as.numeric(base64(y, FALSE)),
                                                 lng = as.numeric(base64(x, FALSE)),
                                                 row.names = NULL)})
                    return(cvdf)
                }
            } else{
                warning(paste('convert failed with error ', cv['error'],
                              '. conversion is not supported by baidu map api.',
                              sep = ''),
                        call. = FALSE)
                return(data.frame(lat = NA, lng = NA))
            }
        } else{
            if (from == 'WGS-84' & to == 'GCJ-02') return(convWGS2GCJ(lat, lon))
            if (from == 'WGS-84' & to == 'BD-09') return(convWGS2BD(lat, lon))
            if (from == 'GCJ-02' & to == 'WGS-84') return(convGCJ2WGS(lat, lon))
            if (from == 'GCJ-02' & to == 'BD-09') return(convGCJ2BD(lat, lon))
            if (from == 'BD-09' & to == 'WGS-84') return(convBD2WGS(lat, lon))
            if (from == 'BD-09' & to == 'GCJ-02') return(convBD2GCJ(lat, lon))
        }
    }
}

#' @export
conv_coord <- convCoord