Skip to content

Commit

Permalink
🎨 clean check
Browse files Browse the repository at this point in the history
  • Loading branch information
Kevin Cazelles committed Sep 25, 2020
1 parent 8bc68f5 commit 686d1c1
Show file tree
Hide file tree
Showing 9 changed files with 224 additions and 277 deletions.
2 changes: 2 additions & 0 deletions .Rbuildignore
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,4 @@
^.*\.Rproj$
^\.Rproj\.user$
^vignettes/rsconnect/documents/esri2sf-vignettes\.Rmd/rpubs\.com/rpubs/Document\.dcf$
^vignettes/rsconnect/documents/esri2sf-vignettes\.Rmd/rpubs\.com/rpubs/Publish Document\.dcf$
11 changes: 8 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,19 +2,24 @@ Package: esri2sf
Type: Package
Title: Create Simple Features from ArcGIS Server REST API
Version: 0.1.1
Authors@R: person("Yongha", "Hwang", email = "yongha.hwang@gmail.com",
role = c("aut", "cre"))
Authors@R: c(
person("Yongha", "Hwang", email = "yongha.hwang@gmail.com", role = c("aut", "cre")),
person("Cazelles", "Kevin", role = c("aut", "ctb"))
)
Description: This package enables you to scrape geographic features
directly from ArcGIS servers REST API into R as simple features.
License: MIT
License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
Depends: R (>= 3.1.0)
Imports:
dplyr,
jsonlite,
httr,
rstudioapi,
sf
Suggests:
knitr,
RoxygenNote: 7.1.1
Roxygen: list(markdown = TRUE)
VignetteBuilder: knitr
2 changes: 2 additions & 0 deletions LICENSE
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
YEAR: 2020
COPYRIGHT HOLDER: Yongha Hwang
17 changes: 11 additions & 6 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,14 @@

export(esri2df)
export(esri2sf)
export(generateOAuthToken)
export(generateToken)
import(dplyr)
import(httr)
import(jsonlite)
import(sf)
importFrom(dplyr,"%>%")
importFrom(httr,GET)
importFrom(httr,POST)
importFrom(httr,config)
importFrom(httr,content)
importFrom(jsonlite,fromJSON)
importFrom(sf,st_multilinestring)
importFrom(sf,st_multipolygon)
importFrom(sf,st_point)
importFrom(sf,st_sf)
importFrom(sf,st_sfc)
269 changes: 42 additions & 227 deletions R/esri2sf.R
View file
Original file line number Diff line number Diff line change
@@ -1,252 +1,67 @@
#' Main Functions
#' Import data from ESRI's ArcGIS Server
#'
#' These functions are the interface to the user.
#' @import jsonlite httr sf dplyr
#' @param url string for service url. ex) \url{https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/3}
#' @param outFields vector of fields you want to include. default is '*' for all fields
#' @param where string for where condition. default is 1=1 for all rows
#' @param token. string for authentication token if needed.
#' @param geomType string specifying the layer geometry ('esriGeometryPolygon' or 'esriGeometryPoint' or 'esriGeometryPolyline' - if NULL, will try to be infered from the server)
#'
#' @param url string for service url., e.g. <https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/>.
#' @param outFields vector of fields you want to include. default is '*' for all fields"
#' @param where string for where condition. default is 1=1 for all rows"
#' @param token string for authentication token if needed.
#' @param geomType string specifying the layer geometry ('esriGeometryPolygon' or 'esriGeometryPoint' or 'esriGeometryPolyline' - if NULL, will try to be inferred from the server)
#' @param ... additional named parameters to pass to the query. ex) "resultRecordCount = 3"
#' @return sf dataframe (\code{esri2sf}) or tibble dataframe (\code{esri2df})

#' @return sf dataframe `esri2sf`) or tibble dataframe `esri2sf`)

#' @describeIn esri2sf Retrieve spatial object

#' @note When accessing services with multiple layers, the layer number must be specified at the end of the service url
#' (e.g., \url{https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/3}).
#' (e.g., <https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/3>).
#'
#' The list of layers and their respective id numbers can be found by viewing the service's url in a web broswer
#' and viewing the "Layers" heading
#' (e.g.,\url{https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/#mapLayerList}).
#' (e.g., <https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/#mapLayerList>).
#'
#' @examples
#' url <- "https://sampleserver1.arcgisonline.com/ArcGIS/rest/services/Demographics/ESRI_Census_USA/MapServer/3"
#' baseURL <- "https://sampleserver1.arcgisonline.com/ArcGIS/rest/"
#' url <- paste0(baseURL, "services/Demographics/ESRI_Census_USA/MapServer/3")
#' outFields <- c("POP2007", "POP2000")
#' where <- "STATE_NAME = 'Michigan'"
#' df <- esri2sf(url, outFields=outFields, where=where)
#' plot(df)
#'
#' @export
esri2sf <- function(url, outFields=c("*"), where="1=1", token='', geomType=NULL, ...) {
library(httr)
library(jsonlite)
library(sf)
library(dplyr)
layerInfo <- jsonlite::fromJSON(
httr::content(
httr::POST(
url,
query=list(f="json", token=token),
encode="form",
config = httr::config(ssl_verifypeer = FALSE)
),
as="text"
)
)

esri2sf <- function(url, outFields = c("*"), where = "1=1", token = "", geomType = NULL,
...) {
layerInfo <- jsonlite::fromJSON(content(POST(url, query = list(f = "json",
token = token), encode = "form", config = config(ssl_verifypeer = FALSE)),
as = "text"))
print(layerInfo$type)
if (is.null(geomType)) {
if (is.null(layerInfo$geometryType))
if (is.null(layerInfo$geometryType))
stop("geomType is NULL and layer geometry type ('esriGeometryPolygon' or 'esriGeometryPoint' or 'esriGeometryPolyline') could not be infered from server.")

geomType <- layerInfo$geometryType
}
print(geomType)
queryUrl <- paste(url, "query", sep="/")
queryUrl <- paste(url, "query", sep = "/")
esriFeatures <- getEsriFeatures(queryUrl, outFields, where, token, ...)
simpleFeatures <- esri2sfGeom(esriFeatures, geomType)
return(simpleFeatures)
esri2sfGeom(esriFeatures, geomType)
}

#' @describeIn esri2sf Retrieve table object (no spatial data)
#' @describeIn esri2sf Retrieve table object (no spatial data).
#' @export
esri2df <- function(url, outFields=c("*"), where="1=1", token='', ...) {
library(httr)
library(jsonlite)
library(sf)
library(dplyr)
layerInfo <- jsonlite::fromJSON(
httr::content(
httr::POST(
url,
query=list(f="json", token=token),
encode="form",
config = httr::config(ssl_verifypeer = FALSE)
),
as="text"
)
)
esri2df <- function(url, outFields = c("*"), where = "1=1", token = "", ...) {
layerInfo <- fromJSON(content(
POST(url,
query = list(f = "json", token = token),
encode = "form",
config = config(ssl_verifypeer = FALSE)
), as = "text"))

print(layerInfo$type)
if (layerInfo$type != 'Table') {
stop("Layer type for URL is not 'Table'.")
}
queryUrl <- paste(url, "query", sep="/")
esriFeatures <- getEsriFeatures(queryUrl, outFields, where, token)#, ...)
esriTable <- getEsriTable(esriFeatures)
return(esriTable)
}

getEsriFeatures <- function(queryUrl, fields, where, token='', ...) {
ids <- getObjectIds(queryUrl, where, token, ...)
if(is.null(ids)){
warning("No records match the search critera")
return()
}
idSplits <- split(ids, ceiling(seq_along(ids)/500))
results <- lapply(idSplits, getEsriFeaturesByIds, queryUrl, fields, token, ...)
merged <- unlist(results, recursive=FALSE)
return(merged)
}

getObjectIds <- function(queryUrl, where, token='', ...){
# create Simple Features from ArcGIS servers json response
query <- list(
where=where,
returnIdsOnly="true",
token=token,
f="json",
...
)
responseRaw <- httr::content(
httr::POST(
queryUrl,
body=query,
encode="form",
config = httr::config(ssl_verifypeer = FALSE)),
as="text"
)
response <- jsonlite::fromJSON(responseRaw)
return(response$objectIds)
}

getEsriFeaturesByIds <- function(ids, queryUrl, fields, token='', ...){
# create Simple Features from ArcGIS servers json response
query <- list(
objectIds=paste(ids, collapse=","),
outFields=paste(fields, collapse=","),
token=token,
outSR='4326',
f="json",
...
)
responseRaw <- httr::content(
httr::POST(
queryUrl,
body=query,
encode="form",
config = httr::config(ssl_verifypeer = FALSE)
),
as="text"
)
response <- jsonlite::fromJSON(responseRaw,
simplifyDataFrame = FALSE,
simplifyVector = FALSE,
digits=NA)
esriJsonFeatures <- response$features
return(esriJsonFeatures)
}

getEsriTable <- function(jsonFeats) {
atts <- lapply(jsonFeats, '[[', 1) %>%
lapply(function(att) lapply(att, function(x) return(ifelse(is.null(x), NA, x))))
df <- dplyr::bind_rows(lapply(atts, as.data.frame.list, stringsAsFactors=FALSE)) %>% dplyr::as_tibble()
return(df)
}

esri2sfGeom <- function(jsonFeats, geomType) {
# convert esri json to simple feature
if (geomType == 'esriGeometryPolygon') {
geoms <- esri2sfPolygon(jsonFeats)
}
if (geomType == 'esriGeometryPoint') {
geoms <- esri2sfPoint(jsonFeats)
}
if (geomType == 'esriGeometryPolyline') {
geoms <- esri2sfPolyline(jsonFeats)
}
# attributes
atts <- lapply(jsonFeats, '[[', 1) %>%
lapply(function(att) lapply(att, function(x) return(ifelse(is.null(x), NA, x))))

af <- dplyr::bind_rows(lapply(atts, as.data.frame.list, stringsAsFactors=FALSE))
# geometry + attributes
df <- sf::st_sf(geoms, af, crs = 4326)
return(df)
}

esri2sfPoint <- function(features) {
getPointGeometry <- function(feature) {
if (is.numeric(unlist(feature$geometry))){
return(sf::st_point(unlist(feature$geometry)))
} else {
return(sf::st_point())
}
}
geoms <- sf::st_sfc(lapply(features, getPointGeometry))
return(geoms)
}

esri2sfPolygon <- function(features) {
ring2matrix <- function(ring) {
return(do.call(rbind, lapply(ring, unlist)))
}
rings2multipoly <- function(rings) {
return(sf::st_multipolygon(list(lapply(rings, ring2matrix))))
}
getGeometry <- function(feature) {
if(is.null(unlist(feature$geometry$rings))){
return(sf::st_multipolygon())
} else {
return(rings2multipoly(feature$geometry$rings))
}
}
geoms <- sf::st_sfc(lapply(features, getGeometry))
return(geoms)
}

esri2sfPolyline <- function(features) {
path2matrix <- function(path) {
return(do.call(rbind, lapply(path, unlist)))
}
paths2multiline <- function(paths) {
return(sf::st_multilinestring(lapply(paths, path2matrix)))
}
getGeometry <- function(feature) {
return(paths2multiline(feature$geometry$paths))
}
geoms <- sf::st_sfc(lapply(features, getGeometry))
return(geoms)
}

#' @export
generateToken <- function(server, uid, pwd='', expiration=5000){
# generate auth token from GIS server
if (pwd=='') {
pwd <- rstudioapi::askForPassword("pwd")
}
query <- list(
username=uid,
password=pwd,
expiration=expiration,
client="requestip",
f="json"
)
url <- paste(server, "arcgis/admin/generateToken", sep="/")
r <- httr::POST(url, body=query, encode="form")
token <- jsonlite::fromJSON(httr::content(r, "parsed"))$token
return(token)
}

#' Generate a OAuth token for Arcgis Online
#' @param clientId string clientId
#' @param clientSecret string clientSecret.
#' @return string token
#'
#' How to obtain clientId and clientSecret is described here:
#' https://developers.arcgis.com/documentation/core-concepts/security-and-authentication/accessing-arcgis-online-services/
#' @export
generateOAuthToken <- function(clientId,clientSecret,expiration=5000) {

query=list(client_id=clientId,
client_secret=clientSecret,
expiration=expiration,
grant_type="client_credentials")

r <- httr::POST("https://www.arcgis.com/sharing/rest/oauth2/token",body=query)
token <- content(r,type = "application/json")$access_token
return(token)
if (layerInfo$type != "Table") stop("Layer type for URL is not 'Table'.")

queryUrl <- paste(url, "query", sep = "/")
esriFeatures <- getEsriFeatures(queryUrl, outFields, where, token) #, ...)
getEsriTable(esriFeatures)
}
Loading

0 comments on commit 686d1c1

Please sign in to comment.