├── vignettes ├── .gitignore ├── geoplumber.png ├── geoplumber2.png ├── geoplumber3.png ├── geoplumber4.png ├── geoplumber-concept.png ├── paper.Rmd └── gisruk.bib ├── data ├── traffic.rda ├── uni_point.rda ├── uni_poly.rda ├── traffic_network.rda ├── traffic_volumes.rda └── traffic_casualties_2014.rda ├── man ├── figures │ ├── gp.png │ └── geoplumber-concept.png ├── read_tempfile.Rd ├── get_os.Rd ├── tempfile_name.Rd ├── is_port_engated.Rd ├── gp_install_npm_package.Rd ├── gp_erase.Rd ├── gp_install_node_instructions.Rd ├── gp_rstudio.Rd ├── gp_create.Rd ├── gp_npm_exists.Rd ├── gp_kill_process.Rd ├── gp_explore.Rd ├── add_lines.Rd ├── gp_plumb_front.Rd ├── change_to_proj_dir.Rd ├── gp_remove_lines.Rd ├── gp_sf.Rd ├── gp_is_wd_geoplumber.Rd ├── uni_point.Rd ├── gp_geojson.Rd ├── gp_build.Rd ├── gp_clean.Rd ├── traffic_network.Rd ├── add_import_component.Rd ├── gp_check_clip_endpoint.Rd ├── gp_change_file.Rd ├── gp_map.Rd ├── traffic.Rd ├── gp_add_slider.Rd ├── traffic_casualties_2014.Rd ├── gp_add_geojson.Rd ├── traffic_volumes.Rd ├── gp_endpoint_from_clip.Rd └── gp_plumb.Rd ├── tests ├── testthat.R └── testthat │ ├── test-data.R │ ├── test-map.R │ ├── test-explore.R │ ├── test-add-slider.R │ ├── test-add-geojson.R │ ├── test-geojson.R │ ├── test-add-endpoints.R │ ├── test-utils.R │ └── test-build.R ├── inst ├── js │ ├── public │ │ ├── favicon.ico │ │ ├── manifest.json │ │ └── index.html │ ├── src │ │ ├── img │ │ │ └── layers.png │ │ ├── App.test.js │ │ ├── App.js │ │ ├── index.js │ │ ├── components │ │ │ ├── RBSlider.jsx │ │ │ ├── Header.jsx │ │ │ ├── RBDropdownComponent.jsx │ │ │ └── GeoJSONComponent.jsx │ │ ├── Welcome.js │ │ ├── logo.svg │ │ ├── utils.js │ │ ├── registerServiceWorker.js │ │ └── App.css │ └── package.json ├── rproj_template ├── templates │ └── package.json.geospatial ├── build.missing.html ├── plumber.R └── geoplumber.html ├── .Rbuildignore ├── .gitignore ├── NAMESPACE ├── geoplumber.Rproj ├── data-raw └── package.json.Rmd ├── R ├── install_node_instructions.R ├── install_npm_package.R ├── plumb_front.R ├── is_wd_geoplumber.R ├── add_slider.R ├── plumb.R ├── explore.R ├── build.R ├── create.R ├── add_geojson.R ├── data.R ├── sf.R ├── geojson.R ├── endpoint_from_clip.R └── utils.R ├── DESCRIPTION ├── .travis.yml ├── README.Rmd └── README.md /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /data/traffic.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/traffic.rda -------------------------------------------------------------------------------- /data/uni_point.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/uni_point.rda -------------------------------------------------------------------------------- /data/uni_poly.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/uni_poly.rda -------------------------------------------------------------------------------- /man/figures/gp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/man/figures/gp.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(geoplumber) 3 | 4 | test_check("geoplumber") 5 | -------------------------------------------------------------------------------- /data/traffic_network.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/traffic_network.rda -------------------------------------------------------------------------------- /data/traffic_volumes.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/traffic_volumes.rda -------------------------------------------------------------------------------- /inst/js/public/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/inst/js/public/favicon.ico -------------------------------------------------------------------------------- /inst/js/src/img/layers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/inst/js/src/img/layers.png -------------------------------------------------------------------------------- /vignettes/geoplumber.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/vignettes/geoplumber.png -------------------------------------------------------------------------------- /vignettes/geoplumber2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/vignettes/geoplumber2.png -------------------------------------------------------------------------------- /vignettes/geoplumber3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/vignettes/geoplumber3.png -------------------------------------------------------------------------------- /vignettes/geoplumber4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/vignettes/geoplumber4.png -------------------------------------------------------------------------------- /data/traffic_casualties_2014.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/data/traffic_casualties_2014.rda -------------------------------------------------------------------------------- /vignettes/geoplumber-concept.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/vignettes/geoplumber-concept.png -------------------------------------------------------------------------------- /man/figures/geoplumber-concept.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ATFutures/geoplumber/HEAD/man/figures/geoplumber-concept.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^README\.Rmd$ 2 | ^geoplumber$ 3 | ^my_app$ 4 | ^my-app$ 5 | ^Dockerfile$ 6 | ^DONT_COMMIT\.r$ 7 | ^.*\.Rproj$ 8 | ^geoplumber\.Rproj$ 9 | ^\.Rproj\.user$ 10 | ^\.travis\.yml$ 11 | /node_modules 12 | data-raw/ 13 | -------------------------------------------------------------------------------- /inst/rproj_template: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: XeLaTeX 14 | -------------------------------------------------------------------------------- /inst/js/src/App.test.js: -------------------------------------------------------------------------------- 1 | import React from 'react'; 2 | import ReactDOM from 'react-dom'; 3 | import App from './App'; 4 | 5 | it('renders without crashing', () => { 6 | const div = document.createElement('div'); 7 | ReactDOM.render(, div); 8 | ReactDOM.unmountComponentAtNode(div); 9 | }); 10 | -------------------------------------------------------------------------------- /man/read_tempfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{read_tempfile} 4 | \alias{read_tempfile} 5 | \title{returns the project name from the temp file} 6 | \usage{ 7 | read_tempfile() 8 | } 9 | \description{ 10 | returns the project name from the temp file 11 | } 12 | -------------------------------------------------------------------------------- /man/get_os.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{get_os} 4 | \alias{get_os} 5 | \title{Internal helper function to determine OS in a consistent way.} 6 | \usage{ 7 | get_os() 8 | } 9 | \description{ 10 | Internal helper function to determine OS in a consistent way. 11 | } 12 | -------------------------------------------------------------------------------- /man/tempfile_name.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{tempfile_name} 4 | \alias{tempfile_name} 5 | \title{generates a temporary file name 6 | /tmp/HasHfolDER} 7 | \usage{ 8 | tempfile_name() 9 | } 10 | \description{ 11 | generates a temporary file name 12 | /tmp/HasHfolDER 13 | } 14 | -------------------------------------------------------------------------------- /inst/js/public/manifest.json: -------------------------------------------------------------------------------- 1 | { 2 | "short_name": "React App", 3 | "name": "Create React App Sample", 4 | "icons": [ 5 | { 6 | "src": "favicon.ico", 7 | "sizes": "64x64 32x32 24x24 16x16", 8 | "type": "image/x-icon" 9 | } 10 | ], 11 | "start_url": "./index.html", 12 | "display": "standalone", 13 | "theme_color": "#000000", 14 | "background_color": "#ffffff" 15 | } 16 | -------------------------------------------------------------------------------- /man/is_port_engated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{is_port_engated} 4 | \alias{is_port_engated} 5 | \title{Internal function to determine if port is engaed.} 6 | \usage{ 7 | is_port_engated(port = 3000) 8 | } 9 | \arguments{ 10 | \item{port}{to check.} 11 | } 12 | \description{ 13 | Internal function to determine if port is engaed. 14 | } 15 | -------------------------------------------------------------------------------- /man/gp_install_npm_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_npm_package.R 3 | \name{gp_install_npm_package} 4 | \alias{gp_install_npm_package} 5 | \title{Install an npm package locally} 6 | \usage{ 7 | gp_install_npm_package(pkg) 8 | } 9 | \arguments{ 10 | \item{pkg}{of npm package to install} 11 | } 12 | \description{ 13 | TODO: in future it could do global installation. 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat/test-data.R: -------------------------------------------------------------------------------- 1 | context("data provided") 2 | 3 | test_that("traffic exists", { 4 | # just check traffic exists 5 | expect_equal(!is.null(traffic), TRUE) 6 | # expect_equal(length(traffic), length(readLines(system.file("extdata/traffic.json", package = "geoplumber")))) 7 | }) 8 | 9 | test_that("traffic_network exists", { 10 | # just check traffic_network exists 11 | expect_equal(!is.null(traffic_network), TRUE) 12 | }) 13 | -------------------------------------------------------------------------------- /man/gp_erase.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create.R 3 | \name{gp_erase} 4 | \alias{gp_erase} 5 | \title{Remove a geoplumber project and clean associated directories} 6 | \usage{ 7 | gp_erase(dir_name = NULL) 8 | } 9 | \arguments{ 10 | \item{dir_name}{name of gp project directory (if NULL, previously-built 11 | directory will be erased)} 12 | } 13 | \description{ 14 | Remove a geoplumber project and clean associated directories 15 | } 16 | -------------------------------------------------------------------------------- /man/gp_install_node_instructions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_node_instructions.R 3 | \name{gp_install_node_instructions} 4 | \alias{gp_install_node_instructions} 5 | \title{TODO: install node for different systems} 6 | \usage{ 7 | gp_install_node_instructions() 8 | } 9 | \description{ 10 | Currently shows nodejs for deb 64bit distros only 11 | } 12 | \examples{ 13 | \dontrun{ 14 | gp_install_node_instructions() 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /man/gp_rstudio.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{gp_rstudio} 4 | \alias{gp_rstudio} 5 | \title{Wrapper function to copy template.Rproj file into working directory.} 6 | \usage{ 7 | gp_rstudio(path = ".") 8 | } 9 | \arguments{ 10 | \item{path}{project path to create .Rproj file in, defaults to ".".} 11 | } 12 | \description{ 13 | Wrapper function to copy template.Rproj file into working directory. 14 | } 15 | \examples{ 16 | \dontrun{ 17 | gp_rstudio() 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /man/gp_create.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create.R 3 | \name{gp_create} 4 | \alias{gp_create} 5 | \title{Simulate CRA without create-react-app} 6 | \usage{ 7 | gp_create(path = getwd()) 8 | } 9 | \arguments{ 10 | \item{path}{character: new/existing path of the target gp app.} 11 | } 12 | \description{ 13 | This function assembles the required npm package files to then build from. 14 | } 15 | \examples{ 16 | p = file.path(tempdir(), "gp_app") 17 | gp_create(p) 18 | gp_erase() 19 | } 20 | -------------------------------------------------------------------------------- /man/gp_npm_exists.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create.R 3 | \name{gp_npm_exists} 4 | \alias{gp_npm_exists} 5 | \title{Essential checks for certain functions of geoplumber.} 6 | \usage{ 7 | gp_npm_exists() 8 | } 9 | \value{ 10 | TRUE/FALSE 11 | } 12 | \description{ 13 | gp_build, gp_create and others rely on npm/node being present 14 | on the system and might be used in future so refactoring a helper function 15 | is good. 16 | } 17 | \examples{ 18 | { 19 | gp_npm_exists() 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | inst/doc 2 | # See https://help.github.com/ignore-files/ for more about ignoring files. 3 | 4 | # dependencies 5 | node_modules 6 | package-lock.json 7 | # testing 8 | /coverage 9 | # production 10 | /build 11 | !build.R 12 | # misc 13 | .DS_Store 14 | .env.local 15 | .env.development.local 16 | .env.test.local 17 | .env.production.local 18 | npm-debug.log* 19 | yarn-debug.log* 20 | yarn-error.log* 21 | .Rproj.user 22 | .Rhistory 23 | .RData 24 | # default app 25 | /geoplumber 26 | /my_app 27 | /my-app 28 | # special 29 | DONT_COMMIT.R 30 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(gp_add_geojson) 4 | export(gp_add_slider) 5 | export(gp_build) 6 | export(gp_change_file) 7 | export(gp_check_clip_endpoint) 8 | export(gp_create) 9 | export(gp_endpoint_from_clip) 10 | export(gp_erase) 11 | export(gp_explore) 12 | export(gp_geojson) 13 | export(gp_install_node_instructions) 14 | export(gp_install_npm_package) 15 | export(gp_is_wd_geoplumber) 16 | export(gp_kill_process) 17 | export(gp_map) 18 | export(gp_npm_exists) 19 | export(gp_plumb) 20 | export(gp_plumb_front) 21 | export(gp_remove_lines) 22 | export(gp_rstudio) 23 | export(gp_sf) 24 | -------------------------------------------------------------------------------- /geoplumber.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageBuildArgs: --no-build-vignettes 22 | PackageBuildBinaryArgs: --no-build-vignettes 23 | PackageCheckArgs: --no-build-vignettes 24 | PackageRoxygenize: rd,collate,namespace 25 | -------------------------------------------------------------------------------- /man/gp_kill_process.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{gp_kill_process} 4 | \alias{gp_kill_process} 5 | \title{Wrapper function to kill what is listening on a particular port.} 6 | \usage{ 7 | gp_kill_process(port = 3000) 8 | } 9 | \arguments{ 10 | \item{port}{targted port to kill process for defaults to \code{3000}} 11 | } 12 | \description{ 13 | Detect sysytem and run command based on OS. This function supports 14 | Linux, MacOS and Windows. There is no guarantee to kill the process. 15 | } 16 | \examples{ 17 | { 18 | gp_kill_process() 19 | } 20 | 21 | } 22 | -------------------------------------------------------------------------------- /man/gp_explore.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/explore.R 3 | \name{gp_explore} 4 | \alias{gp_explore} 5 | \title{Explore an sf R object using Turing eAtlas.} 6 | \usage{ 7 | gp_explore(sf = geoplumber::traffic, build = TRUE, run = TRUE) 8 | } 9 | \arguments{ 10 | \item{sf}{a valid sf object that can be converted to geojson} 11 | 12 | \item{build}{if \code{TRUE} build the front-end.} 13 | 14 | \item{run}{if \code{TRUE} run geoplumber} 15 | } 16 | \description{ 17 | Explore an sf R object using Turing eAtlas. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | gp_explore() 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /tests/testthat/test-map.R: -------------------------------------------------------------------------------- 1 | context("test-map") 2 | 3 | test_that("gp_map works", { 4 | url = "https://docs.mapbox.com/help/data/stations.geojson" 5 | path = file.path(tempdir(), basename(url)) 6 | result <- gp_map(x = url, browse_map = FALSE) 7 | found <- grepl(pattern = "const geojson = null;", 8 | x = result) 9 | expect_false(found) 10 | result <- gp_map(x = geoplumber::traffic, 11 | browse_map = FALSE) 12 | found <- grepl(pattern = "const geojson = null;", 13 | x = result) 14 | expect_false(found) 15 | expect_true(grepl(pattern = "traffic", result)) 16 | }) 17 | -------------------------------------------------------------------------------- /man/add_lines.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{add_lines} 4 | \alias{add_lines} 5 | \title{takes a vector of strings, adds another vector 6 | either before or after pattern provided.} 7 | \usage{ 8 | add_lines(target, pattern, what, before = TRUE) 9 | } 10 | \arguments{ 11 | \item{target}{the vector to add what to} 12 | 13 | \item{pattern}{where to add the what to} 14 | 15 | \item{what}{vector to add to target} 16 | 17 | \item{before}{or after the pattern} 18 | } 19 | \description{ 20 | takes a vector of strings, adds another vector 21 | either before or after pattern provided. 22 | } 23 | -------------------------------------------------------------------------------- /man/gp_plumb_front.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plumb_front.R 3 | \name{gp_plumb_front} 4 | \alias{gp_plumb_front} 5 | \title{Wrapper function to view front end using dev server.} 6 | \usage{ 7 | gp_plumb_front(background = TRUE) 8 | } 9 | \arguments{ 10 | \item{background}{run the command in the background, default \code{TRUE}} 11 | } 12 | \description{ 13 | Currently geoplumber only works with React, 14 | create-react-app comes with a dev server to view the front end.. 15 | This function must be called from a geoplumber app. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | gp_plumb_front() 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat/test-explore.R: -------------------------------------------------------------------------------- 1 | test_that("import added", { 2 | gp <- tolower(tempdir()) 3 | # dir.create(gp) less covr if used 4 | expect_message(gp_create(gp)) 5 | proj_dir <- read_tempfile() 6 | od <- setwd(proj_dir) 7 | # check import in ther 8 | gp_explore(run = FALSE) 9 | cont <- readLines("src/App.js") 10 | expect_true(any(grepl("Eatlas", cont))) 11 | expect_true(any(grepl("eatlas", cont))) 12 | expect_true(any(grepl(" 24 | 25 | 26 | ) 27 | } 28 | } 29 | 30 | export default App; 31 | -------------------------------------------------------------------------------- /man/gp_remove_lines.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{gp_remove_lines} 4 | \alias{gp_remove_lines} 5 | \title{Remove lines from a source file in place} 6 | \usage{ 7 | gp_remove_lines( 8 | path, 9 | pattern = " * geoplumber R package code.", 10 | lines_count = 1L 11 | ) 12 | } 13 | \arguments{ 14 | \item{path}{path of file to change, used in readLines()} 15 | 16 | \item{pattern}{remove what, 1st is used. Unique is best.} 17 | 18 | \item{lines_count}{1 by default provide a number} 19 | } 20 | \description{ 21 | Utility function to remove lines from a source file 22 | } 23 | \examples{ 24 | \dontrun{ 25 | gp_remove_lines() 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /tests/testthat/test-add-slider.R: -------------------------------------------------------------------------------- 1 | context("test-add-slider") 2 | 3 | test_that("gp_add_slider works on a geoplumber app path", { 4 | # create app at /tmp then delete 5 | # wd = /tests/testthat 6 | temp.dir <- tolower(tempdir()) 7 | # cat(temp.dir) 8 | system(paste0("mkdir ", temp.dir)) 9 | oldwd <- setwd(temp.dir) 10 | on.exit(oldwd) 11 | system("mkdir R") 12 | system(paste0("cp -R ", system.file("js", package = "geoplumber"), "/* .")) 13 | cat("\n.......\n", "Mocking a geoplumber app\n", list.files(), "\n......\n") 14 | # run tests here 15 | expect_message(gp_add_slider(), "Success.") 16 | # end tests 17 | # clean up 18 | setwd(oldwd) 19 | unlink (temp.dir, recursive = TRUE) 20 | }) 21 | -------------------------------------------------------------------------------- /man/gp_sf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sf.R 3 | \name{gp_sf} 4 | \alias{gp_sf} 5 | \title{Explore an sf R object on a leaflet map.} 6 | \usage{ 7 | gp_sf( 8 | sf = geoplumber::traffic, 9 | props_list = list(road = geoplumber::traffic$road) 10 | ) 11 | } 12 | \arguments{ 13 | \item{sf}{a valid sf object that can be converted to geojson} 14 | 15 | \item{props_list}{one named list of menuitmes to explore sf object with.} 16 | } 17 | \description{ 18 | The function (for now) takes one parameter to bounce back 19 | to the backend. For now just a dropdown list. 20 | The slider only works with circles. 21 | } 22 | \examples{ 23 | \dontrun{ 24 | gp_sf() 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /data-raw/package.json.Rmd: -------------------------------------------------------------------------------- 1 | To generate package.json and in light of discussions under [ticket #61](), documenting how package.json was generated. Also plans to replace current method of adding the deps and dev deps in package.json of a `geoplumber` app. 2 | 3 | ```{bash} 4 | # from /tmp 5 | # name is important as gp_create relies on 6 | # geoplumber being default name in package.json 7 | npx create-react-app geoplumber 8 | cat blah/package.json 9 | # add deps 10 | npm i prop-types react-bootstrap leaflet react-leaflet react-leaflet-control react-router react-router-dom 11 | 12 | # add devs 13 | npm i --save-dev enzyme enzyme-adapter-react-16 sinon react-test-renderer 14 | # copy package.json into geoplumber/inst/js 15 | ``` 16 | -------------------------------------------------------------------------------- /man/gp_is_wd_geoplumber.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is_wd_geoplumber.R 3 | \name{gp_is_wd_geoplumber} 4 | \alias{gp_is_wd_geoplumber} 5 | \title{Helper function to determin if working dir is a geoplumber app.} 6 | \usage{ 7 | gp_is_wd_geoplumber(path = ".") 8 | } 9 | \arguments{ 10 | \item{path}{check particular path} 11 | } 12 | \value{ 13 | \code{TRUE} or \code{FALSE} 14 | } 15 | \description{ 16 | Conditions for a geoplumber app (at least initiated with) 17 | \enumerate{ 18 | \item An 'R' directory with R/plumber.R file 19 | \item A 'src' directory 20 | \item A 'package.json' file at root. 21 | } 22 | } 23 | \examples{ 24 | { 25 | gp_is_wd_geoplumber() 26 | } 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/uni_point.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{uni_point} 5 | \alias{uni_point} 6 | \alias{uni_poly} 7 | \title{sf object representing the university of Leeds} 8 | \format{ 9 | An object of class \code{sf} (inherits from \code{data.frame}) with 1 rows and 5 columns. 10 | } 11 | \usage{ 12 | uni_point 13 | } 14 | \description{ 15 | From OpenStreetMap 16 | } 17 | \examples{ 18 | # library(osmdata) 19 | # osm_list <- opq("leeds") \%>\% 20 | # add_osm_feature("name", "University of Leeds") \%>\% 21 | # osmdata_sf() 22 | # uni_poly = osm_list$osm_polygons 23 | # mapview::mapview(uni_poly) 24 | # uni_point <- sf::st_centroid(osm_list$osm_polygons) 25 | } 26 | \keyword{datasets} 27 | -------------------------------------------------------------------------------- /R/install_node_instructions.R: -------------------------------------------------------------------------------- 1 | #' TODO: install node for different systems 2 | #' 3 | #' Currently shows nodejs for deb 64bit distros only 4 | #' 5 | #' @export 6 | #' @examples \dontrun{ 7 | #' gp_install_node_instructions() 8 | #' } 9 | gp_install_node_instructions <- function() { 10 | print(c( 11 | "You will need NodeJS and npm to use geoplumber.\n\n", 12 | "To install node and npm on debian 64 bit machines using apt: \n", 13 | "sudo apt-get install nodejs\n", 14 | "sudo apt-get install npm\n", 15 | "Or specific versions from NodeJS:\n", 16 | "curl -sL https://deb.nodesource.com/setup_8.x | sudo -E bash -\n", 17 | "sudo apt-get install -y nodejs\n", 18 | "More here https://nodejs.org/en/download/package-manager/\n" 19 | )) 20 | } 21 | -------------------------------------------------------------------------------- /man/gp_geojson.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geojson.R 3 | \name{gp_geojson} 4 | \alias{gp_geojson} 5 | \title{Explore a geojson object from a remote URL on a map.} 6 | \usage{ 7 | gp_geojson(geojson_url, colour_pal = "", build = TRUE) 8 | } 9 | \arguments{ 10 | \item{geojson_url}{URL or path to read geojson from} 11 | 12 | \item{colour_pal}{the value to use when colouring each feature} 13 | 14 | \item{build}{whether to build React front-end, defaults to \code{TRUE}.} 15 | } 16 | \description{ 17 | Explore a geojson object from a remote URL on a map. 18 | } 19 | \examples{ 20 | \dontrun{ 21 | gp_geojson(paste0("http://opendata.canterburymaps.govt.nz/datasets/", 22 | "fb00b553120b4f2fac49aa76bc8d82aa_26.geojson")) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /man/gp_build.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build.R 3 | \name{gp_build} 4 | \alias{gp_build} 5 | \title{Build npm packages} 6 | \usage{ 7 | gp_build(clean = FALSE) 8 | } 9 | \arguments{ 10 | \item{clean}{clean build TODO} 11 | } 12 | \description{ 13 | This function must be called to build 14 | React build for online front-end. 15 | } 16 | \details{ 17 | Runs npm run build. This creates an optimized, production and minified JS front end 18 | which is ready to be deployed anywhere. 19 | } 20 | \section{TODO}{ 21 | this function will be used less and less during development. 22 | For now geoplumber does not have a development function. Once this becomes available, 23 | the two functions will work together but do totally different tasks. 24 | } 25 | 26 | -------------------------------------------------------------------------------- /man/gp_clean.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build.R 3 | \name{gp_clean} 4 | \alias{gp_clean} 5 | \title{Function to clean the front end build for some reason.} 6 | \usage{ 7 | gp_clean(background = FALSE, rebuild = FALSE, reinstall = TRUE) 8 | } 9 | \arguments{ 10 | \item{background}{run command in the background, 11 | defaults to \code{FALSE} just to keep user aware.} 12 | 13 | \item{rebuild}{whether to rebuild the front, defaults to \code{FALSE}} 14 | 15 | \item{reinstall}{should it just clean node_modules & reinstall them, 16 | defaults to \code{TRUE}} 17 | } 18 | \description{ 19 | Three options: clean, cleand and reinstall and rebuild 20 | which cleans, reinstall and rebuilds. 21 | } 22 | \examples{ 23 | \dontrun{ 24 | gp_clean() 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /R/install_npm_package.R: -------------------------------------------------------------------------------- 1 | #' Install an npm package locally 2 | #' 3 | #' TODO: in future it could do global installation. 4 | #' 5 | #' @param pkg of npm package to install 6 | #' 7 | #' @export 8 | gp_install_npm_package <- function(pkg){ 9 | # check if working dir is a valid node package 10 | if(missing(pkg)) { 11 | stop("Please provide a package name to install") 12 | } 13 | if (length(pkg) != 1L) 14 | stop("'pkg' must be of length 1") 15 | if (is.na(pkg) || (pkg == "")) 16 | stop("invalid package name to install") 17 | if(file.exists("package.json")){ 18 | message("Installing npm pacakge '", pkg, "'") 19 | system(paste0("npm i -S ", pkg)) 20 | } else { 21 | message(paste0("Error: working directory '", getwd(), 22 | "' does not include a package.json.")) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /man/traffic_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{traffic_network} 5 | \alias{traffic_network} 6 | \title{Small sample of road network in an sf object.} 7 | \format{ 8 | An object of class \code{sf} (inherits from \code{data.frame}) with 361 rows and 1 columns. 9 | } 10 | \usage{ 11 | traffic_network 12 | } 13 | \description{ 14 | The data has been processed too much for a reproducible snippet to 15 | provide here. 16 | } 17 | \details{ 18 | It is obtained from the same \href{https://data.cdrc.ac.uk/dataset/southwark-traffic-counts}{data.cdrc.ac.uk/dataset/southwark-traffic-counts} 19 | dataset of \code{traffic} above, also using osmdata package. 20 | } 21 | \examples{ 22 | { 23 | object.size(traffic_network) 24 | } 25 | } 26 | \keyword{datasets} 27 | -------------------------------------------------------------------------------- /R/plumb_front.R: -------------------------------------------------------------------------------- 1 | #' Wrapper function to view front end using dev server. 2 | #' 3 | #' 4 | #' Currently geoplumber only works with React, 5 | #' create-react-app comes with a dev server to view the front end.. 6 | #' This function must be called from a geoplumber app. 7 | #' 8 | #' 9 | #' @param background run the command in the background, default `TRUE` 10 | #' 11 | #' @examples 12 | #' \dontrun{ 13 | #' gp_plumb_front() 14 | #' } 15 | #' @export 16 | gp_plumb_front <- function(background = TRUE) { 17 | stop_ifnot_geoplumber() 18 | 19 | message("Attempting: ", "npm start") 20 | if(is_port_engated()) { 21 | # TODO: choice of different port 22 | stop("Something is running on port 3000.") 23 | } 24 | if(background) { 25 | ps <- callr::r_bg(system, list("npm start")) 26 | return(ps) 27 | } 28 | system("npm start") 29 | # if(r) utils::browseURL("http://localhost:3000") 30 | } 31 | -------------------------------------------------------------------------------- /man/add_import_component.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{add_import_component} 4 | \alias{add_import_component} 5 | \title{takes a vector of strings, adds a Babel style import statement} 6 | \usage{ 7 | add_import_component( 8 | target, 9 | component.name, 10 | component.path, 11 | keyword = "export default", 12 | package = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{target}{vector to add import statement in.} 17 | 18 | \item{component.name}{name of component to import.} 19 | 20 | \item{component.path}{path to "import" from.} 21 | 22 | \item{keyword}{to use as anchor to add import statement.} 23 | 24 | \item{package}{is the import statement for a package? 25 | TODO: multiple or \verb{const \{\}} JS way of importing.} 26 | } 27 | \description{ 28 | takes a vector of strings, adds a Babel style import statement 29 | } 30 | -------------------------------------------------------------------------------- /tests/testthat/test-add-geojson.R: -------------------------------------------------------------------------------- 1 | context("test-gp_add_geojson") 2 | test_that("gp_add_geojson fails on no geoplumber app path", { 3 | expect_error(gp_add_geojson("/dev/null")) 4 | }) 5 | 6 | test_that("gp_add_geojson works on a geoplumber app path", { 7 | # create app at /tmp then delete 8 | # wd = /tests/testthat 9 | temp.dir <- tolower(tempdir()) 10 | # cat(temp.dir) 11 | system(paste0("mkdir ", temp.dir)) 12 | oldwd <- setwd(temp.dir) 13 | on.exit(oldwd) 14 | system(paste0("cp -R ", system.file("js", package = "geoplumber"), "/* .")) 15 | cat("\n.......\n", "Mocking a geoplumber app\n", list.files(), "\n......\n") 16 | # run tests here 17 | expect_message(gp_add_geojson(line_weight = 1), "Success. ") 18 | expect_message(gp_add_geojson(color = "color", 19 | line_weight = "lwd", 20 | properties = TRUE), "Success. ") 21 | # end tests 22 | # clean up 23 | setwd(oldwd) 24 | unlink (temp.dir, recursive = TRUE) 25 | }) 26 | -------------------------------------------------------------------------------- /man/gp_check_clip_endpoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/endpoint_from_clip.R 3 | \name{gp_check_clip_endpoint} 4 | \alias{gp_check_clip_endpoint} 5 | \title{Basic sanity check of the plumber endpiont} 6 | \usage{ 7 | gp_check_clip_endpoint(evaluate = FALSE) 8 | } 9 | \arguments{ 10 | \item{evaluate}{should clipboard function be evaulated? Default is (\code{FALSE})} 11 | } 12 | \value{ 13 | number of warnings 14 | } 15 | \description{ 16 | Use this function to check that: 17 | } 18 | \details{ 19 | \enumerate{ 20 | \item There is an endpoint "/api/test" etc. 21 | \item There is a "tag" such as @get/@post 22 | \item Defines a function with/without params 23 | \item Serves a content-type https://www.w3.org/TR/html4/types.html#h-6.7. 24 | No specific checks on the return for now just !is.null() 25 | \item TODO: content-type matches 26 | } 27 | 28 | using clipr we read from the clipboard 29 | } 30 | \examples{ 31 | \dontrun{ 32 | gp_check_clip_endpoint() 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/gp_change_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{gp_change_file} 4 | \alias{gp_change_file} 5 | \title{Change a source file in place} 6 | \usage{ 7 | gp_change_file( 8 | path = system.file("js/src/App.js", package = "geoplumber"), 9 | what = " * geoplumber R package code.", 10 | pattern = " * geoplumber R package code.", 11 | before = TRUE, 12 | replace = FALSE, 13 | verbose = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{path}{path of file to change, used in readLines()} 18 | 19 | \item{what}{vector to add to path} 20 | 21 | \item{pattern}{where to add the what to, 1st is used. Unique is best.} 22 | 23 | \item{before}{s after the pattern} 24 | 25 | \item{replace}{or replace pattern} 26 | 27 | \item{verbose}{cat the change out} 28 | } 29 | \description{ 30 | Utility function to make changes to a source file 31 | } 32 | \examples{ 33 | { 34 | gp_change_file(replace = TRUE, verbose = TRUE) # replacing the comment itself. 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /R/is_wd_geoplumber.R: -------------------------------------------------------------------------------- 1 | #' Helper function to determin if working dir is a geoplumber app. 2 | #' 3 | #' Conditions for a geoplumber app (at least initiated with) 4 | #' 1. An 'R' directory with R/plumber.R file 5 | #' 2. A 'src' directory 6 | #' 3. A 'package.json' file at root. 7 | #' 8 | #' @param path check particular path 9 | #' @return `TRUE` or `FALSE` 10 | #' 11 | #' @examples { 12 | #' gp_is_wd_geoplumber() 13 | #' } 14 | #' 15 | #' @export 16 | gp_is_wd_geoplumber <- function(path = ".") { 17 | the_path <- path 18 | dir_r <- dir.exists(file.path(the_path, "R")) 19 | dir_src <- dir.exists(file.path(the_path, "src")) 20 | package.json <- file.exists(file.path(the_path, "package.json")) 21 | 22 | if(dir_r && dir_src && package.json) { 23 | return(TRUE) 24 | } 25 | FALSE 26 | } 27 | 28 | stop_ifnot_geoplumber <- function() { 29 | if(!gp_is_wd_geoplumber()) { 30 | stop("Is working directory a geoplumber app? ", 31 | getwd(), "\nEither change directory or run gp_create() to create one.") 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /inst/js/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "geoplumber", 3 | "version": "0.1.0", 4 | "private": true, 5 | "dependencies": { 6 | "leaflet": "^1.4.0", 7 | "prop-types": "^15.6.2", 8 | "react": "^16.7.0", 9 | "react-bootstrap": "^0.32.4", 10 | "react-dom": "^16.7.0", 11 | "react-leaflet": "^2.2.0", 12 | "react-leaflet-control": "^2.1.0", 13 | "react-router": "^4.3.1", 14 | "react-router-dom": "^4.3.1", 15 | "react-scripts": "^3.0.1" 16 | }, 17 | "scripts": { 18 | "start": "react-scripts start", 19 | "build": "react-scripts build", 20 | "test": "react-scripts test", 21 | "eject": "react-scripts eject" 22 | }, 23 | "eslintConfig": { 24 | "extends": "react-app" 25 | }, 26 | "browserslist": [ 27 | ">0.2%", 28 | "not dead", 29 | "not ie <= 11", 30 | "not op_mini all" 31 | ], 32 | "devDependencies": { 33 | "enzyme": "^3.8.0", 34 | "enzyme-adapter-react-16": "^1.8.0", 35 | "react-test-renderer": "^16.7.0", 36 | "sinon": "^7.2.3" 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /inst/js/src/index.js: -------------------------------------------------------------------------------- 1 | /** 2 | * geoplumber R package code. 3 | */ 4 | import React from 'react'; 5 | import ReactDOM from 'react-dom'; 6 | import { BrowserRouter } from 'react-router-dom'; 7 | 8 | import App from './App'; 9 | // TODO: register/unregister needed? 10 | import { unregister } from './registerServiceWorker'; 11 | 12 | // *** Do NOT remove, it seems the location for icon is missing or something 13 | import L from 'leaflet'; 14 | delete L.Icon.Default.prototype._getIconUrl; 15 | 16 | L.Icon.Default.mergeOptions({ 17 | iconRetinaUrl: require('leaflet/dist/images/marker-icon-2x.png'), 18 | iconUrl: require('leaflet/dist/images/marker-icon.png'), 19 | shadowUrl: require('leaflet/dist/images/marker-shadow.png'), 20 | }); 21 | // ***end 22 | 23 | /** 24 | * Separating index.js and App.js has the benefit of 25 | * doing above like launch configs and keep App.js 26 | * clear for React application. 27 | */ 28 | ReactDOM.render( 29 | 30 | 31 | , document.getElementById('root')); 32 | 33 | unregister(); 34 | -------------------------------------------------------------------------------- /man/gp_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geojson.R 3 | \name{gp_map} 4 | \alias{gp_map} 5 | \title{Export geojson object on a map.} 6 | \usage{ 7 | gp_map( 8 | x, 9 | browse_map = TRUE, 10 | dest_path = tempdir(), 11 | height = NULL, 12 | width = NULL 13 | ) 14 | } 15 | \arguments{ 16 | \item{x}{character or sf object: URL or sf object to view on map} 17 | 18 | \item{browse_map}{logical: should the outcome be viewed in a browser? 19 | defaults to \code{TRUE}} 20 | 21 | \item{dest_path}{character: write output to \code{tempdir} (default).} 22 | 23 | \item{height}{character: css compatible option for map height.} 24 | 25 | \item{width}{character: css compatible option for map width.} 26 | } 27 | \value{ 28 | path character of path that html file was written to. 29 | } 30 | \description{ 31 | Export geojson object on a map. 32 | } 33 | \examples{ 34 | \dontrun{ 35 | gp_map(paste0("http://opendata.canterburymaps.govt.nz/datasets/", 36 | "fb00b553120b4f2fac49aa76bc8d82aa_26.geojson"), browse_map = FALSE) 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /man/traffic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{traffic} 5 | \alias{traffic} 6 | \title{Traffic data from CDRC data sets} 7 | \format{ 8 | An object of class \code{sf} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 572 rows and 11 columns. 9 | } 10 | \usage{ 11 | traffic 12 | } 13 | \description{ 14 | See \href{https://data.cdrc.ac.uk/dataset/southwark-traffic-counts}{data.cdrc.ac.uk/dataset/southwark-traffic-counts} 15 | This dataset represents point locations where traffic 16 | is measured. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | # dataset was stored as follows (from CDRC): 21 | u = paste0("https://data.cdrc.ac.uk/dataset/", 22 | "c90eee49-6f92-4508-ac36-6df56853f817/resource/", 23 | "d39d9d89-0478-4f75-a166-1a445bf42f9c/download/metadata.json") 24 | download.file(u, "inst/extdata/traffic.geojson") 25 | traffic <- sf::read_sf("inst/extdata/traffic.geojson") 26 | # sf:::plot.sf(traffic) 27 | # mapview::mapview(traffic) 28 | usethis::use_data(traffic, overwrite = TRUE) 29 | } 30 | } 31 | \keyword{datasets} 32 | -------------------------------------------------------------------------------- /inst/templates/package.json.geospatial: -------------------------------------------------------------------------------- 1 | { 2 | "name": "geoplumber", 3 | "version": "0.1.0", 4 | "private": true, 5 | "dependencies": { 6 | "create-react-app": "^1.5.2", 7 | "deck.gl": "^5.3.2", 8 | "enzyme": "^3.3.0", 9 | "enzyme-adapter-react-16": "^1.1.1", 10 | "leaflet": "^1.3.1", 11 | "leaflet.markercluster": "^1.3.0", 12 | "papaparse": "^4.5.0", 13 | "prop-types": "^15.6.1", 14 | "query-string": "^6.1.0", 15 | "react": "^16.3.2", 16 | "react-bootstrap": "^0.32.1", 17 | "react-dom": "^16.3.2", 18 | "react-leaflet": "^1.9.1", 19 | "react-leaflet-control": "^1.4.1", 20 | "react-loading": "^2.0.2", 21 | "react-router": "^4.3.1", 22 | "react-router-dom": "^4.2.2", 23 | "react-scripts": "1.1.4", 24 | "react-test-renderer": "^16.4.1", 25 | "react-virtualized": "^9.20.0", 26 | "recharts": "^1.0.1", 27 | "sinon": "^6.1.4" 28 | }, 29 | "scripts": { 30 | "start": "react-scripts start", 31 | "build": "react-scripts build", 32 | "test": "react-scripts test --env=jsdom", 33 | "eject": "react-scripts eject" 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /inst/build.missing.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 45 | 46 | 47 |
48 |
49 |

geoplumber

50 |
51 |
52 |

run: gp_build()

53 |
54 |
55 |
56 |

build missing

57 |
58 |
59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: geoplumber 2 | Title: Geospatial applications with R and frontend libraries 3 | Version: 0.1 4 | Authors@R: c( 5 | person("Layik", "Hama", email = "layik.hama@gmail.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0003-1912-4890")), 7 | person("Robin", "Lovelace", email = "rob00x@gmail.com", role = c("ctb"), 8 | comment = c(ORCID = "0000-0001-5679-6536")), 9 | person("Mark", "Padgham", role=c("ctb"), 10 | comment = c(ORCID = "0000-0003-2172-5265")), 11 | person("Thomas", "Kluth", email = "t.kluth@posteo.de", role = c("ctb")) 12 | ) 13 | Description: Utilize the power of R and ReactJS to build web applications. 14 | Depends: R (>= 3.4.0) 15 | License: GPL-3 16 | Encoding: UTF-8 17 | URL: https://atfutures.github.com/geoplumber 18 | BugReports: https://github.com/ATFutures/geoplumber/issues 19 | LazyData: true 20 | Imports: 21 | plumber, 22 | geojsonsf, 23 | callr 24 | Suggests: 25 | clipr, 26 | testthat, 27 | knitr, 28 | rmarkdown, 29 | stats19, 30 | dplyr, 31 | remotes, 32 | htmltools, 33 | devtools, 34 | RCurl 35 | RoxygenNote: 7.1.1 36 | Roxygen: list(markdown = TRUE) 37 | VignetteBuilder: knitr 38 | Language: en-GB 39 | -------------------------------------------------------------------------------- /man/gp_add_slider.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_slider.R 3 | \name{gp_add_slider} 4 | \alias{gp_add_slider} 5 | \title{Adds a basic slider with a callback function to parent.} 6 | \usage{ 7 | gp_add_slider( 8 | min = 1L, 9 | max = 10L, 10 | step = 1L, 11 | js_on_change_function = "onChange={(sliderInput) => this.setState({sliderInput})}", 12 | to_vector = "NA" 13 | ) 14 | } 15 | \arguments{ 16 | \item{min}{min to pass to the slider} 17 | 18 | \item{max}{max to pass to the slider} 19 | 20 | \item{step}{step changes for min & max} 21 | 22 | \item{js_on_change_function}{the function to run on React parent (Welcome). By default, 23 | \verb{onChange=\{(sliderInput) => this.setState(\{sliderInput\})\}} sets the state of parent 24 | with value returned from the html input's onChange function.} 25 | 26 | \item{to_vector}{instead of reading default Welcome.js} 27 | } 28 | \description{ 29 | At this moment, there is no strategy to manage parent <> child 30 | interaction between what is main component (Welcome) and 31 | children. React does have strong tools for this but geoplumber 32 | is still young. 33 | } 34 | \examples{ 35 | \dontrun{ 36 | gp_add_slider() 37 | } 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/traffic_casualties_2014.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{traffic_casualties_2014} 5 | \alias{traffic_casualties_2014} 6 | \title{Road traffic casualties} 7 | \format{ 8 | An object of class \code{sf} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 1652 rows and 3 columns. 9 | } 10 | \usage{ 11 | traffic_casualties_2014 12 | } 13 | \description{ 14 | From OpenStreetMap 15 | } 16 | \examples{ 17 | \dontrun{ 18 | stplanr::dl_stats19() 19 | ac = stplanr::read_stats19_ac() # 214 mb compressed data 20 | ac = ac[!is.na(ac$Latitude), ] 21 | ac_few_cols = ac[ c("Accident_Severity", "Longitude", "Latitude", "Date")] 22 | ac_sf = sf::st_as_sf(ac_few_cols, coords = c("Longitude", "Latitude")) 23 | sf::st_crs(ac_sf) = 4326 24 | bb = stplanr::bb2poly(bb = sf::as_Spatial(traffic)) 25 | bb_sf = sf::st_as_sf(bb) 26 | traffic_casualties = ac_sf[bb_sf, ] 27 | pryr::object_size(traffic_casualties) # 2 MB 28 | traffic_casualties_2014 = traffic_casualties[ 29 | traffic_casualties$Date > "2014-01-01", 30 | ] 31 | pryr::object_size(traffic_casualties_2014) # 200 kB 32 | usethis::use_data(traffic_casualties_2014) 33 | } 34 | plot(traffic_casualties_2014$Date, traffic_casualties_2014$Accident_Severity) 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | language: r 3 | warnings_are_errors: true 4 | sudo: required 5 | cache: packages 6 | 7 | r_github_packages: 8 | - jimhester/covr 9 | r_check_args: --no-build-vignettes 10 | 11 | addons: 12 | apt: 13 | packages: 14 | - libudunits2-dev # paper.Rmd see travis builds/508333361#L1622 15 | - libgdal-dev 16 | - libgeos-dev 17 | - libssl-dev 18 | - xclip 19 | - libsodium-dev 20 | - libharfbuzz-dev 21 | - libfribidi-dev 22 | 23 | # copy from 24 | # https://github.com/mdlincoln/clipr/blob/master/.travis.yml 25 | env: TRAVIS_CLIP=xclip DISPLAY=:99.0 CLIPR_ALLOW=TRUE 26 | # see https://github.com/mdlincoln/clipr/issues/21 27 | # Ensure xclip can still run headlessly 28 | services: 29 | - xvfb 30 | before_script: 31 | - if [ "$TRAVIS_CLIP" == "xclip" ]; then uptime | xclip -i -sel p -f | xclip -i -sel c; xclip -o -sel clipboard; fi 32 | 33 | before_install: 34 | - nvm install 12.18.3 35 | - npm i -g create-react-app 36 | - Rscript -e 'install.packages("ragg")' 37 | - Rscript -e 'install.packages("pkgdown")' 38 | 39 | after_success: 40 | - Rscript -e "covr::codecov()" 41 | 42 | deploy: 43 | provider: script 44 | script: Rscript -e 'pkgdown::deploy_site_github()' 45 | skip_cleanup: true 46 | -------------------------------------------------------------------------------- /tests/testthat/test-geojson.R: -------------------------------------------------------------------------------- 1 | context("test-geojson") 2 | 3 | test_that("geojson fails on missing path", { 4 | expect_error(gp_geojson()) 5 | }) 6 | 7 | test_that("geojson fails on no geoplumber app path", { 8 | expect_error(gp_geojson("/dev/null")) 9 | }) 10 | 11 | test_that("geojson works on a geoplumber app path", { 12 | # wd = /tests/testthat 13 | temp.dir <- file.path(tempdir(), "foo") 14 | dir.create(temp.dir, recursive = TRUE) 15 | oldwd <- setwd(temp.dir) 16 | on.exit(oldwd) 17 | cat("\n.......\n", "Mocking a geoplumber app\n", list.files(), "\n......\n") 18 | gp_create() 19 | expect_true(gp_is_wd_geoplumber()) 20 | Sys.setenv(DO_NOT_PLUMB = 'false') 21 | # run tests 22 | geojson_url = paste0("http://opendata.canterburymaps.govt.nz/datasets/", 23 | "fb00b553120b4f2fac49aa76bc8d82aa_26.geojson") 24 | expect_equal(gp_geojson(geojson_url = geojson_url, colour_pal = "mock"), 25 | TRUE) 26 | # we should now have a 'style={(feature) => ({fillColor:feature.properties.' 27 | # section in the Welcome.js 28 | expect_true(any(grepl("fillColor:feature.properties.", 29 | readLines(file.path( 30 | temp.dir, "src/Welcome.js" 31 | ))))) 32 | Sys.unsetenv("DO_NOT_PLUMB") 33 | setwd(oldwd) 34 | unlink (temp.dir, recursive = TRUE) 35 | }) 36 | -------------------------------------------------------------------------------- /man/gp_add_geojson.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_geojson.R 3 | \name{gp_add_geojson} 4 | \alias{gp_add_geojson} 5 | \title{For now, views a geojson served from an endpoint on leafletjs.} 6 | \usage{ 7 | gp_add_geojson( 8 | endpoint = "/api/data", 9 | color = "#3388ff", 10 | line_weight = NA, 11 | properties = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{endpoint}{where to fetch the geojson from} 16 | 17 | \item{color}{for now color value for all geojson} 18 | 19 | \item{line_weight}{worded carefully for leaflet geojson lineweight.} 20 | 21 | \item{properties}{logical, by default \code{FALSE}. If TRUE \code{color} and \code{line_weight} will 22 | be obtained from properties/columns from corresponding data served via \code{endpoint}} 23 | } 24 | \description{ 25 | Assumes there is a valid geoplumber app at wd 26 | TODO: work with valid paths too 27 | TODO: either here, or separate function, add my own component. 28 | \enumerate{ 29 | \item Add a component with ability to fetch geojson from an endpoint to /components 30 | \item Import it into the App.js (TODO: into any other component) 31 | Errors: stop execution if either React 'src' folder or for now "Welcome.js" component 32 | does not exist. This is because for now we are adding the ready to use GeoJSONComponent component 33 | into src/Welcome.js 34 | } 35 | } 36 | \examples{ 37 | \dontrun{ 38 | if(gp_is_wd_geoplumber()) { 39 | gp_add_geojson() 40 | } 41 | } 42 | 43 | } 44 | -------------------------------------------------------------------------------- /man/traffic_volumes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{traffic_volumes} 5 | \alias{traffic_volumes} 6 | \title{Traffic data from CDRC data sets} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 1522 rows and 20 columns. 9 | } 10 | \usage{ 11 | traffic_volumes 12 | } 13 | \description{ 14 | See \href{https://data.cdrc.ac.uk/dataset/southwark-traffic-counts}{data.cdrc.ac.uk/dataset/southwark-traffic-counts} 15 | This dataset represents travel levels at the point locations stored in 16 | \code{traffic} 17 | } 18 | \examples{ 19 | \dontrun{ 20 | f = "/tmp/2010-2016-allaveragedailytrafficflowcdrcmapreducedfile.xlsx" 21 | traffic_volumes = readxl::read_excel(f) 22 | summary(traffic_volumes$ID \%in\% traffic$cp) 23 | pryr::object_size(traffic_volumes) 24 | usethis::use_data(traffic_volumes) 25 | library(dplyr) 26 | traffic_agg = traffic_volumes \%>\% 27 | group_by(cp = ID) \%>\% 28 | summarise( 29 | total = sum(`TOTAL FLOW`), 30 | cycle_or_motorcycle = sum(`ARX PEDAL-MOTORCYCLE`), 31 | av_speed = mean(AVERAGE_SPEED), 32 | year = mean(YEAR) 33 | ) 34 | if(ncol(traffic) < 8) { 35 | traffic = left_join(traffic, traffic_agg) 36 | usethis::use_data(traffic, overwrite = TRUE) 37 | } 38 | mapview::mapview(traffic, zcol = "total") 39 | sf:::plot.sf(traffic) 40 | } 41 | summary(traffic_volumes) 42 | plot(traffic$total, traffic$cycle_or_motorcycle) 43 | } 44 | \keyword{datasets} 45 | -------------------------------------------------------------------------------- /inst/js/src/components/RBSlider.jsx: -------------------------------------------------------------------------------- 1 | 'use-strict' 2 | 3 | import React, { Component } from 'react'; 4 | import Control from 'react-leaflet-control'; 5 | 6 | export default class RBSlider extends Component { 7 | constructor(props) { 8 | super(props); 9 | this.state = { 10 | value: null 11 | } 12 | } 13 | 14 | _handleChange(event) { 15 | if (typeof (this.props.onChange) === 'function') { 16 | this.props.onChange(event.target.value) 17 | } 18 | this.setState({ value: event.target.value }) 19 | } 20 | 21 | render() { 22 | let { min, max, step } = this.props; 23 | min = min || 1 24 | max = max || 10 25 | step = step || 1 26 | const { value } = this.state; 27 | return ( 28 | 31 |
32 | 41 |

{value ? value : min}

42 |
43 |
44 | ) 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /man/gp_endpoint_from_clip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/endpoint_from_clip.R 3 | \name{gp_endpoint_from_clip} 4 | \alias{gp_endpoint_from_clip} 5 | \title{Adds an endpoint function to the plumber.R from clipboard.} 6 | \usage{ 7 | gp_endpoint_from_clip(evaluate = FALSE) 8 | } 9 | \arguments{ 10 | \item{evaluate}{extra check on clipboard content} 11 | } 12 | \value{ 13 | None 14 | } 15 | \description{ 16 | To use this function, write the endpoint somewhere and then copy it into clipboard. 17 | Then call this function. 18 | This function uses \code{clipr} to write it to the 'plumber.R' file. 19 | For now only file will be plumber.R 20 | } 21 | \details{ 22 | TODO: 23 | add silent param, write to other .R files. 24 | } 25 | \examples{ 26 | \dontrun{ 27 | # Following is a valid endpoint to serve geoplumber::traffic dataset: 28 | # = begin ===> 29 | # Serve geoplumber::traffic from /api/data 30 | 31 | # @get /api/data 32 | # get_traffic <- function(res) { 33 | # geojson <- geojsonio::geojson_json(geoplumber::traffic) 34 | # res$body <- geojson 35 | # res 36 | # } 37 | # <==== end = 38 | # holindg current clipboard 39 | old_clip <- clipr::read_clip() 40 | # adding above to clipboard 41 | clipr::write_clip(c( 42 | "#' Serve geoplumber::traffic from /api/data", 43 | "@get /api/data", 44 | "get_traffic <- function(res) {", 45 | "geojson <- geojsonio::geojson_json(geoplumber::traffic)", 46 | "res$body <- geojson", 47 | "res", 48 | "}" 49 | )) 50 | # clipr::read_clip() 51 | gp_endpoint_from_clip() 52 | clipr::write_clip(old_clip) 53 | } 54 | 55 | } 56 | -------------------------------------------------------------------------------- /man/gp_plumb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plumb.R 3 | \name{gp_plumb} 4 | \alias{gp_plumb} 5 | \title{Launch a webserver via plumber to serve data} 6 | \usage{ 7 | gp_plumb( 8 | run = TRUE, 9 | port = 8000, 10 | file = "R/plumber.R", 11 | front = FALSE, 12 | host = "127.0.0.1", 13 | background = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{run}{should plumber run the server or return it as an object} 18 | 19 | \item{port}{to serve from} 20 | 21 | \item{file}{location of plumber.R file used by plumber} 22 | 23 | \item{front}{should geoplumber start the front dev server? Defaults} 24 | 25 | \item{host}{host to pass to plumber default \verb{http://127.0.0.1} 26 | to \code{FALSE}.} 27 | 28 | \item{background}{run the R process in the background using callr, 29 | defaults to \code{TRUE}.} 30 | } 31 | \value{ 32 | an instance of plumber::plumb if \code{run} is set to \code{FALSE}, 33 | a process id from \code{callr::r_bg} to easily destroy if parameter 34 | \code{background} is default \code{TRUE}. 35 | } 36 | \description{ 37 | Launch a webserver via plumber to serve data 38 | } 39 | \examples{ 40 | { 41 | d <- file.path(tempdir(), "gp") 42 | gp_create(d) 43 | old <- setwd(d) 44 | ps <- gp_plumb() 45 | ps 46 | Sys.sleep(1) # just in case 47 | ps 48 | require(RCurl) 49 | webpage <- getURL("http://localhost:8000") 50 | webpage <- readLines(tc <- textConnection(webpage)); close(tc) 51 | tail(webpage) 52 | ps$kill() 53 | setwd(old) 54 | unlink(d, recursive = TRUE) 55 | } 56 | } 57 | \seealso{ 58 | \code{\link[=gp_plumb_front]{gp_plumb_front()}} 59 | } 60 | -------------------------------------------------------------------------------- /inst/js/src/components/Header.jsx: -------------------------------------------------------------------------------- 1 | /** 2 | * geoplumber R package code. 3 | */ 4 | import React from 'react'; 5 | import { Navbar, Nav, NavItem } from 'react-bootstrap'; 6 | import { Link, withRouter } from 'react-router-dom'; 7 | 8 | const navs = [ 9 | { 10 | key: 1, 11 | to: "test", 12 | title: "Test" 13 | }, 14 | { 15 | key: 2, 16 | to: "about", 17 | title: "About" 18 | }, 19 | ]; 20 | 21 | class Header extends React.Component { 22 | 23 | render () { 24 | return ( 25 | 26 | 27 | 28 | geoplumber 29 | 30 | 31 | 32 | 33 | 47 | 48 | 49 | ) 50 | } 51 | } 52 | 53 | // thanks to https://stackoverflow.com/a/42124328/2332101 54 | export default withRouter(Header); 55 | -------------------------------------------------------------------------------- /inst/js/src/Welcome.js: -------------------------------------------------------------------------------- 1 | /** 2 | * ATFutures, LIDA/ITS, University of Leeds 3 | * Entry component for ATT 4 | */ 5 | import React, { Component } from 'react'; 6 | import { Map, TileLayer } from 'react-leaflet'; 7 | import Control from 'react-leaflet-control'; 8 | 9 | import GeoJSONComponent from './components/GeoJSONComponent.jsx'; 10 | 11 | import './App.css'; 12 | 13 | export default class Welcome extends Component { 14 | constructor(props) { 15 | super(props); 16 | this.state = { 17 | sfParam: null, 18 | map: null 19 | } 20 | } 21 | 22 | componentDidMount() { 23 | const map = this.refs.map.leafletElement 24 | this.setState({ map }) 25 | } 26 | 27 | render() { 28 | return ( 29 | { 35 | this.setState({ touchReceived: true }) 36 | }} 37 | > 38 | 40 | {this.state.label} 41 | 42 | 46 | 47 | {/* #ADD_COMPONENT */} 48 | 49 | ); 50 | } 51 | } 52 | 53 | -------------------------------------------------------------------------------- /tests/testthat/test-add-endpoints.R: -------------------------------------------------------------------------------- 1 | context("test-gp_endpoint_from_clip") 2 | 3 | if(clipr::clipr_available()) { 4 | test_that("gp_endpoint_from_clip fails on empty clip", { 5 | clip <- clipr::read_clip() 6 | clipr::clear_clip() 7 | expect_error(gp_endpoint_from_clip()) 8 | clipr::write_clip(clip) 9 | }) 10 | } 11 | 12 | if(clipr::clipr_available()) { 13 | test_that("gp_endpoint_from_clip fails no R/plumber.R", { 14 | clip <- clipr::read_clip() 15 | clipr::write_clip("some valid function") 16 | expect_error(gp_endpoint_from_clip()) 17 | clipr::write_clip(clip) 18 | }) 19 | } 20 | 21 | if(clipr::clipr_available()) { 22 | test_that("gp_endpoint_from_clip stops endless loop", { 23 | clip <- clipr::read_clip() 24 | clipr::write_clip("gp_endpoint_from_clip") 25 | expect_error(gp_endpoint_from_clip()) 26 | clipr::write_clip(clip) 27 | }) 28 | } 29 | 30 | test_that("gp_endpoint_from_clip works", { 31 | temp.dir <- tolower(tempdir()) 32 | system(paste0("mkdir -p ", temp.dir, "/R")) # no harm in -p 33 | system(paste0("cd ", temp.dir)) 34 | old_wd <- setwd(temp.dir) 35 | system(paste0("cp ", system.file("plumber.R", package = "geoplumber"), " R")) 36 | endpoint <- c( 37 | "#' comment for a new endpoint", 38 | "#' @get /api/test", 39 | "function(){", 40 | " cat('test')", 41 | "}" 42 | ) 43 | m <- "Success.\nPlease restart your server: gp_plumb()" 44 | if(clipr::clipr_available()) { 45 | old_clip <- clipr::read_clip() 46 | clipr::write_clip(endpoint, breaks = "\n") 47 | 48 | expect_message(gp_endpoint_from_clip(), m) 49 | expect_error(gp_endpoint_from_clip(evaluate = TRUE), NA) 50 | clipr::write_clip(old_clip) 51 | } 52 | # reset 53 | setwd(old_wd) 54 | unlink (temp.dir, recursive = TRUE) 55 | }) 56 | -------------------------------------------------------------------------------- /inst/plumber.R: -------------------------------------------------------------------------------- 1 | #' plumber 0.4.6 2 | 3 | # Enable CORS ------------------------------------------------------------- 4 | #' CORS enabled for now. See docs of plumber 5 | #' for disabling it for any endpoint we want in future 6 | #' https://www.rplumber.io/docs/security.html#cross-origin-resource-sharing-cors 7 | #' @filter cors 8 | cors <- function(res) { 9 | res$setHeader("Access-Control-Allow-Origin", "*") 10 | plumber::forward() 11 | } 12 | # TODO: option to remove above CORS 13 | 14 | #' 15 | #' @param msg The message to echo 16 | #' @get /api/helloworld 17 | #' @get /api/helloworld/ 18 | function(msg="nothing given"){ 19 | list(msg = paste0("The message is: '", msg, "'")) 20 | } 21 | 22 | #' @section TODO: 23 | #' The plugger endpoint should not be there. Currently mapping React build to / 24 | #' at assets causes the swagger endpoint to be 404. Support is limited. 25 | #' 26 | #' @get /__swagger__/ 27 | swagger <- function(req, res){ 28 | fname <- system.file("swagger-ui/index.html", package = "plumber") # serve the swagger page. 29 | plumber::include_html(fname, res) 30 | } 31 | 32 | # Below is part of Welcome endpoint: 33 | library(geoplumber) 34 | uol <- rbind(uni_point, uni_poly) 35 | uol <- geojsonsf::sf_geojson(uol, factors_as_string=FALSE) 36 | #' Welcome endpoint. Feel free to remove, relevant line in Welcome.js (line 41) 37 | #' @get /api/uol 38 | uol_geojson <- function(res, grow){ 39 | if(!missing(grow) && !is.na(as.numeric(grow))) { 40 | # add a buffer around poly for now 41 | # TODO: further checks for value validity. 42 | poly <- sf::st_buffer(uni_poly, as.numeric(grow)) 43 | poly <- geojsonsf::sf_geojson(poly) 44 | res$body <- poly # geojson 45 | return (res) 46 | } 47 | res$body <- uol 48 | res 49 | } 50 | 51 | #' Tell plumber where our public facing directory is to SERVE. 52 | #' No need to map / to the build or public index.html. This will do. 53 | #' plumber1.0 working directory is current file's parent. 54 | #' 55 | #' @assets ../build / 56 | list() 57 | -------------------------------------------------------------------------------- /inst/js/public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 11 | 12 | 13 | 14 | 17 | 20 | 29 | geoplumber 30 | 31 | 32 | 35 |
36 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /R/add_slider.R: -------------------------------------------------------------------------------- 1 | #' Adds a basic slider with a callback function to parent. 2 | #' 3 | #' At this moment, there is no strategy to manage parent <> child 4 | #' interaction between what is main component (Welcome) and 5 | #' children. React does have strong tools for this but geoplumber 6 | #' is still young. 7 | #' 8 | #' @param js_on_change_function the function to run on React parent (Welcome). By default, 9 | #' `onChange={(sliderInput) => this.setState({sliderInput})}` sets the state of parent 10 | #' with value returned from the html input's onChange function. 11 | #' @param min min to pass to the slider 12 | #' @param max max to pass to the slider 13 | #' @param step step changes for min & max 14 | #' @param to_vector instead of reading default Welcome.js 15 | #' 16 | #' @export 17 | #' @examples \dontrun{ 18 | #' gp_add_slider() 19 | #' } 20 | #' 21 | gp_add_slider <- function( 22 | min = 1L, 23 | max = 10L, 24 | step = 1L, 25 | js_on_change_function = "onChange={(sliderInput) => this.setState({sliderInput})}", 26 | to_vector = "NA"){ 27 | stop_ifnot_geoplumber() 28 | # Read the template 29 | component.name <- "RBSlider" 30 | component.path <- paste0("components/", component.name, ".jsx") 31 | # Add component to geoplumber Welcome.js 32 | target <- to_vector # dont read then check, check then read. 33 | if("NA" == target) 34 | target <- readLines("src/Welcome.js") 35 | # read target compoennt, if not, stop 36 | if(length(target) < 10) { # TODO: much better check than this 37 | stop("geoplumber could not insert component into target component.") 38 | } 39 | # import component 40 | target <- add_import_component(target, component.name, component.path) 41 | 42 | # find end map component tag 43 | map.end.index <- grep(pattern = "", x = target) 44 | # TODO: more checks as file could be corrupt 45 | # insert line 46 | spaces <- next_spaces(target[map.end.index]) 47 | target <- c(target[1:map.end.index - 1], 48 | paste0(spaces, "<", component.name), 49 | paste0(spaces, "min={", min, "} max={", max, "}", " step={", step, "}"), 50 | paste0(spaces, js_on_change_function, " />"), 51 | target[map.end.index:length(target)] 52 | ) 53 | # now write to project 54 | if("NA" == to_vector){ 55 | write(target, "src/Welcome.js") 56 | } else { 57 | return(target) 58 | } 59 | message("Remember to rebuild frontend: gp_build()") 60 | message("Success.") 61 | } 62 | -------------------------------------------------------------------------------- /inst/js/src/logo.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /R/plumb.R: -------------------------------------------------------------------------------- 1 | #' Launch a webserver via plumber to serve data 2 | #' 3 | #' @param port to serve from 4 | #' @param file location of plumber.R file used by plumber 5 | #' @param run should plumber run the server or return it as an object 6 | #' @param front should geoplumber start the front dev server? Defaults 7 | #' @param host host to pass to plumber default `http://127.0.0.1` 8 | #' to `FALSE`. 9 | #' @param background run the R process in the background using callr, 10 | #' defaults to `TRUE`. 11 | #' 12 | #' @seealso [gp_plumb_front()] 13 | #' 14 | #' @return an instance of plumber::plumb if `run` is set to `FALSE`, 15 | #' a process id from `callr::r_bg` to easily destroy if parameter 16 | #' `background` is default `TRUE`. 17 | #' 18 | #' @export 19 | #' @examples { 20 | #' d <- file.path(tempdir(), "gp") 21 | #' gp_create(d) 22 | #' old <- setwd(d) 23 | #' ps <- gp_plumb() 24 | #' ps 25 | #' Sys.sleep(1) # just in case 26 | #' ps 27 | #' require(RCurl) 28 | #' webpage <- getURL("http://localhost:8000") 29 | #' webpage <- readLines(tc <- textConnection(webpage)); close(tc) 30 | #' tail(webpage) 31 | #' ps$kill() 32 | #' setwd(old) 33 | #' unlink(d, recursive = TRUE) 34 | #' } 35 | gp_plumb <- function(run = TRUE, 36 | port = 8000, 37 | file = "R/plumber.R", 38 | front = FALSE, 39 | host = "127.0.0.1", 40 | background = TRUE) { 41 | stop_ifnot_geoplumber() 42 | 43 | # todo: when initiating project copy plumber.R file to somewhere sensible 44 | # e.g. in newly created plumber/ directory (the code should also create this) 45 | # todo: create @parm new_session which serves from a new R session by default 46 | # (checkout out future pkg for this) 47 | 48 | server <- plumber::plumb(file = file) 49 | #plumber works without a frontend 50 | if(!dir.exists("build")){ 51 | message("WARNING:\n", 52 | "Looks like geoplumber was not built, serveing API only.\n", 53 | "To serve the front end run gp_build() first.") 54 | server$handle("GET", "/", function(res){ 55 | fname <- system.file("build.missing.html", package = "geoplumber") 56 | plumber::include_html(fname, res) 57 | }) 58 | } 59 | # run front 60 | # TODO: specify front port 61 | if(front) { 62 | gp_plumb_front() 63 | } 64 | # run plumb 65 | if(run) { 66 | openURL(host, port) 67 | if(background) { 68 | f <- function(s, p, h) {s$setDocs(FALSE); s$run(port = p, host = h)} 69 | ps <- callr::r_bg(f, list(s = server, p = port, h = host)) 70 | return(ps) 71 | } 72 | server$run(port = port, host = host) 73 | } else { 74 | return(server) 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /R/explore.R: -------------------------------------------------------------------------------- 1 | #' Explore an sf R object using Turing eAtlas. 2 | #' 3 | #' 4 | #' @param sf a valid sf object that can be converted to geojson 5 | #' @param build if `TRUE` build the front-end. 6 | #' @param run if `TRUE` run geoplumber 7 | #' 8 | #' @examples \dontrun{ 9 | #' gp_explore() 10 | #' } 11 | #' @export 12 | gp_explore <- function(sf = geoplumber::traffic, 13 | build = TRUE, 14 | run = TRUE) { 15 | # gp_plumb checks project availability 16 | server <- gp_plumb(run = FALSE) 17 | # convert sf to geojson 18 | # TODO stop if not valid sf or geojsonsf cannot deal with it. 19 | # TODO try catch? 20 | geojson <- geojsonsf::sf_geojson(sf, factors_as_string=FALSE) 21 | 22 | # prepare back-end 23 | # add endpoint to object not to file 24 | endpoint <- "/api/explore" 25 | # variable name here "road" must be used in the React component. 26 | # flexible variable names 27 | server$handle("GET", endpoint, function(res, req, ...){ 28 | qs <- c(...) # named vector 29 | res$headers$`Content-type` <- "application/json" 30 | res$body <- geojson 31 | res 32 | }) 33 | server$handle("GET", "/explore", function(req, res){ 34 | # plumber 1.0 breaking change 35 | # wd is plumber.R from geoplumber::gp_plumb 36 | fname <- file.path("..", "build", "index.html") 37 | plumber::include_html(fname, res) 38 | }) 39 | # prepare frontend 40 | # must be done on clean Welcome.js 41 | # 1. import eAtlas/kepler 42 | # 2. install it 43 | # 3. add to file 44 | parent <- readLines(system.file(paste0("js/src/App.js"), package = "geoplumber")) 45 | # import first 46 | # TODO: cannot use such magical strings in code. 47 | component.name <- "Eatlas" 48 | parent <- add_import_component(parent, 49 | component.name, 50 | tolower(component.name), 51 | keyword="class App", 52 | package = TRUE) 53 | # add component 54 | parent <- add_lines( 55 | parent, # target 56 | " 61 | paste0('() => '), 62 | '}/>' 63 | ) 64 | ) 65 | # finally write before building 66 | write(parent, "src/App.js") 67 | # build & serve 68 | if(run) { 69 | if(build) { 70 | # TODO: if already installed skip 71 | gp_install_npm_package(tolower(component.name)) 72 | # TODO: gp_build is not made for this or refactor it. 73 | gp_build() 74 | } 75 | # TODO: is it free? 76 | # is_port_engated(port = 8000) 77 | # attempt starting backend in any case 78 | message("Serving data at ", "http://localhost:8000/api/explore") 79 | f <- function(s, p) {s$setDocs(FALSE);s$run(port = p)} 80 | ps <- callr::r_bg(f, list(s = server, p = 8000)) 81 | openURL(path = "explore") 82 | return(ps) 83 | } 84 | } 85 | 86 | 87 | -------------------------------------------------------------------------------- /R/build.R: -------------------------------------------------------------------------------- 1 | #' Build npm packages 2 | #' 3 | #' This function must be called to build 4 | #' React build for online front-end. 5 | #' 6 | #' Runs npm run build. This creates an optimized, production and minified JS front end 7 | #' which is ready to be deployed anywhere. 8 | #' 9 | #' @section TODO: this function will be used less and less during development. 10 | #' For now geoplumber does not have a development function. Once this becomes available, 11 | #' the two functions will work together but do totally different tasks. 12 | #' 13 | #' @param clean clean build TODO 14 | #' 15 | #' @export 16 | gp_build <- function(clean = FALSE) { 17 | if (!gp_npm_exists()) { 18 | msg <- paste0 ("geoplumber failed to identify a version of node ", 19 | "on this system:\n", Sys.info()["sysname"], "\n", 20 | gp_install_node_instructions()) 21 | stop (msg) 22 | } 23 | 24 | if (!(file.exists ("package.json") | file.exists (tempfile_name ()))) 25 | stop("geoplumber failed to identify a package.json in working directory:\n", 26 | getwd(), "\nEither change to directory of previously-created ", 27 | "geoplumger app,\nor run gp_create() to create one.") 28 | 29 | wd <- getwd() 30 | if(!gp_is_wd_geoplumber()) { 31 | # try finding the newly created geoplumber app directory 32 | wd <- change_to_proj_dir () 33 | } 34 | 35 | # TODO: do more checks before actually running the command 36 | second.build <- 1L 37 | first.build <- try({ 38 | message("Running: ", "npm run build") 39 | result <- system("npm run build", ignore.stderr = TRUE) 40 | result 41 | }) 42 | if(first.build != 0) { 43 | # run gp_build() 44 | message("Looks like first run, installing npm packages...") 45 | message("Running: ", "gp_npm_install()") 46 | system("npm install") 47 | # back on to build 48 | message("Now trying to build: ", "npm run build") 49 | second.build <- system("npm run build") # we wont filter ignore.stdout or ignore.stderr 50 | } 51 | # in both cases. 52 | if(second.build == 0) 53 | message("Standard output from create-react-app above works.\n", 54 | "To run the geoplumber app: gp_plumb()\n") 55 | setwd (wd) 56 | } 57 | 58 | #' Function to clean the front end build for some reason. 59 | #' 60 | #' Three options: clean, cleand and reinstall and rebuild 61 | #' which cleans, reinstall and rebuilds. 62 | #' 63 | #' @param background run command in the background, 64 | #' defaults to `FALSE` just to keep user aware. 65 | #' @param rebuild whether to rebuild the front, defaults to `FALSE` 66 | #' @param reinstall should it just clean node_modules & reinstall them, 67 | #' defaults to `TRUE` 68 | #' 69 | #' @examples 70 | #' \dontrun{ 71 | #' gp_clean() 72 | #' } 73 | gp_clean <- function(background = FALSE, 74 | rebuild = FALSE, reinstall = TRUE) { 75 | stop_ifnot_geoplumber() 76 | message("clear install and buil...") 77 | command <- "rm -rf node_modules" 78 | if(reinstall) 79 | command <- "npm run clean && npm install" 80 | if(rebuild) 81 | command <- "npm run clean && npm install && npm run build" 82 | if(background) 83 | command <- paste0(command, " &") 84 | message("Running: ", command) 85 | system(command = command) 86 | } 87 | -------------------------------------------------------------------------------- /inst/js/src/utils.js: -------------------------------------------------------------------------------- 1 | /* 2 | Utility Functions 3 | 4 | thanks https://github.com/realm/github-gantt/blob/master/utilities.js 5 | 6 | */ 7 | var isString = function(x) { 8 | return x !== null && x !== undefined && x.constructor === String 9 | } 10 | 11 | var isNumber = function(x) { 12 | return x !== null && x !== undefined && x.constructor === Number 13 | } 14 | 15 | var isBoolean = function(x) { 16 | return x !== null && x !== undefined && x.constructor === Boolean 17 | } 18 | 19 | var isObject = function(x) { 20 | return x !== null && x !== undefined && x.constructor === Object 21 | } 22 | 23 | var isArray = function(x) { 24 | return x !== null && x !== undefined && x.constructor === Array 25 | } 26 | 27 | var isDate = function(d) { 28 | if ( Object.prototype.toString.call(d) === "[object Date]" ) { 29 | if ( isNaN( d.getTime() ) ) { 30 | return false; 31 | } 32 | else { 33 | return true; 34 | } 35 | } 36 | else { 37 | return false; 38 | } 39 | } 40 | 41 | var isRealmObject = function(x) { 42 | return x !== null && x !== undefined && x.constructor === Realm.Object 43 | } 44 | 45 | var isRealmList = function(x) { 46 | return x !== null && x !== undefined && x.constructor === Realm.List 47 | } 48 | 49 | var sanitizeFloat = function(number) { 50 | if (isNumber(number)) { 51 | return number; 52 | } 53 | else if (isString(number)) { 54 | let n = parseFloat(number); 55 | if (isNaN(n)) { 56 | return null; 57 | } 58 | else { 59 | return n; 60 | } 61 | } 62 | else { 63 | return null; 64 | } 65 | } 66 | 67 | var sanitizeInt = function(number) { 68 | if (isNumber(number)) { 69 | return number; 70 | } 71 | else if (isString(number)) { 72 | return parseInt(number); 73 | } 74 | else { 75 | return null; 76 | } 77 | } 78 | 79 | var sanitizeString = function(string) { 80 | if (isString(string)) { 81 | return string; 82 | } 83 | else if (isNumber(string)) { 84 | return string.toString(); 85 | } 86 | else { 87 | return null; 88 | } 89 | } 90 | 91 | var sanitizeStringNonNull = function(string) { 92 | if (isString(string)) { 93 | return string; 94 | } 95 | else if (isNumber(string)) { 96 | return string.toString(); 97 | } 98 | else { 99 | return ""; 100 | } 101 | } 102 | 103 | var sanitizeBool = function(bool) { 104 | if (isBoolean(bool)) { 105 | return bool; 106 | } 107 | else if (isNumber(bool)) { 108 | return Boolean(bool); 109 | } 110 | else { 111 | return null; 112 | } 113 | } 114 | 115 | exports.isString = isString; 116 | exports.isNumber = isNumber; 117 | exports.isBoolean = isBoolean; 118 | exports.isObject = isObject; 119 | exports.isArray = isArray; 120 | exports.isDate = isDate; 121 | exports.isRealmObject = isRealmObject; 122 | exports.isRealmList = isRealmList; 123 | exports.sanitizeFloat = sanitizeFloat; 124 | exports.sanitizeInt = sanitizeInt; 125 | exports.sanitizeString = sanitizeString; 126 | exports.sanitizeStringNonNull = sanitizeStringNonNull; 127 | exports.sanitizeBool = sanitizeBool; 128 | -------------------------------------------------------------------------------- /inst/js/src/components/RBDropdownComponent.jsx: -------------------------------------------------------------------------------- 1 | 'use-strict'; 2 | 3 | import React from 'react'; 4 | import { MenuItem, DropdownButton, ButtonToolbar } from 'react-bootstrap'; 5 | import Control from 'react-leaflet-control'; 6 | 7 | export default class RBDropDown extends React.Component { 8 | constructor(props) { 9 | super(props); 10 | this.state = { 11 | title: props.hasOwnProperty('title') ? props.title : "No Title", 12 | menuitems: props.hasOwnProperty('menuitems') ? props.menuitems : [] 13 | } 14 | this._generateMenuItems = this._generateMenuItems.bind(this); 15 | } 16 | 17 | _generateMenuItems(menuitems) { 18 | const isArray = menuitems && typeof (menuitems[0]) !== 'string'; 19 | return menuitems.map((entry, i) => { 20 | let key, value; 21 | if (isArray) { 22 | key = Object.keys(entry)[0]; 23 | value = Object.values(entry)[0]; 24 | } 25 | if ((!isArray && entry === "") || 26 | (isArray && key === "" && value === "")) { 27 | return (); 28 | } 29 | else { 30 | return ( 32 | {isArray ? value : entry} 33 | ); 34 | } 35 | }); 36 | } 37 | 38 | static getDerivedStateFromProps(props, state) { 39 | if (props.hasOwnProperty('title') && props.title !== state.title) { 40 | return { 41 | title: props.title 42 | } 43 | } 44 | if (props.hasOwnProperty('menuitems') && props.menuitems.length !== state.menuitems.length) { 45 | return { 46 | menuitems: props.menuitems 47 | } 48 | } 49 | return null 50 | } 51 | 52 | render() { 53 | const { title, menuitems } = this.state; 54 | const { size, classNames } = this.props; 55 | const keyIsArray = menuitems && typeof (menuitems[0]) !== 'string'; 56 | 57 | // console.log(title); 58 | if(!menuitems || menuitems.length == 0) { 59 | return(null) 60 | } 61 | 62 | return ( 63 | 66 | 67 | 0 && [...classNames]} 70 | id={typeof (size) === 'string' ? size : "dropdown-size-medium"} 71 | onSelect={(event) => { 72 | //update title 73 | this.setState({ 74 | title: keyIsArray ? Object.values(event)[0] : event 75 | }) 76 | if (typeof (this.props.onSelectCallback) === 'function') { 77 | this.props.onSelectCallback(keyIsArray ? Object.values(event)[0] : event) 78 | } 79 | //die gracefully 80 | }}> 81 | { 82 | this._generateMenuItems(menuitems) 83 | } 84 | 85 | 86 | 87 | ) 88 | } 89 | } 90 | -------------------------------------------------------------------------------- /R/create.R: -------------------------------------------------------------------------------- 1 | #' Simulate CRA without create-react-app 2 | #' 3 | #' This function assembles the required npm package files to then build from. 4 | #' 5 | #' @param path character: new/existing path of the target gp app. 6 | #' 7 | #' @export 8 | #' @examples 9 | #' p = file.path(tempdir(), "gp_app") 10 | #' gp_create(p) 11 | #' gp_erase() 12 | gp_create <- function(path = getwd()) { 13 | if(gp_is_wd_geoplumber()) 14 | stop("Directory seems to be a gp app already.") 15 | if(!dir.exists(path)) { 16 | message("Creating directory: ", path) 17 | dir.create(path) 18 | } else { 19 | # check to proceed if other files exist 20 | if(length(dir(path)) !=0) { 21 | if(interactive() && force) { 22 | message("Path: ", path) 23 | message(list.files(path)) 24 | reply = utils::menu(c("Yes", "No"), 25 | title="Directory not empty, proceed?") 26 | if(reply == 2) { 27 | stop("OK leaving '", path, "' untouched.") 28 | } 29 | } else { 30 | # TODO: could use force=TRUE param 31 | stop("Directory '", path, "' not empty.") 32 | } 33 | } 34 | } 35 | # simulate an app 36 | dir.create(file.path(path, "R")) 37 | # copy CRA files over 38 | gp_temp_files <- list.files( 39 | system.file("js", package="geoplumber")) 40 | sapply(gp_temp_files, function(x){ 41 | file.copy(system.file(file.path("js", x), package = "geoplumber"), 42 | path, recursive = TRUE) 43 | }) 44 | file.copy(system.file("plumber.R", package = "geoplumber") 45 | , file.path(path, "R")) 46 | ow <- setwd(path) 47 | rename_package.json(basename(path)) 48 | setwd(ow) 49 | # we are done 50 | message(paste0("To build/run app, set working directory to: ", path)) 51 | message("Standard output from create-react-app works.\n", 52 | "You can run gp_ functions from directory: ", path, 53 | "\nTo build the front end run: gp_build()\n", 54 | "To run the geoplumber app: gp_plumb()\n", 55 | "Happy coding.") 56 | # write path to `tempfile_name()` 57 | write_tempfile(path) 58 | } 59 | 60 | 61 | #' Remove a geoplumber project and clean associated directories 62 | #' 63 | #' @param dir_name name of gp project directory (if NULL, previously-built 64 | #' directory will be erased) 65 | #' 66 | #' @export 67 | gp_erase <- function(dir_name = NULL) { 68 | if (is.null(dir_name)) 69 | dir_name <- read_tempfile() # from R/utils.R 70 | wd <- getwd() 71 | # only a gp directory, could check with user 72 | # if not interactive, wont be so useful 73 | if(gp_is_wd_geoplumber(dir_name)) { 74 | setwd (dir_name) 75 | setwd ("..") 76 | message("Erasing '", dir_name, "' ...") 77 | unlink (dir_name, recursive = TRUE) 78 | if (file.exists(tempfile_name())) 79 | invisible(file.remove(tempfile_name())) 80 | if (file.exists(wd)) # dir_name might have been wd itself 81 | setwd(wd) 82 | } 83 | } 84 | 85 | #' Essential checks for certain functions of geoplumber. 86 | #' 87 | #' gp_build, gp_create and others rely on npm/node being present 88 | #' on the system and might be used in future so refactoring a helper function 89 | #' is good. 90 | #' 91 | #' @return TRUE/FALSE 92 | #' @examples { 93 | #' gp_npm_exists() 94 | #' } 95 | #' @export 96 | gp_npm_exists <- function() { 97 | # TODO: hide system errors. 98 | check_node <- system("node -v", ignore.stdout = TRUE, ignore.stderr = TRUE) 99 | check_npm <- system("npm -v", ignore.stdout = TRUE, ignore.stderr = TRUE) 100 | check_npm == 0 && check_node == 0 101 | } 102 | -------------------------------------------------------------------------------- /R/add_geojson.R: -------------------------------------------------------------------------------- 1 | #' For now, views a geojson served from an endpoint on leafletjs. 2 | #' 3 | #' Assumes there is a valid geoplumber app at wd 4 | #' TODO: work with valid paths too 5 | #' TODO: either here, or separate function, add my own component. 6 | #' 1. Add a component with ability to fetch geojson from an endpoint to /components 7 | #' 2. Import it into the App.js (TODO: into any other component) 8 | #' Errors: stop execution if either React 'src' folder or for now "Welcome.js" component 9 | #' does not exist. This is because for now we are adding the ready to use GeoJSONComponent component 10 | #' into src/Welcome.js 11 | #' 12 | #' @param endpoint where to fetch the geojson from 13 | #' @param color for now color value for all geojson 14 | #' @param line_weight worded carefully for leaflet geojson lineweight. 15 | #' @param properties logical, by default `FALSE`. If TRUE `color` and `line_weight` will 16 | #' be obtained from properties/columns from corresponding data served via `endpoint` 17 | #' 18 | #' @export 19 | #' @examples \dontrun{ 20 | #' if(gp_is_wd_geoplumber()) { 21 | #' gp_add_geojson() 22 | #' } 23 | #' } 24 | #' 25 | gp_add_geojson <- function(endpoint = "/api/data", 26 | color = "#3388ff", 27 | line_weight = NA, 28 | properties = FALSE){ 29 | check_welcome <- file.exists("src/Welcome.js") 30 | if(!check_welcome) { 31 | stop("Is current dir a geoplumber app? 32 | \nTry geoplumber::gp_create() first.") 33 | # no point going any further 34 | } 35 | # Read the template 36 | component.name <- "GeoJSONComponent" 37 | component.path <- paste0("components/", component.name, ".jsx") 38 | component <- system.file(paste0("js/src/", component.path), package = "geoplumber") 39 | component <- readLines(component) 40 | # Add component to Welcome.js 41 | welcome <- readLines("src/Welcome.js") 42 | # read welcome compoennt, if not, stop 43 | if(length(welcome) < 10) { # TODO: much better check than this 44 | stop("geoplumber could not insert component into Welcome.js") 45 | } 46 | # import component 47 | welcome <- add_import_component(welcome, component.name, component.path) 48 | 49 | # find end map component tag 50 | map.end.index <- grep(pattern = "", x = welcome) 51 | # TODO: more checks as file could be corrupt 52 | style <- paste0("{color:'", color, "'") 53 | if(!is.na(line_weight)){ 54 | style <- paste0(style, ", ", 55 | "weight:'", line_weight, "'}" 56 | ) 57 | } else { 58 | style <- paste0(style, "}") 59 | } 60 | style <- paste0(" style={", style, "}") 61 | if(properties) { 62 | if(!is.na(line_weight) & 63 | !startsWith(color, "#") & # in case deafult is left int 64 | is.character(color)) { 65 | # get the values from gejoson features 66 | # style is a function 67 | style <- paste0(" style={(feature) => ({color: feature.properties.", color, ",", 68 | "weight: feature.properties.", line_weight,"})}") 69 | } else { 70 | stop("Please provide correct parameters to add a GeoJSON component.") 71 | } 72 | } 73 | # insert line 74 | welcome <- c(welcome[1:map.end.index - 1], 75 | # add two spaces 76 | paste0(next_spaces(welcome[map.end.index]), 77 | "<", component.name, 78 | style, 79 | " fetchURL='http://localhost:8000", endpoint, "'", 80 | " map={ this.state.map } />"), #TODO: HARDcoded url port etc. 81 | welcome[map.end.index:length(welcome)] 82 | ) 83 | # now write to project 84 | write(component, file = paste0("src/", component.path)) 85 | write(welcome, "src/Welcome.js") 86 | message("Remember to rebuild frontend: gp_build()") 87 | message("Success. ") 88 | } 89 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | context("test-utils") 2 | 3 | 4 | test_that("change_to_proj_dir needs a dir", { 5 | expect_error(change_to_proj_dir()) 6 | }) 7 | 8 | test_that("!gp_is_wd_geoplumber", { 9 | expect_equal(gp_is_wd_geoplumber(), FALSE) 10 | }) 11 | 12 | test_that("stop_ifnot_geoplumber", { 13 | expect_error(stop_ifnot_geoplumber()) 14 | }) 15 | 16 | test_that("gp_install_npm_package fails on empty", { 17 | expect_error(gp_install_npm_package()) 18 | }) 19 | 20 | test_that("gp_install_npm_package fails on na", { 21 | expect_error(gp_install_npm_package(NA)) 22 | }) 23 | 24 | test_that("gp_install_npm_package fails on NULL", { 25 | expect_error(gp_install_npm_package(NULL)) 26 | }) 27 | 28 | test_that("gp_install_npm_package fails on ", { 29 | expect_error(gp_install_npm_package("")) 30 | }) 31 | 32 | test_that("gp_install_npm_package fails on no package.json", { 33 | expect_message(gp_install_npm_package("testpackage")) 34 | }) 35 | 36 | test_that("prints npm install instructions", { 37 | out <- gp_install_node_instructions() 38 | expect_equal(any(grepl(pattern = "NodeJS", out)), TRUE) 39 | }) 40 | 41 | test_that("add_lines adds line at correct location", { 42 | v <- readLines(system.file("js/src/App.js", package = "geoplumber")) 43 | # is at 25 44 | v <- add_lines(v, "", "") 45 | # should be at 25 46 | dummy <- grep(pattern = "", v) 47 | main <- grep(pattern = "", v) 48 | expect_equal(dummy, main - 1) 49 | # add line after 50 | v <- add_lines(v, "", "", before = FALSE) 51 | dummy <- grep(pattern = "", v) 52 | expect_equal(dummy[2], main + 1) 53 | }) 54 | 55 | test_that("gp_remove_lines removes pattern given from source.", { 56 | appjs <- readLines(system.file("js/src/App.js", package = "geoplumber")) 57 | filename <- "test.js" 58 | write(appjs, file = filename) 59 | gp_remove_lines(filename, 60 | pattern = "* Separate the Header and the main content.") 61 | testjs <- readLines(filename) 62 | expect_equal((length(appjs)) - 1, length(testjs)) 63 | file.remove(filename) 64 | }) 65 | 66 | test_that("gp_remove_lines removes 5 lines after pattern from source.", { 67 | before <- readLines(system.file("js/src/App.js", package = "geoplumber")) 68 | filename <- "test.js" 69 | write(before, file = filename) 70 | gp_remove_lines(filename, 71 | pattern = "* Separate the Header and the main content.", 72 | lines_count = 5) 73 | after <- readLines(filename) 74 | expect_equal((length(before)) - (length(after)), 5) 75 | file.remove(filename) 76 | }) 77 | 78 | test_that("add_import_component adds one line", { 79 | v <- readLines(system.file("js/src/App.js", package = "geoplumber")) 80 | v.length <- length(v) 81 | v <- add_import_component(v, "", "") 82 | expect_equal(v.length + 1, length(v)) 83 | }) 84 | 85 | test_that("gp_change_file adds one line", { 86 | v <- readLines(system.file("js/src/App.js", package = "geoplumber")) 87 | v.length <- length(v) 88 | index.main <- grep("", v) 89 | temp.file <- "temp.js" 90 | write(v, temp.file) 91 | v <- gp_change_file(temp.file, what = "# dummy __comment__ line", 92 | pattern = "", verbose = TRUE) 93 | v <- readLines(temp.file) 94 | index <- grep("# dummy __comment__ line", v) 95 | expect_equal(index.main, index) # added before 96 | expect_equal(v.length + 1, length(v)) # ony one line added 97 | file.remove(temp.file) 98 | }) 99 | 100 | test_that("gp_create adds one line", { 101 | dir <- file.path(tempdir(), "cra") 102 | dir.create(dir, recursive = TRUE) 103 | expect_false(gp_is_wd_geoplumber(dir)) 104 | gp_create(dir) 105 | expect_true(gp_is_wd_geoplumber(dir)) 106 | }) 107 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' Traffic data from CDRC data sets 2 | #' 3 | #' See [data.cdrc.ac.uk/dataset/southwark-traffic-counts](https://data.cdrc.ac.uk/dataset/southwark-traffic-counts) 4 | #' This dataset represents point locations where traffic 5 | #' is measured. 6 | #' 7 | #' @examples 8 | #' \dontrun{ 9 | #' # dataset was stored as follows (from CDRC): 10 | #' u = paste0("https://data.cdrc.ac.uk/dataset/", 11 | #' "c90eee49-6f92-4508-ac36-6df56853f817/resource/", 12 | #' "d39d9d89-0478-4f75-a166-1a445bf42f9c/download/metadata.json") 13 | #' download.file(u, "inst/extdata/traffic.geojson") 14 | #' traffic <- sf::read_sf("inst/extdata/traffic.geojson") 15 | #' # sf:::plot.sf(traffic) 16 | #' # mapview::mapview(traffic) 17 | #' usethis::use_data(traffic, overwrite = TRUE) 18 | #' } 19 | "traffic" 20 | 21 | #' Traffic data from CDRC data sets 22 | #' 23 | #' See [data.cdrc.ac.uk/dataset/southwark-traffic-counts](https://data.cdrc.ac.uk/dataset/southwark-traffic-counts) 24 | #' This dataset represents travel levels at the point locations stored in 25 | #' `traffic` 26 | #' 27 | #' @examples 28 | #' \dontrun{ 29 | #' f = "/tmp/2010-2016-allaveragedailytrafficflowcdrcmapreducedfile.xlsx" 30 | #' traffic_volumes = readxl::read_excel(f) 31 | #' summary(traffic_volumes$ID %in% traffic$cp) 32 | #' pryr::object_size(traffic_volumes) 33 | #' usethis::use_data(traffic_volumes) 34 | #' library(dplyr) 35 | #' traffic_agg = traffic_volumes %>% 36 | #' group_by(cp = ID) %>% 37 | #' summarise( 38 | #' total = sum(`TOTAL FLOW`), 39 | #' cycle_or_motorcycle = sum(`ARX PEDAL-MOTORCYCLE`), 40 | #' av_speed = mean(AVERAGE_SPEED), 41 | #' year = mean(YEAR) 42 | #' ) 43 | #' if(ncol(traffic) < 8) { 44 | #' traffic = left_join(traffic, traffic_agg) 45 | #' usethis::use_data(traffic, overwrite = TRUE) 46 | #' } 47 | #' mapview::mapview(traffic, zcol = "total") 48 | #' sf:::plot.sf(traffic) 49 | #' } 50 | #' summary(traffic_volumes) 51 | #' plot(traffic$total, traffic$cycle_or_motorcycle) 52 | "traffic_volumes" 53 | 54 | #' Road traffic casualties 55 | #' 56 | #' From OpenStreetMap 57 | #' 58 | #' @examples 59 | #' \dontrun{ 60 | #' stplanr::dl_stats19() 61 | #' ac = stplanr::read_stats19_ac() # 214 mb compressed data 62 | #' ac = ac[!is.na(ac$Latitude), ] 63 | #' ac_few_cols = ac[ c("Accident_Severity", "Longitude", "Latitude", "Date")] 64 | #' ac_sf = sf::st_as_sf(ac_few_cols, coords = c("Longitude", "Latitude")) 65 | #' sf::st_crs(ac_sf) = 4326 66 | #' bb = stplanr::bb2poly(bb = sf::as_Spatial(traffic)) 67 | #' bb_sf = sf::st_as_sf(bb) 68 | #' traffic_casualties = ac_sf[bb_sf, ] 69 | #' pryr::object_size(traffic_casualties) # 2 MB 70 | #' traffic_casualties_2014 = traffic_casualties[ 71 | #' traffic_casualties$Date > "2014-01-01", 72 | #' ] 73 | #' pryr::object_size(traffic_casualties_2014) # 200 kB 74 | #' usethis::use_data(traffic_casualties_2014) 75 | #' } 76 | #' plot(traffic_casualties_2014$Date, traffic_casualties_2014$Accident_Severity) 77 | "traffic_casualties_2014" 78 | 79 | #' Small sample of road network in an sf object. 80 | #' 81 | #' The data has been processed too much for a reproducible snippet to 82 | #' provide here. 83 | #' 84 | #' It is obtained from the same [data.cdrc.ac.uk/dataset/southwark-traffic-counts](https://data.cdrc.ac.uk/dataset/southwark-traffic-counts) 85 | #' dataset of `traffic` above, also using osmdata package. 86 | #' @examples { 87 | #' object.size(traffic_network) 88 | #' } 89 | "traffic_network" 90 | 91 | #' sf object representing the university of Leeds 92 | #' 93 | #' From OpenStreetMap 94 | #' 95 | #' @aliases uni_poly 96 | #' @examples 97 | #' # library(osmdata) 98 | #' # osm_list <- opq("leeds") %>% 99 | #' # add_osm_feature("name", "University of Leeds") %>% 100 | #' # osmdata_sf() 101 | #' # uni_poly = osm_list$osm_polygons 102 | #' # mapview::mapview(uni_poly) 103 | #' # uni_point <- sf::st_centroid(osm_list$osm_polygons) 104 | "uni_point" 105 | -------------------------------------------------------------------------------- /tests/testthat/test-build.R: -------------------------------------------------------------------------------- 1 | context("test-gp_build") 2 | # all tests run from clean package env 3 | 4 | skip_build <- function() { 5 | # set GP_LOCAL_INCLUDE_BUILD in ~/.Renviron as 6 | # GP_LOCAL_INCLUDE_BUILD = false for skipping test. 7 | if(identical(Sys.getenv("GP_LOCAL_INCLUDE_BUILD"), "false")) 8 | skip("Not running full test.") 9 | } 10 | 11 | testthat::skip_on_cran() 12 | #' Few different tests are included in this file. 13 | #' The reason is gp_create takes a while and it is best to do all the tests in the same repo. 14 | #' The alternative is to move gp_erase or unlink commands into the last running test. 15 | #' for `now` perhaps a big test file would cause no damage. 16 | 17 | test_that("gp_build errs for non geoplumber path", { 18 | # runs from a clean env so gp_is_wd_geoplumber == FALSE 19 | expect_error(gp_build()) 20 | }) 21 | 22 | test_that("full create", { 23 | # tolower is used to respect CRA rules. 24 | gp <- tolower(tempdir()) 25 | expect_error(gp_rstudio()) 26 | expect_error(gp_rstudio("NOT_GP_DIR")) 27 | f <- file.path(gp, "test.txt") 28 | dir.create(gp) # must create in test before file.create 29 | file.create(f) 30 | expect_error(gp_create (gp)) 31 | unlink(gp, recursive = TRUE) # so that gp_create does it 32 | # create full 33 | # dir.create(gp) less covr if used 34 | expect_message(gp_create (gp)) 35 | proj_dir <- read_tempfile () 36 | expect_true(file.exists (proj_dir)) 37 | js_file <- file.path (proj_dir, "package.json") 38 | expect_true(file.exists (js_file)) 39 | old <- setwd(proj_dir) # we are in the new app dir 40 | expect_false(rproj_file_exists("")) 41 | expect_true(gp_is_wd_geoplumber()) 42 | gp_rstudio() 43 | expect_error(gp_rstudio("")) 44 | expect_error(gp_rstudio(c(NA,NA))) 45 | # expect_true(rproj_file_exists()) 46 | teardown(unlink(gp, recursive = TRUE)) 47 | teardown(setwd(old)) 48 | # rproj before create 49 | tmp <- file.path(tolower(tempdir()), "my_app") 50 | dir.create(tmp) 51 | file.create(file.path(tmp, "my_app.Rproj")) 52 | expect_error(gp_create (tmp)) 53 | teardown(unlink(tmp, recursive = TRUE)) 54 | }) 55 | 56 | # test before build test 57 | test_that("gp_plumb can serve API only", { 58 | # needs to skip as gp_is_wd_geoplumber == FALSE 59 | # skip_build() 60 | expect_message(gp_plumb(run = FALSE, file = "R/plumber.R")) 61 | r <- gp_plumb(run = FALSE, file = "R/plumber.R") 62 | expect_equal(length(r$endpoints[[1]]), 5) # added extra endpoint 63 | # print(gp_is_wd_geoplumber()) 64 | ps <- gp_plumb() 65 | expect_true(inherits(ps, "r_process")) 66 | # require(RCurl) 67 | # webpage <- getURL("http://localhost:8000") 68 | # webpage <- readLines(tc <- textConnection(webpage)); close(tc) 69 | # print(tail(webpage)) 70 | ps$kill() 71 | on.exit(tryCatch(ps$kill, error = function(e) NULL), add = TRUE) 72 | }) 73 | 74 | test_that ("full build", { 75 | skip_build() 76 | expect_message (gp_build ()) 77 | build_dir <- file.path (read_tempfile(), "build") 78 | expect_true(file.exists (build_dir)) 79 | }) 80 | 81 | test_that("npm start works", { 82 | skip_build() 83 | setup({ 84 | gp_kill_process() # no harm 85 | }) 86 | expect_false(is_port_engated()) 87 | expect_message(gp_plumb_front()) 88 | expect_message(gp_clean()) 89 | teardown( 90 | gp_kill_process() 91 | ) 92 | }) 93 | 94 | make_req <- function(verb, path, qs="", body=""){ 95 | req <- new.env() 96 | req$REQUEST_METHOD <- toupper(verb) 97 | req$PATH_INFO <- path 98 | req$QUERY_STRING <- qs 99 | req$rook.input <- list(read_lines = function(){ body }, 100 | read = function(){ charToRaw(body) }, 101 | rewind = function(){ length(charToRaw(body)) }) 102 | req 103 | } 104 | 105 | test_that ("default endpoints", { 106 | skip_build() 107 | r <- gp_plumb(run = FALSE, file = "R/plumber.R", 108 | front = TRUE) 109 | expect_equal(length(r$endpoints[[1]]), 4) 110 | expect_equal(r$endpoints[[1]][[1]]$exec(make_req("GET", "/"), ""), 111 | list(msg="The message is: 'nothing given'")) 112 | }) 113 | 114 | context("test-gp_sf") 115 | 116 | test_that ("gp_sf can serve default sf object", { 117 | Sys.setenv(DO_NOT_PLUMB = 'false') 118 | on.exit(Sys.unsetenv("DO_NOT_PLUMB")) 119 | expect_equal(gp_sf(), TRUE) 120 | Sys.unsetenv("DO_NOT_PLUMB") 121 | }) 122 | 123 | context("test-gp_erase") 124 | 125 | test_that ("full erase", { 126 | skip_build() 127 | expect_message (gp_erase ()) 128 | }) 129 | -------------------------------------------------------------------------------- /inst/js/src/registerServiceWorker.js: -------------------------------------------------------------------------------- 1 | // In production, we register a service worker to serve assets from local cache. 2 | 3 | // This lets the app load faster on subsequent visits in production, and gives 4 | // it offline capabilities. However, it also means that developers (and users) 5 | // will only see deployed updates on the "N+1" visit to a page, since previously 6 | // cached resources are updated in the background. 7 | 8 | // To learn more about the benefits of this model, read https://goo.gl/KwvDNy. 9 | // This link also includes instructions on opting out of this behavior. 10 | 11 | const isLocalhost = Boolean( 12 | window.location.hostname === 'localhost' || 13 | // [::1] is the IPv6 localhost address. 14 | window.location.hostname === '[::1]' || 15 | // 127.0.0.1/8 is considered localhost for IPv4. 16 | window.location.hostname.match( 17 | /^127(?:\.(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)){3}$/ 18 | ) 19 | ); 20 | 21 | export default function register() { 22 | if (process.env.NODE_ENV === 'production' && 'serviceWorker' in navigator) { 23 | // The URL constructor is available in all browsers that support SW. 24 | const publicUrl = new URL(process.env.PUBLIC_URL, window.location); 25 | if (publicUrl.origin !== window.location.origin) { 26 | // Our service worker won't work if PUBLIC_URL is on a different origin 27 | // from what our page is served on. This might happen if a CDN is used to 28 | // serve assets; see https://github.com/facebookincubator/create-react-app/issues/2374 29 | return; 30 | } 31 | 32 | window.addEventListener('load', () => { 33 | const swUrl = `${process.env.PUBLIC_URL}/service-worker.js`; 34 | 35 | if (isLocalhost) { 36 | // This is running on localhost. Lets check if a service worker still exists or not. 37 | checkValidServiceWorker(swUrl); 38 | 39 | // Add some additional logging to localhost, pointing developers to the 40 | // service worker/PWA documentation. 41 | navigator.serviceWorker.ready.then(() => { 42 | console.log( 43 | 'This web app is being served cache-first by a service ' + 44 | 'worker. To learn more, visit https://goo.gl/SC7cgQ' 45 | ); 46 | }); 47 | } else { 48 | // Is not local host. Just register service worker 49 | registerValidSW(swUrl); 50 | } 51 | }); 52 | } 53 | } 54 | 55 | function registerValidSW(swUrl) { 56 | navigator.serviceWorker 57 | .register(swUrl) 58 | .then(registration => { 59 | registration.onupdatefound = () => { 60 | const installingWorker = registration.installing; 61 | installingWorker.onstatechange = () => { 62 | if (installingWorker.state === 'installed') { 63 | if (navigator.serviceWorker.controller) { 64 | // At this point, the old content will have been purged and 65 | // the fresh content will have been added to the cache. 66 | // It's the perfect time to display a "New content is 67 | // available; please refresh." message in your web app. 68 | console.log('New content is available; please refresh.'); 69 | } else { 70 | // At this point, everything has been precached. 71 | // It's the perfect time to display a 72 | // "Content is cached for offline use." message. 73 | console.log('Content is cached for offline use.'); 74 | } 75 | } 76 | }; 77 | }; 78 | }) 79 | .catch(error => { 80 | console.error('Error during service worker registration:', error); 81 | }); 82 | } 83 | 84 | function checkValidServiceWorker(swUrl) { 85 | // Check if the service worker can be found. If it can't reload the page. 86 | fetch(swUrl) 87 | .then(response => { 88 | // Ensure service worker exists, and that we really are getting a JS file. 89 | if ( 90 | response.status === 404 || 91 | response.headers.get('content-type').indexOf('javascript') === -1 92 | ) { 93 | // No service worker found. Probably a different app. Reload the page. 94 | navigator.serviceWorker.ready.then(registration => { 95 | registration.unregister().then(() => { 96 | window.location.reload(); 97 | }); 98 | }); 99 | } else { 100 | // Service worker found. Proceed as normal. 101 | registerValidSW(swUrl); 102 | } 103 | }) 104 | .catch(() => { 105 | console.log( 106 | 'No internet connection found. App is running in offline mode.' 107 | ); 108 | }); 109 | } 110 | 111 | export function unregister() { 112 | if ('serviceWorker' in navigator) { 113 | navigator.serviceWorker.ready.then(registration => { 114 | registration.unregister(); 115 | }); 116 | } 117 | } 118 | -------------------------------------------------------------------------------- /R/sf.R: -------------------------------------------------------------------------------- 1 | #' Explore an sf R object on a leaflet map. 2 | #' 3 | #' The function (for now) takes one parameter to bounce back 4 | #' to the backend. For now just a dropdown list. 5 | #' The slider only works with circles. 6 | #' 7 | #' @param sf a valid sf object that can be converted to geojson 8 | #' @param props_list one named list of menuitmes to explore sf object with. 9 | #' 10 | #' @examples \dontrun{ 11 | #' gp_sf() 12 | #' } 13 | #' @export 14 | gp_sf <- function(sf = geoplumber::traffic, 15 | props_list = list(road = geoplumber::traffic$road)) { 16 | # no more than one param for now 17 | if(length(props_list) > 1) 18 | stop("gp_sf is young, can only take one variable. WIP.") 19 | # print(list) 20 | # gp_plumb checks project availability 21 | server <- gp_plumb(run = FALSE) 22 | # convert sf to geojson 23 | # TODO stop if not valid sf or geojsonsf cannot deal with it. 24 | # TODO try catch? 25 | geojson <- geojsonsf::sf_geojson(sf, factors_as_string=FALSE) 26 | 27 | # prepare backend 28 | # TODO: reserve api url for this or generate temp one. 29 | endpoint <- "/api/gp" 30 | # variable name here "road" must be used in the React component. 31 | # flexible variable names 32 | server$handle("GET", endpoint, function(res, req, ...){ 33 | qs <- c(...) # named vector 34 | res$headers$`Content-type` <- "application/json" 35 | if(length(props_list) == 1 && length(names(qs)) == 1){ 36 | # names(props_list) == names(qs) 37 | # qs[[names(qs)]] == "some value" if length is 1 of course 38 | geojson <- geojsonsf::sf_geojson(sf[sf[[names(props_list)]] == qs[[names(qs)]], ], 39 | factors_as_string=FALSE) 40 | } 41 | res$body <- geojson 42 | res 43 | }) 44 | # prepare frontend 45 | # must be done on clean Welcome.js 46 | # 1. add a GeoJSONComponent 47 | # 2. dropdown menu items 48 | parent <- readLines(system.file(paste0("js/src/Welcome.js"), package = "geoplumber")) 49 | # import first 50 | component.name <- "RBDropdownComponent" 51 | component.path <- paste0("components/", component.name, ".jsx") 52 | component2.name <- "GeoJSONComponent" 53 | component2.path <- paste0("components/", component2.name, ".jsx") 54 | parent <- add_import_component(parent, component.name, component.path) 55 | parent <- add_import_component(parent, component2.name, component2.path) 56 | # add component 1 57 | parent <- add_lines( 58 | parent, # target 59 | "", # pattern 60 | c( # what 61 | paste0('<', component.name), # one line 62 | 'position="topright"', 63 | 'menuitems={[]}', 64 | 'onSelectCallback={(sfParam) => this.setState({sfParam})}', 65 | '/>' 66 | ) 67 | ) 68 | # add component 2 69 | parent <- add_lines( 70 | parent, 71 | "", # pattern 72 | c( 73 | paste0('<', component2.name), 74 | 'circle={true}', # connecting GeoJSON with slider 75 | 'radius={this.state.sliderInput}', # connecting GeoJSON with slider 76 | 'map={this.state.map}', # get the map from parent 77 | paste0('fetchURL={"http://localhost:8000', endpoint,'" +'), # 78 | ' (this.state.sfParam ?', 79 | ' //encode the spaces.', 80 | ' "?road=" + this.state.sfParam.split(" ").join("%20") : "")}', 81 | '/>' 82 | ) 83 | ) 84 | 85 | # only if we have a property list to filter the data from client 86 | if(length(props_list) == 1) { 87 | menuitems.index <- grep("menuitems=", parent) # TODO: HARDcoded. 88 | menuitems.line <- paste0("menuitems={[", # TODO: HARDcoded. 89 | # using " quotes means we can avoid apostrophe wreck 90 | paste(paste0('"', unique(sf[[names(props_list)]]), '"'), collapse = ", ") 91 | , "]}") 92 | parent[menuitems.index] <- menuitems.line 93 | # change url based on the variable passed back to plumber 94 | param.index <- grep("?road=", parent) # TODO: HARDcoded. 95 | param.line <- parent[param.index] 96 | # skip sf's default values 97 | # replace road with appropriate name given from props_list 98 | if(!identical("road", names(props_list))) { 99 | param.line <- sub("road=", paste0(names(props_list), "="), param.line) 100 | parent[param.index] <- param.line 101 | } 102 | } 103 | # finally write before building 104 | write(parent, "src/Welcome.js") 105 | # build & serve 106 | if(!identical(Sys.getenv("DO_NOT_PLUMB"), "false")) { 107 | # TODO: gp_build is not made for this or refactor it. 108 | gp_build() 109 | openURL() 110 | # TODO: is it free? 111 | # is_port_engated(port = 8000) 112 | # attempt starting backend in any case 113 | message("Serving data on at ", "http://localhost:8000/api/gp") 114 | server$run(port = 8000) 115 | } else { 116 | return(TRUE) 117 | } 118 | } 119 | 120 | 121 | -------------------------------------------------------------------------------- /R/geojson.R: -------------------------------------------------------------------------------- 1 | #' Explore a geojson object from a remote URL on a map. 2 | #' 3 | #' 4 | #' @param geojson_url URL or path to read geojson from 5 | #' @param colour_pal the value to use when colouring each feature 6 | #' @param build whether to build React front-end, defaults to `TRUE`. 7 | #' 8 | #' @examples \dontrun{ 9 | #' gp_geojson(paste0("http://opendata.canterburymaps.govt.nz/datasets/", 10 | #' "fb00b553120b4f2fac49aa76bc8d82aa_26.geojson")) 11 | #' } 12 | #' @export 13 | gp_geojson <- function(geojson_url, 14 | colour_pal = "", 15 | build = TRUE) { 16 | stop_ifnot_geoplumber() 17 | if(missing(geojson_url)) 18 | stop("gp_geojson needs a geojson_url to pull .geojson from.") 19 | endpoint <- "/api/gp" 20 | component_name <- "GeoJSONComponent" 21 | component_path <- paste0("components/", component_name, ".jsx") 22 | parent <- readLines(system.file(paste0("js/src/Welcome.js"), package = "geoplumber")) 23 | parent <- add_import_component(parent, component_name, component_path) 24 | 25 | colour_function <- "" 26 | if(exists("colour_pal") && length(colour_pal) == 1L && 27 | !is.na(colour_pal) && colour_pal != "") { 28 | colour_function <- 29 | paste0('style={(feature) => ({fillColor:feature.properties.', 30 | colour_pal, 31 | '})}') 32 | } else { 33 | message("colour_pal should be column name, colouring ignored.") 34 | } 35 | parent <- add_lines( 36 | parent, # target 37 | "map: null", # pattern 38 | c(paste0("label: 'gp_geojson: ", geojson_url,"',")) 39 | ) 40 | parent <- add_lines( 41 | parent, # target 42 | "", # pattern 43 | c( # what 44 | paste0('<', component_name), 45 | 'map={this.state.map}', 46 | paste0('fetchURL={"http://localhost:8000', 47 | endpoint,'"}'), 48 | # get color from pallete if given 49 | colour_function, 50 | '/>' 51 | ) 52 | ) 53 | 54 | # prep the data from geojson_url 55 | geojson <- geojsonsf::geojson_sf(geojson_url) 56 | geojson <- geojsonsf::sf_geojson(geojson) 57 | # add it to the endpoint 58 | server <- gp_plumb(run = FALSE) 59 | server$handle("GET", endpoint, function(res){ 60 | res$headers$`Content-type` <- "application/json" 61 | res$body <- geojson 62 | res 63 | }) 64 | 65 | # finally write before building 66 | write(parent, "src/Welcome.js") 67 | # build & serve 68 | if(!identical(Sys.getenv("DO_NOT_PLUMB"), "false")) { 69 | if(build) gp_build() 70 | message("Serving data on at ", "http://localhost:8000/api/gp") 71 | openURL() 72 | # blocking by design 73 | server$run(port = 8000) 74 | } else { 75 | return(TRUE) 76 | } 77 | } 78 | 79 | #' Export geojson object on a map. 80 | #' 81 | #' 82 | #' @param x character or sf object: URL or sf object to view on map 83 | #' @param browse_map logical: should the outcome be viewed in a browser? 84 | #' defaults to `TRUE` 85 | #' @param dest_path character: write output to `tempdir` (default). 86 | #' @param height character: css compatible option for map height. 87 | #' @param width character: css compatible option for map width. 88 | #' @return path character of path that html file was written to. 89 | #' 90 | #' @examples \dontrun{ 91 | #' gp_map(paste0("http://opendata.canterburymaps.govt.nz/datasets/", 92 | #' "fb00b553120b4f2fac49aa76bc8d82aa_26.geojson"), browse_map = FALSE) 93 | #' } 94 | #' @export 95 | gp_map <- function(x, 96 | browse_map = TRUE, 97 | dest_path = tempdir(), 98 | height = NULL, 99 | width = NULL) { 100 | if(missing(x)) 101 | stop("gp_map needs either a URL or sf object to pull data from.") 102 | gv <- "geojson: null // anchor" 103 | result <- readLines(system.file("geoplumber.html", package = "geoplumber")) 104 | geojson <- x 105 | geojson_name <- deparse(substitute(x)) # provisional 106 | prefix <- "gp_map_" 107 | # file or object? 108 | if(!inherits(x, "sf")) { 109 | # superficial test 110 | if(!endsWith(x, ".geojson")) 111 | stop("Is given x a json or geojson file?") 112 | geojson <- geojsonsf::geojson_sf(x) 113 | geojson_name <- basename(x) 114 | } 115 | if(!nrow(geojson) > 0) 116 | stop("Invalid object given or file is corrupt.") 117 | geojson <- geojsonsf::sf_geojson(geojson) 118 | # increment 119 | list <- list.files(dest_path, pattern = prefix) 120 | n <- length(list) 121 | path <- file.path(dest_path, 122 | paste0(prefix, geojson_name, n,".html")) 123 | # add description 124 | result <- gsub("dataDescription: null", 125 | paste0("dataDescription: '", geojson_name, "'"), 126 | result) 127 | # replace placeholder 128 | result <- gsub(gv, paste0("geojson: ",geojson, collapse = ""), result) 129 | # edit map height and width 130 | if(!is.null(height)) { 131 | result <- gsub("height: 100vh", paste0("height: ", height), result) 132 | } 133 | if(!is.null(width)) { 134 | result <- gsub("width: 100%", paste0("width: ", width), result) 135 | } 136 | # finally 137 | write(result, path) 138 | if(browse_map) { 139 | utils::browseURL(path) 140 | } else { 141 | return (path) 142 | } 143 | } 144 | -------------------------------------------------------------------------------- /R/endpoint_from_clip.R: -------------------------------------------------------------------------------- 1 | #' Adds an endpoint function to the plumber.R from clipboard. 2 | #' 3 | #' To use this function, write the endpoint somewhere and then copy it into clipboard. 4 | #' Then call this function. 5 | #' This function uses `clipr` to write it to the 'plumber.R' file. 6 | #' For now only file will be plumber.R 7 | #' 8 | #' 9 | #' TODO: 10 | #' add silent param, write to other .R files. 11 | #' 12 | #' @param evaluate extra check on clipboard content 13 | #' @return None 14 | #' 15 | #' @examples \dontrun{ 16 | #'# Following is a valid endpoint to serve geoplumber::traffic dataset: 17 | #'# = begin ===> 18 | #'# Serve geoplumber::traffic from /api/data 19 | #' 20 | #'# @get /api/data 21 | #'# get_traffic <- function(res) { 22 | #'# geojson <- geojsonio::geojson_json(geoplumber::traffic) 23 | #'# res$body <- geojson 24 | #'# res 25 | #'# } 26 | #'# <==== end = 27 | #'# holindg current clipboard 28 | #' old_clip <- clipr::read_clip() 29 | #'# adding above to clipboard 30 | #' clipr::write_clip(c( 31 | #' "#' Serve geoplumber::traffic from /api/data", 32 | #' "@get /api/data", 33 | #' "get_traffic <- function(res) {", 34 | #' "geojson <- geojsonio::geojson_json(geoplumber::traffic)", 35 | #' "res$body <- geojson", 36 | #' "res", 37 | #' "}" 38 | #' )) 39 | #' # clipr::read_clip() 40 | #' gp_endpoint_from_clip() 41 | #' clipr::write_clip(old_clip) 42 | #' } 43 | #' 44 | #' @export 45 | gp_endpoint_from_clip <- function(evaluate = FALSE) { 46 | # next call reads and checks clip emptyness. 47 | # sanity check 48 | gp_check_clip_endpoint(evaluate = evaluate) 49 | # if there is no plumber.R we must stop 50 | plumberR <- "R/plumber.R" 51 | if(!file.exists(plumberR)) { 52 | stop("Error: cannot find R/plumber.R file.") 53 | } 54 | clip <- suppressWarnings(clipr::read_clip()) 55 | # write 56 | write(c("\n# endoint -----------------------------------", 57 | clip), 58 | file = plumberR, append = TRUE) 59 | message( 60 | "Success.\n", 61 | "Please restart your server: gp_plumb()" 62 | ) 63 | } 64 | 65 | #' Basic sanity check of the plumber endpiont 66 | #' 67 | #' Use this function to check that: 68 | #' 69 | #' 1. There is an endpoint "/api/test" etc. 70 | #' 2. There is a "tag" such as @get/@post 71 | #' 3. Defines a function with/without params 72 | #' 4. Serves a content-type https://www.w3.org/TR/html4/types.html#h-6.7. 73 | #' No specific checks on the return for now just !is.null() 74 | #' 5. TODO: content-type matches 75 | #' 76 | #' using clipr we read from the clipboard 77 | #' 78 | #' @param evaluate should clipboard function be evaulated? Default is (`FALSE`) 79 | #' 80 | #' @return number of warnings 81 | #' 82 | #' @examples \dontrun{ 83 | #' gp_check_clip_endpoint() 84 | #' } 85 | #' @export 86 | gp_check_clip_endpoint <- function(evaluate = FALSE) { 87 | warningCount <- 0 88 | # silence clipr::read_clip temp 89 | # https://stackoverflow.com/a/32719422/2332101 90 | # oldw <- getOption("warn") 91 | # options(warn = -1) 92 | clip <- suppressWarnings(clipr::read_clip()) 93 | # options(warn = oldw) 94 | if(is.null(clip)) { 95 | # should not be adding empty lines 96 | stop("Error: Clipboard empty. Please copy a valid endpoint to clipboard first.") 97 | } 98 | if(grepl("gp_endpoint_from_clip", clip) || 99 | grepl("gp_check_clip_endpoint", clip)) { 100 | stop(paste0("Clipboard: \n", 101 | clip, "\n", 102 | " was going to be an infinite loop. Stopping.") 103 | ) 104 | } 105 | message("Clipboard contents: \n", 106 | "------begin----\n", 107 | paste(clip,collapse="\n"), 108 | "\n-----end-----\n") 109 | # 1. is there an endooint /api/data? 110 | matches <- grep("/[[:alpha:]]+", clip, value = TRUE) 111 | if(identical(matches, character(0))) { 112 | warning("Function does not seem to define an endpoint, e.g: /api/data") 113 | warningCount <- warningCount + 1 114 | } 115 | # 2. is there an api verb? 116 | # https://github.com/trestletech/plumber/blob/1332047d57242404c6ccb2ba5a28bd1255b8d2bd/R/plumber.R#L6 117 | verbs <- c("GET", "PUT", "POST", "DELETE", "HEAD", "OPTIONS", "PATCH") 118 | matches <- unique (grep(paste(verbs, collapse="|"), clip, value = TRUE, ignore.case=TRUE)) 119 | # above would return character(0) if none of the verbs can be found. 120 | if(identical(matches, character(0))) { 121 | warning("Functiond does not contain any of the API verbs: ", 122 | paste(verbs, collapse = ", ")) 123 | warningCount <- warningCount + 1 124 | } 125 | # 3. defines a function? 126 | if(class(eval(parse(text = clip))) != 'function') { 127 | warning("Endpoint doesnt seem to be a function.") 128 | warningCount <- warningCount + 1 129 | } 130 | 131 | # 4. using eval(parse(text=clip)) returns something? 132 | # TODO: try creating an endpoint from the clipr contents. 133 | # following code is really useless. 134 | if(evaluate){ 135 | evalClip <- try({ 136 | # keep it inside try as it might be an expression rather than a function 137 | ret <- eval(parse(text = clip)) # the function 138 | if(class(ret) == 'function') { 139 | ret <- ret() 140 | } 141 | # if runs fine but returns nothing. 142 | if (is.null(ret)) { 143 | # stop? 144 | warning("Function seems to be returning nothing.") 145 | warningCount <- warningCount + 1 146 | } 147 | ret 148 | }) # TODO: could be silenced. 149 | # http://adv-r.had.co.nz/Exceptions-Debugging.html#debugging-tools 150 | if(class(evalClip) == "try-error") { 151 | warning("Clipboard content failed to parse") 152 | warningCount <- warningCount + 1 153 | } 154 | } 155 | # successful checks should get some feedback. 156 | if(warningCount == 0) { 157 | message("Success.\nPlease restart your server: gp_plumb()") 158 | } 159 | warningCount 160 | } 161 | -------------------------------------------------------------------------------- /inst/js/src/components/GeoJSONComponent.jsx: -------------------------------------------------------------------------------- 1 | /** 2 | * Add features from geojson from a URL to a given map. 3 | * 4 | * 5 | * If the features are points and there are >10 features or circle=true then 6 | * features are displayed as circleMarkers, else Markers. 7 | * 8 | * @param fetchURL default = 'http://localhost:8000/api/data' 9 | * @param radius default 8 10 | * 11 | * geoplumber R package React code. 12 | */ 13 | import React from 'react'; 14 | import { GeoJSON } from 'react-leaflet'; 15 | import L from 'leaflet'; 16 | 17 | export default class GeoJSONComponent extends React.Component { 18 | 19 | constructor(props) { 20 | super(props); 21 | this.state = { 22 | geojson: null 23 | } 24 | this._fetchData = this._fetchData.bind(this) 25 | } 26 | 27 | _fetchData() { 28 | const url = this.props.fetchURL ? this.props.fetchURL : 'http://localhost:8000/api/data' 29 | // console.log("fetching... " + url) 30 | fetch(url) 31 | .then((response) => { 32 | if (response.status !== 200) { 33 | console.log('Looks like there was a problem. Status Code: ' + 34 | response.status); 35 | return; 36 | } 37 | // Examine the text in the response 38 | response.json() 39 | .then((geojson) => { 40 | if ((geojson.features && geojson.features.length === 0) || response.status === 'ZERO_RESULTS') { 41 | this.setState({ error: response.status }) 42 | } else { 43 | var geojsonLayer = L.geoJson(geojson) 44 | const bbox = geojsonLayer.getBounds() 45 | // assuming parent has provided "map" object 46 | this.props.map && this.props.map.fitBounds(bbox) 47 | this.setState({ geojson }) 48 | } 49 | }); 50 | }) 51 | .catch((err) => { 52 | console.log('Fetch Error: ', err); 53 | }); 54 | } 55 | 56 | componentDidMount() { 57 | this._fetchData() 58 | } 59 | 60 | componentDidUpdate(prevProps, prevState) { 61 | if (this.props.fetchURL !== prevProps.fetchURL) { 62 | this._fetchData() 63 | } 64 | if(this.props.radius !== prevProps.radius) { 65 | this.forceUpdate() 66 | } 67 | } 68 | 69 | render() { 70 | const { geojson } = this.state; 71 | let { radius, style } = this.props; 72 | 73 | if (!geojson) { 74 | return (null) // as per React docs 75 | } 76 | 77 | // get radius from parent, or is it above 100 markers? 2 else 8 78 | radius = radius ? radius : geojson.features && geojson.features.length > 100 ? 2 : 8 79 | 80 | if(!geojson.features || geojson.type !== "FeatureCollection") { 81 | if(geojson.coordinates) { //single feature. 82 | return( 83 | 87 | ) 88 | } else { 89 | return(null) //nothing is passed to me. 90 | } 91 | } 92 | // we have type: "FeatureCollection" 93 | return ( 94 | geojson.features.map((feature, i) => { 95 | return ( 96 | { 109 | const properties = Object.keys(feature.properties).map((key) => { 110 | return (key + " : " + feature.properties[key]) 111 | }) 112 | layer.bindPopup( 113 | properties.join('
') 114 | ); 115 | }} 116 | pointToLayer={ 117 | // use cricles prop if not 10 markers is enough 118 | this.props.circle || geojson.features.length > 10 ? 119 | (_, latlng) => { 120 | // Change the values of these options to change the symbol's appearance 121 | let options = { 122 | radius: radius, 123 | fillColor: "green", 124 | color: "black", 125 | weight: 1, 126 | opacity: 1, 127 | fillOpacity: 0.8 128 | } 129 | return L.circleMarker(latlng, options); 130 | } 131 | : 132 | (_, latlng) => { 133 | return L.marker(latlng); 134 | } 135 | } 136 | /> 137 | ) 138 | }) 139 | ) 140 | } 141 | } 142 | -------------------------------------------------------------------------------- /inst/js/src/App.css: -------------------------------------------------------------------------------- 1 | /** 2 | * ATFutures, LIDA/ITS, University of Leeds 3 | * Prepackaged css rules that may or may not be used. 4 | * 5 | * TOD0: separate/component'ize rules. 6 | * TODO: don not overwrite React default package created. 7 | */ 8 | .loader:empty { 9 | position: absolute; 10 | top: calc(50% - 4em); 11 | left: calc(50% - 4em); 12 | width: 6em; 13 | height: 6em; 14 | border: 1.1em solid rgba(0, 0, 0, 0.2); 15 | border-left: 1.1em solid #000000; 16 | border-radius: 50%; 17 | animation: load8 1.1s infinite linear; 18 | z-index: 0; 19 | } 20 | 21 | @keyframes load8 { 22 | 0% { 23 | transform: rotate(0deg); 24 | } 25 | 100% { 26 | transform: rotate(360deg); 27 | } 28 | } 29 | 30 | .info { 31 | padding: 6px 8px; 32 | font: 14px/16px Arial, Helvetica, sans-serif; 33 | background: white; 34 | background: rgba(255,255,255,0.8); 35 | box-shadow: 0 0 15px rgba(0,0,0,0.2); 36 | border-radius: 5px; 37 | } 38 | .info h4 { 39 | margin: 0 0 5px; 40 | color: #777; 41 | } 42 | .legend { 43 | line-height: 18px; 44 | color: #555; 45 | } 46 | .legend i { 47 | width: 18px; 48 | height: 18px; 49 | float: left; 50 | margin-right: 8px; 51 | opacity: 0.7; 52 | } 53 | .leaflet-cluster-anim .leaflet-marker-icon, .leaflet-cluster-anim .leaflet-marker-shadow { 54 | -webkit-transition: -webkit-transform 0.3s ease-out, opacity 0.3s ease-in; 55 | -moz-transition: -moz-transform 0.3s ease-out, opacity 0.3s ease-in; 56 | -o-transition: -o-transform 0.3s ease-out, opacity 0.3s ease-in; 57 | transition: transform 0.3s ease-out, opacity 0.3s ease-in; 58 | } 59 | 60 | .leaflet-cluster-spider-leg { 61 | /* stroke-dashoffset (duration and function) should match with leaflet-marker-icon transform in order to track it exactly */ 62 | -webkit-transition: -webkit-stroke-dashoffset 0.3s ease-out, -webkit-stroke-opacity 0.3s ease-in; 63 | -moz-transition: -moz-stroke-dashoffset 0.3s ease-out, -moz-stroke-opacity 0.3s ease-in; 64 | -o-transition: -o-stroke-dashoffset 0.3s ease-out, -o-stroke-opacity 0.3s ease-in; 65 | transition: stroke-dashoffset 0.3s ease-out, stroke-opacity 0.3s ease-in; 66 | } 67 | 68 | .marker-cluster-small { 69 | background-color: rgba(181, 226, 140, 0.6); 70 | } 71 | .marker-cluster-small div { 72 | background-color: rgba(110, 204, 57, 0.6); 73 | } 74 | 75 | .marker-cluster-medium { 76 | background-color: rgba(241, 211, 87, 0.6); 77 | } 78 | .marker-cluster-medium div { 79 | background-color: rgba(240, 194, 12, 0.6); 80 | } 81 | 82 | .marker-cluster-large { 83 | background-color: rgba(253, 156, 115, 0.6); 84 | } 85 | .marker-cluster-large div { 86 | background-color: rgba(241, 128, 23, 0.6); 87 | } 88 | 89 | /* IE 6-8 fallback colors */ 90 | .leaflet-oldie .marker-cluster-small { 91 | background-color: rgb(181, 226, 140); 92 | } 93 | .leaflet-oldie .marker-cluster-small div { 94 | background-color: rgb(110, 204, 57); 95 | } 96 | 97 | .leaflet-oldie .marker-cluster-medium { 98 | background-color: rgb(241, 211, 87); 99 | } 100 | .leaflet-oldie .marker-cluster-medium div { 101 | background-color: rgb(240, 194, 12); 102 | } 103 | 104 | .leaflet-oldie .marker-cluster-large { 105 | background-color: rgb(253, 156, 115); 106 | } 107 | .leaflet-oldie .marker-cluster-large div { 108 | background-color: rgb(241, 128, 23); 109 | } 110 | 111 | .marker-cluster { 112 | background-clip: padding-box; 113 | border-radius: 20px; 114 | } 115 | .marker-cluster div { 116 | width: 30px; 117 | height: 30px; 118 | margin-left: 5px; 119 | margin-top: 5px; 120 | 121 | text-align: center; 122 | border-radius: 15px; 123 | font: 12px "Helvetica Neue", Arial, Helvetica, sans-serif; 124 | } 125 | .marker-cluster span { 126 | line-height: 30px; 127 | } 128 | 129 | .leaflet-container { 130 | width: inherit; 131 | height: calc(100% - 50px); 132 | } 133 | 134 | html, body, main, .App, #root { 135 | height: 100%; 136 | } 137 | /* top center for now */ 138 | .svg-block { 139 | margin: auto; 140 | } 141 | 142 | .attsearchinput { 143 | color: inherit; 144 | font-size: 15px; 145 | border: none; 146 | } 147 | 148 | .menuAndInput { 149 | padding: 10px; 150 | background-color: #fff; 151 | } 152 | 153 | .attsidebar { 154 | overflow: auto; 155 | max-height: 80vh; 156 | background-color: #fff; 157 | } 158 | 159 | .menuAndInput, .attsidebar { 160 | display: flex; 161 | flex-direction: row; 162 | border-radius: 7px; 163 | } 164 | 165 | .attsidebar button { 166 | align-self: center; 167 | } 168 | 169 | .leaflet-control-layers-expanded, 170 | .leaflet-control-layers-toggle { 171 | border: 2px solid rgba(0,0,0,0.2); 172 | border-radius: 5px; 173 | -webkit-border-radius: 5px; 174 | -moz-border-radius: 5px; 175 | } 176 | 177 | .leaflet-control-layers-toggle { 178 | width: 44px; 179 | height: 44px; 180 | background: url('./img/layers.png') no-repeat center; 181 | background-color: #fff; 182 | } 183 | 184 | .navbar { 185 | margin-bottom: unset; 186 | } 187 | 188 | /******** React 16 default App.css *********/ 189 | .App { 190 | text-align: center; 191 | } 192 | 193 | .App-logo { 194 | animation: App-logo-spin infinite 20s linear; 195 | height: 80px; 196 | } 197 | 198 | .App-header { 199 | background-color: #222; 200 | height: 150px; 201 | padding: 20px; 202 | color: white; 203 | } 204 | 205 | .App-title { 206 | font-size: 1.5em; 207 | } 208 | 209 | .App-intro { 210 | font-size: large; 211 | } 212 | 213 | @keyframes App-logo-spin { 214 | from { transform: rotate(0deg); } 215 | to { transform: rotate(360deg); } 216 | } 217 | 218 | /*http://danielstern.ca/range.css*/ 219 | input[type=range] { 220 | -webkit-appearance: none; 221 | width: 100%; 222 | margin: 7.3px 0; 223 | } 224 | input[type=range]:focus { 225 | outline: none; 226 | } 227 | input[type=range]::-webkit-slider-runnable-track { 228 | width: 100%; 229 | height: 11.4px; 230 | cursor: pointer; 231 | box-shadow: 1px 1px 1px #000000, 0px 0px 1px #0d0d0d; 232 | background: rgba(48, 113, 169, 0.78); 233 | border-radius: 1.3px; 234 | border: 0.2px solid #010101; 235 | } 236 | input[type=range]::-webkit-slider-thumb { 237 | box-shadow: 0.9px 0.9px 1px #000031, 0px 0px 0.9px #00004b; 238 | border: 1.8px solid #00001e; 239 | height: 26px; 240 | width: 26px; 241 | border-radius: 15px; 242 | background: #ffffff; 243 | cursor: pointer; 244 | -webkit-appearance: none; 245 | margin-top: -7.5px; 246 | } 247 | input[type=range]:focus::-webkit-slider-runnable-track { 248 | background: rgba(54, 126, 189, 0.78); 249 | } 250 | input[type=range]::-moz-range-track { 251 | width: 100%; 252 | height: 11.4px; 253 | cursor: pointer; 254 | box-shadow: 1px 1px 1px #000000, 0px 0px 1px #0d0d0d; 255 | background: rgba(48, 113, 169, 0.78); 256 | border-radius: 1.3px; 257 | border: 0.2px solid #010101; 258 | } 259 | input[type=range]::-moz-range-thumb { 260 | box-shadow: 0.9px 0.9px 1px #000031, 0px 0px 0.9px #00004b; 261 | border: 1.8px solid #00001e; 262 | height: 26px; 263 | width: 26px; 264 | border-radius: 15px; 265 | background: #ffffff; 266 | cursor: pointer; 267 | } 268 | input[type=range]::-ms-track { 269 | width: 100%; 270 | height: 11.4px; 271 | cursor: pointer; 272 | background: transparent; 273 | border-color: transparent; 274 | color: transparent; 275 | } 276 | input[type=range]::-ms-fill-lower { 277 | background: rgba(42, 100, 149, 0.78); 278 | border: 0.2px solid #010101; 279 | border-radius: 2.6px; 280 | box-shadow: 1px 1px 1px #000000, 0px 0px 1px #0d0d0d; 281 | } 282 | input[type=range]::-ms-fill-upper { 283 | background: rgba(48, 113, 169, 0.78); 284 | border: 0.2px solid #010101; 285 | border-radius: 2.6px; 286 | box-shadow: 1px 1px 1px #000000, 0px 0px 1px #0d0d0d; 287 | } 288 | input[type=range]::-ms-thumb { 289 | box-shadow: 0.9px 0.9px 1px #000031, 0px 0px 0.9px #00004b; 290 | border: 1.8px solid #00001e; 291 | height: 26px; 292 | width: 26px; 293 | border-radius: 15px; 294 | background: #ffffff; 295 | cursor: pointer; 296 | height: 11.4px; 297 | } 298 | input[type=range]:focus::-ms-fill-lower { 299 | background: rgba(48, 113, 169, 0.78); 300 | } 301 | input[type=range]:focus::-ms-fill-upper { 302 | background: rgba(54, 126, 189, 0.78); 303 | } 304 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' generates a temporary file name 2 | #' /tmp/HasHfolDER 3 | tempfile_name <- function (){ 4 | file.path (tempdir(), ".geoplumber.dat") 5 | } 6 | 7 | # currently just writes project directory to tempfile 8 | write_tempfile <- function (dir_name){ 9 | con <- file (tempfile_name()) 10 | writeLines (dir_name, con) 11 | close (con) 12 | } 13 | 14 | #' returns the project name from the temp file 15 | read_tempfile <- function (){ 16 | if (!file.exists (tempfile_name())) 17 | stop ("No geoplumber project has been created") 18 | con <- file (tempfile_name()) 19 | dir_name <- readLines (con) 20 | close (con) 21 | return (dir_name) 22 | } 23 | 24 | #' Useful function to find temp project name from 25 | #' temporary file in /tmp/HasHfolDER/.geoplumber.dat 26 | #' If that is not available (user could already be in a 27 | #' geoplumber directory) then just returns current wd. 28 | change_to_proj_dir <- function () { 29 | if (!(file.exists (tempfile_name ()) | file.exists ("package.json"))) 30 | stop ("If project was built in a previous R session, you must ", 31 | "first manually change to project directory") 32 | 33 | wd <- getwd () 34 | if (file.exists (tempfile_name ())) { 35 | project_dir <- read_tempfile () 36 | if (!file.exists (project_dir)) 37 | stop ("Project directory ", project_dir, " does not exist") 38 | wd <- setwd (project_dir) 39 | } 40 | return (wd) 41 | } 42 | 43 | #' takes a vector of strings, adds another vector 44 | #' either before or after pattern provided. 45 | #' @param target the vector to add what to 46 | #' @param pattern where to add the what to 47 | #' @param what vector to add to target 48 | #' @param before or after the pattern 49 | add_lines <- function (target, pattern, what, before = TRUE) { 50 | where.index <- grep(pattern, target) 51 | spaces <- next_spaces(target[where.index]) 52 | if(before) { 53 | target <- c(target[1:where.index - 1], 54 | paste0(spaces, what), 55 | target[where.index:length(target)] 56 | ) 57 | } else { 58 | target <- c(target[1:where.index], 59 | paste0(spaces, what), 60 | target[(where.index + 1):length(target)] 61 | ) 62 | } 63 | target 64 | } 65 | 66 | #' takes a vector of strings, adds a Babel style import statement 67 | #' 68 | #' @param target vector to add import statement in. 69 | #' @param component.name name of component to import. 70 | #' @param component.path path to "import" from. 71 | #' @param keyword to use as anchor to add import statement. 72 | #' @param package is the import statement for a package? 73 | #' TODO: multiple or `const {}` JS way of importing. 74 | #' 75 | add_import_component <- function( 76 | target, 77 | component.name, 78 | component.path, 79 | keyword = "export default", 80 | package = FALSE) { 81 | r <- target 82 | # Import new component 83 | # Above 'export default' 84 | export.index <- grep(keyword, target) 85 | # check for duplicate 86 | component.name.added <- grepl(paste0("import ", component.name), target) 87 | if(!any(component.name.added)) { 88 | # import GeoJSONComponent from '/components/GeoJSONComponent.jsx'; 89 | # or 90 | # import Component from 'component' for npm packages 91 | line <- paste0("import ", component.name, " from './", 92 | component.path, "';") 93 | if(package) { 94 | line <- paste0("import ", component.name, " from '", 95 | component.path, "';") 96 | } 97 | r <- c(target[1:export.index - 1], line, 98 | target[export.index:length(target)] 99 | ) 100 | } 101 | r 102 | } 103 | 104 | #' Remove lines from a source file in place 105 | #' 106 | #' Utility function to remove lines from a source file 107 | #' 108 | #' @param path path of file to change, used in readLines() 109 | #' @param pattern remove what, 1st is used. Unique is best. 110 | #' @param lines_count 1 by default provide a number 111 | #' @export 112 | #' @examples \dontrun{ 113 | #' gp_remove_lines() 114 | #' } 115 | gp_remove_lines <- function(path, 116 | pattern = " * geoplumber R package code.", 117 | lines_count = 1L 118 | ) { 119 | con <- file(path, "r") 120 | v <- readLines(con) 121 | if(length(v) == 0 || lines_count < 1L) { 122 | stop("Empty file, ", path, "or wrong lines_count: ", lines_count, ".") 123 | } 124 | pattern.index <- grep(pattern = pattern, x = v) 125 | v <- c( 126 | v[1:(pattern.index - 1)], # to the line before pattern 127 | v[(pattern.index + lines_count):length(v)] 128 | ) 129 | write(v, file = path) 130 | close(con) 131 | } 132 | 133 | #' Change a source file in place 134 | #' 135 | #' Utility function to make changes to a source file 136 | #' @param path path of file to change, used in readLines() 137 | #' @param what vector to add to path 138 | #' @param pattern where to add the what to, 1st is used. Unique is best. 139 | #' @param before s after the pattern 140 | #' @param replace or replace pattern 141 | #' @param verbose cat the change out 142 | #' @export 143 | #' @examples { 144 | #' gp_change_file(replace = TRUE, verbose = TRUE) # replacing the comment itself. 145 | #' } 146 | gp_change_file <- function(path = system.file("js/src/App.js", package = "geoplumber"), 147 | what = " * geoplumber R package code.", 148 | pattern = " * geoplumber R package code.", 149 | before = TRUE, 150 | replace = FALSE, 151 | verbose= FALSE) { 152 | con <- file(path, "r") 153 | v <- readLines(con) 154 | if(length(v) == 0) { 155 | stop("Empty file, gp_change_file requires a file with min 1 line.") 156 | } 157 | # fail safe for default 158 | index <- grep(pattern, v) 159 | if(length(index) >= 1) { 160 | if(replace) { 161 | v <- c(v[1:index - 1], what, v[(index + 1):length(v)] 162 | ) 163 | } else { 164 | v <- add_lines(target = v, pattern = pattern, 165 | what = what, before = before) 166 | } 167 | if(verbose) { 168 | print(paste0("Changed at: ", index)) 169 | print(v[index : (index + 5)]) 170 | } 171 | } else { 172 | message("Pattern ", pattern, " not found.") 173 | } 174 | write(v, file = path) 175 | close(con) 176 | } 177 | 178 | next_spaces <- function(x, count = 4) { 179 | spaces <- regexpr("^\\s+", x) 180 | spaces <- attr(spaces, "match.length") # number of spaces of current line 181 | spaces <- rep(" ", spaces + count) 182 | spaces <- paste(spaces, collapse = "") 183 | spaces 184 | } 185 | 186 | # checks if Rproj file exists in current working dir 187 | rproj_file_exists <- function(path) { 188 | # TODO: sanity checks and +/-s 189 | files <- list.files(path = path) 190 | if(any(grepl(".Rproj", files))) { 191 | return(TRUE) 192 | } 193 | FALSE 194 | } 195 | 196 | #' Wrapper function to copy template.Rproj file into working directory. 197 | #' 198 | #' @param path project path to create .Rproj file in, defaults to ".". 199 | #' 200 | #' @export 201 | #' @examples \dontrun{ 202 | #' gp_rstudio() 203 | #' } 204 | gp_rstudio <- function(path = ".") { 205 | if (length(path) != 1L) # if and only if 1 206 | stop("'path' must be of length 1") 207 | if (is.na(path) || (path == "") || is.null(path)) 208 | stop("A geoplumber app's path is required.") 209 | stopifnot(gp_is_wd_geoplumber(path)) 210 | proj_name <- path 211 | if(identical(path, ".")) { 212 | proj_name <- basename(getwd()) 213 | } else { 214 | proj_name <- basename(path) 215 | } 216 | if(rproj_file_exists(path)) 217 | stop("There is a .Rproj file already")# already exists 218 | res <- file.copy(system.file("rproj_template", package = "geoplumber"), 219 | file.path(path, paste0(proj_name, ".Rproj"))) 220 | return(res) 221 | } 222 | 223 | rename_package.json <- function(project_name) { 224 | if(!file.exists("package.json")) { 225 | stop(paste0("Error: working directory '", getwd(), 226 | "' does not include a package.json.")) 227 | } 228 | pkg_json <- readLines("package.json") 229 | pkg_json[2] <- sub("geoplumber", project_name, pkg_json[2]) 230 | # as it could be path or . 231 | write(pkg_json, "package.json") # project name reset. 232 | } 233 | 234 | 235 | #' Wrapper function to kill what is listening on a particular port. 236 | #' 237 | #' Detect sysytem and run command based on OS. This function supports 238 | #' Linux, MacOS and Windows. There is no guarantee to kill the process. 239 | #' 240 | #' @param port targted port to kill process for defaults to `3000` 241 | #' 242 | #' @examples { 243 | #' gp_kill_process() 244 | #' } 245 | #' 246 | #' @export 247 | gp_kill_process <- function(port = 3000) { 248 | stopifnot(exists("port")) 249 | # detect OS 250 | os <- get_os() 251 | # must use system 252 | if(os == "windows") { 253 | pid <- system(paste0('netstat -ano | findstr :', port)) 254 | system(paste0('taskkill /PID', pid,' /F')) 255 | } else if(os == "linux") { 256 | # linux 257 | system(paste0("kill -9 $(lsof -ti tcp:", port,")")) 258 | } else { 259 | # osx 260 | system(paste0("lsof -ti:", port, " | xargs kill -9")) 261 | } 262 | } 263 | 264 | #' Internal function to determine if port is engaed. 265 | #' 266 | #' @param port to check. 267 | is_port_engated <- function(port = 3000) { 268 | stopifnot(exists("port")) 269 | # detect OS 270 | os <- get_os() 271 | # windows 272 | cmd <- paste0('netstat -ano | findstr :', port) 273 | cmd <- switch (os, 274 | "osx" = paste0("lsof -ti:", port), 275 | "linux" = paste0("lsof -ti tcp:", port) 276 | ) 277 | # must use stystem 278 | pid <- system(cmd, ignore.stdout = TRUE) 279 | if(pid == 0) return(TRUE) 280 | FALSE 281 | } 282 | 283 | #' Internal helper function to determine OS in a consistent way. 284 | #' 285 | get_os <- function(){ 286 | sysinf <- Sys.info() 287 | if (!is.null(sysinf)){ 288 | os <- sysinf['sysname'] 289 | if (os == 'Darwin') 290 | os <- "osx" 291 | } else { ## mystery machine 292 | os <- .Platform$OS.type 293 | if (grepl("^darwin", R.version$os)) 294 | os <- "osx" 295 | if (grepl("linux-gnu", R.version$os)) 296 | os <- "linux" 297 | } 298 | tolower(os) 299 | } 300 | 301 | openURL <- function(host = "127.0.0.1", 302 | port = 8000, 303 | browser = FALSE, 304 | path = "") { 305 | u = paste0("http://",host,":",port, "/", path) 306 | viewer <- getOption("viewer") 307 | if(identical(.Platform$GUI, "RStudio") && 308 | !is.null(viewer) && 309 | !browser) { 310 | viewer(u) 311 | } else { 312 | utils::browseURL(u) 313 | } 314 | } 315 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | editor_options: 4 | chunk_output_type: console 5 | --- 6 | 7 | # geoplumber · [![Build Status](https://travis-ci.org/ATFutures/geoplumber.svg)](https://travis-ci.org/ATFutures/geoplumber) [![codecov](https://codecov.io/gh/ATFutures/geoplumber/branch/master/graph/badge.svg)](https://codecov.io/gh/ATFutures/geoplumber) [![Project Status: WIP](https://www.repostatus.org/badges/latest/wip.svg)](https://www.repostatus.org/#wip) [![PRs Welcome](https://img.shields.io/badge/PRs-welcome-brightgreen.svg)](#) 8 | 9 | 10 | 11 | 12 | ```{r setup, include = FALSE} 13 | knitr::opts_chunk$set( 14 | collapse = TRUE, 15 | comment = "#>", 16 | fig.path = "man/figures/README-", 17 | out.width = "100%" 18 | ) 19 | ``` 20 | 21 | geoplumber is an R package which enables data scientists and developers in general to develop scalable geospatial web applications. It is work in progress, and right now we consider it an R powered web application "framework". It utilizes [`plumber`](https://github.com/trestletech/plumber), which was designed for creating web APIs with R which is Swagger compliant. It supports [React](https://reactjs.org/) frontends at present (it may support other frontend frameworks such as VueJS in the future) and geographic data, building on [`sf`](https://github.com/r-spatial/sf). 22 | 23 | It can be installed with the following command as it is not yet on CRAN: 24 | 25 | ```{r install_github, message=FALSE, eval=FALSE} 26 | devtools::install_github("ATFutures/geoplumber") 27 | #> the latest dev version 28 | ``` 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | ## Usage 38 | * For more detailed introduction see the [vignette](https://atfutures.github.io/geoplumber/articles/geoplumber.html) 39 | 40 | To create a new web application: 41 | ```{r hidden1, echo=FALSE, eval=FALSE} 42 | # knitr::opts_knit$set(root.dir = tempdir()) 43 | ``` 44 | ```{r create-example, eval=FALSE} 45 | library(geoplumber) 46 | gp_create("my_app") 47 | ``` 48 | This will create a `my_app` folder at your current working directory. Suppose you started an R session from a folder with path `/Users/ruser/`, you will have `/Users/ruser/my_app` on your machine. 49 | 50 | You can then build the new project 51 | ```{r build-example, eval=FALSE} 52 | setwd("my_app") 53 | gp_build() # the front end and create minified js files. 54 | 55 | ``` 56 | 57 | You can then serve endpoints and front end with: 58 | `gp_plumb()` \# provide custom port if you wish, default is 8000 59 | 60 | Then visit `localhost:8000` to see your app. 61 | 62 | ## Example (1) reproducible web app 63 | ```{r nofuss} 64 | library(geoplumber) 65 | d <- file.path(tempdir(), "gp") 66 | gp_create(d) 67 | ow <- setwd(d) 68 | ps <- gp_plumb() 69 | Sys.sleep(1) # needed on automated build machines :) 70 | ps 71 | require(RCurl) 72 | webpage <- getURL("http://localhost:8000") 73 | webpage <- readLines(tc <- textConnection(webpage)); close(tc) 74 | tail(webpage) 75 | ps$kill() 76 | setwd(ow) 77 | # should fail 78 | # getURL("http://localhost:8000") 79 | ``` 80 | 81 | 82 | ## Example (2) 83 | Serve the `geoplumber::traffic` dataset (data.frame) at a "/api/data" endpoint, and view it on the front end. 84 | 85 | The `traffic` [dataset](https://data.cdrc.ac.uk/dataset/southwark-traffic-counts) is from CDRC at University of Leeds which is traffic data locations for the larger traffic dataset. 86 | 87 | To achive this copy the following endpoint/API to the clipboard of your machine. If you like to understand the function, you need to learn `plumber` package. 88 | 89 | ```{r eval=FALSE} 90 | #' Serve geoplumber::traffic from /api/data 91 | #' @get /api/data 92 | get_traffic <- function(res) { 93 | geojson <- geojsonsf::sf_geojson(geoplumber::traffic) 94 | res$body <- geojson 95 | res 96 | } 97 | ``` 98 | Then run (re-copied into clipboard just in case): 99 | ```{r hidden2, echo=FALSE} 100 | Sys.setenv(CLIPR_ALLOW=TRUE) 101 | ``` 102 | ```{r add-endpoint-manually, eval=FALSE} 103 | setwd("my_app") 104 | old_clip <- clipr::read_clip() 105 | # adding above to clipboard 106 | clipr::write_clip(c( 107 | "#' Serve geoplumber::traffic from /api/data", 108 | "#' @get /api/data", 109 | "get_traffic <- function(res) {", 110 | " geojson <- geojsonsf::sf_geojson(geoplumber::traffic)", 111 | " res$body <- geojson", 112 | " res", 113 | "}" 114 | )) 115 | gp_endpoint_from_clip() 116 | clipr::write_clip(old_clip) 117 | ``` 118 | 119 | This has now added a new endpoint at: `/api/data`. To consume it, we can simply run: 120 | 121 | ```{r add-geojson, eval=FALSE} 122 | setwd("my_app") 123 | gp_add_geojson("/api/data") 124 | ``` 125 | 126 | You can now see the data by running: 127 | ```{r eval=FALSE} 128 | gp_build() # build changes 129 | gp_plumb() 130 | ``` 131 | 132 | Or in the following "export" function a basic `leaflet` map using the "headless" `gp_map` funciton: 133 | 134 | ```{r, echo=FALSE, fig.align='center', out.width="70%", fig.cap="CDRC London traffic data on geoplumber"} 135 | knitr::include_graphics("man/figures/gp.png") 136 | ``` 137 | 138 | ```{r, echo=TRUE, eval=FALSE} 139 | # cd into a geoplumber app 140 | setwd("my-app/") 141 | library(geoplumber) 142 | # view a dataset such as the `traffic` sf object bundled 143 | t <- gp_map(geoplumber::traffic, browse_map = FALSE, 144 | height = "320px", width = "90%") 145 | # use includeHTML for markdown 146 | htmltools::includeHTML(t) 147 | ``` 148 | 149 | You can also now see the raw JSON dataset at `http://localhost:8000/api/data`, 150 | and on a map on a browser view the map at `http://localhost:8000`. 151 | 152 | ## Example (3) 153 | 154 | We would like to see default University of Leeds `uni_poly` grow/shrink using `sf::st_buffer()` function. Here is a reproducible example (please take a look at the default `plumber.R` file in your `my_app` project): 155 | 156 | ```{r, eval=FALSE} 157 | gp_create(tolower(tempdir())) 158 | setwd(tolower(tempdir())) 159 | gp_is_wd_geoplumber() 160 | gp_add_slider( 161 | min = 0.001, 162 | max = 0.01, 163 | step = 0.001 164 | ) 165 | gp_change_file( 166 | path = "src/Welcome.js", 167 | what = ' 168 | ', 169 | pattern = '', 170 | replace = TRUE, 171 | verbose = TRUE 172 | ) 173 | ``` 174 | 175 | Run the project (this time at `tempdir()` location) by: 176 | ```{r eval=FALSE} 177 | gp_build() # build changes 178 | r <- gp_plumb() # run in bg 179 | r¢kill() 180 | ``` 181 | 182 | Now you can see: 183 | ```{r, echo=FALSE, fig.align='center', out.width="70%", fig.cap="geoplumber::uni_poly grow/shrinking using sf::st_buffer function on server side."} 184 | knitr::include_graphics("https://user-images.githubusercontent.com/1825120/46699371-7f79d000-cc11-11e8-9716-e1223296c7d6.gif") 185 | ``` 186 | 187 | ## geoplumber stack 188 | 189 | We have worked with Shiny and [`plumber`](https://github.com/trestletech/plumber/) and we consider ourselves experienced in ReactJS, too. In order to put together a web application powered at the backend with R and React at the front-end, there is a lot of setup and boilerplate to put together. This would be also correct for other front end stack such as Angular or VueJS. 190 | 191 | Currently geoplumber uses Facebook's `create-react-app` (CRA) npm package to deal with underlying app management (including building and running) to keep you up to date with updates. `geoplumber` will generally provide detailed installation instructions for all required `npm` packages, but if not, the following are minimally required: 192 | 193 | ``` 194 | sudo npm i -g create-react-app 195 | ``` 196 | 197 | ### Front end ### 198 | Once the geoplumber app `my_app` has been created. It will have a `create-react-app` directory structure with an extra `R` folder to hold the backend R code. The React components, as they are in CRA apps, are in the `src` folder and ready to be customised and developed for your own purposes. So, a React developer could run `npm start` on the root directory and run the built in CRA development server which is what `gp_plumb_front()` does too. 199 | 200 | ### npm packages used 201 | The following are included by default, the versions are just from old .Rmd file. geoplumber updates these as the package is developed. Feel free to replace it with your own .json package definer as and when. 202 | 203 | ```{r, echo=FALSE} 204 | data <- read.csv(text= 205 | "package , Usage 206 | create-react-app , main package to manage front end 207 | prop-types , React propTypes 208 | react , React main 209 | react-dom , React DOM 210 | react-bootstrap , bootstrapZ 211 | leaflet , current default web mapping library 212 | react-leaflet , React wrapper around leaflet above 213 | react-leaflet-control , React map control 214 | react-router , React router (RR) 215 | react-router-dom , React dom for RR 216 | react-scripts , main package to manage front end 217 | react-test-renderer , test suite 218 | enzyme , test suite 219 | enzyme-adapter-react-16 , test suite adapter for React 220 | sinon , test suite") 221 | ``` 222 | 223 | ```{r kable-npm} 224 | knitr::kable(data) 225 | ``` 226 | 227 | ## Showcase 228 | 229 | An example application is deployed at [www.geoplumber.com](www.geoplumber.com). It showcases some zone and flow data using both `LeafletJS` and `MapboxGL` both in React. The application is dockerised automating the production and deployment. 230 | 231 | ## End-points 232 | 233 | R package `plumber` comes with a default end-point for documenting the API using Swagger. This is also available from `geoplumber`'s `/__swagger__/` path. 234 | 235 | We follow a pattern of `/api/` before the end-points and without for other URL's. 236 | A new web app will have `/api/helloworld` and you can `curl` it: 237 | 238 | ```{sh eval=FALSE} 239 | curl localhost:8000/api/helloworld 240 | #> {"msg":["The message is: 'nothing given'"]} 241 | ``` 242 | 243 | ## Tests 244 | 245 | Tests currently only apply to restricted components of full functionality. 246 | 247 | ```{r, eval=FALSE} 248 | devtools::test() 249 | ``` 250 | 251 | ## Roadmap 252 | 253 | What I (Layik) think will work for a version 0.1 to hit CRAN is geoplumber would be able to have: 254 | 255 | * basic structure of a R + React app running 256 | * basics of a production environment via Docker 257 | -------------------------------------------------------------------------------- /vignettes/paper.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Geospatial web applications with R and ReactJS" 3 | author: 4 | - Dr Layik Hama^[l.hama@leeds.ac.uk] --- University of Leeds, Leeds Institute for Data Analytics (LIDA) 5 | - Dr Robin Lovelace^[r.lovelace@leeds.ac.uk] --- University of Leeds, Institute for Transport Studies (ITS) and Leeds Institute for Data Analytics (LIDA) 6 | date: "`r Sys.Date()`" 7 | output: rmarkdown::html_vignette 8 | vignette: > 9 | %\VignetteIndexEntry{Geographic data analysis and geospatial web applications with R and ReactJS} 10 | %\VignetteEngine{knitr::rmarkdown} 11 | %\VignetteEncoding{UTF-8} 12 | bibliography: gisruk.bib 13 | header-includes: \usepackage{graphicx} 14 | \usepackage{wrapfig} 15 | \usepackage{float} 16 | --- 17 | ```{r setup, include = FALSE} 18 | knitr::opts_chunk$set( 19 | collapse = TRUE, 20 | comment = "#>", 21 | out.width = "100%" 22 | ) 23 | ``` 24 | 25 | ## Summary {-} 26 | 27 | Data scientists, and R users in particular, tend to focus on 'back-end' data processing, with visual outputs usually generated locally. Recent developements have made it easier for R developers to deploy their applications remotely, the `shiny` package/framework being a notably example. 28 | However, such 'pure R' approaches have limitations, especially when it comes to geographic web apps: 29 | they are often 'pinned' to particular JavaScript frameworks/libraries/versions, and provide little for people wanting to develop web APIs. 30 | To overcome this issue we developed `geoplumber`, an R package that provides the 'best of both worlds', leaving the front end to native JavaScript code and the back-end to R/databases. 31 | This paper describes the approach and highlights the possibilities with a real-world example. 32 | 33 | **Keywords:** Web Applications with R, Rpackage, JavaScript, ReactJS, Web Mapping 34 | 35 | ## Introduction 36 | 37 | \par 38 | \begin{wrapfigure}[10]{r}[2pt]{7cm} 39 | \includegraphics[width=0.45\textwidth]{geoplumber-concept.png} 40 | \caption{Running R as backend and ReactJS + LeafletJS at the frontend of a web application.} 41 | \end{wrapfigure} 42 | 43 | Scripting languages [@opensees] have been powering the web for a long time. The most widely used ones are not used for geospatial data processing, for example PHP [@zhao2012hiphop]. We know that Python is also a scripting language and there is Flask [@grinberg2018flask] enabling web applications in Python. 44 | 45 | The statistical programming language R [@rcore] is a widely used language for data science and, with packages such as `sf` enabling geocomputation. 46 | Data scientists who use R and want to deploy their applications often wonder: how can I use R to deploy on the web? 47 | 48 | \newpage 49 | 50 | We found out that there had already been some work in this regard, inspired the Python package Flask, called `plumber` [@plumber]. After preliminary checks and checking the codebase, we decided that we could use `plumber` to power the project. 51 | 52 | ## Approach: Combining technologies for data science and the web 53 | 54 | Facebook developed ReactJS [@fedosejev2015react]. The approach is designed for scalability and rapid front end development [@gackenheimer2015introducing]. These advantages, plus prior experience with React, explain our choice of frontend framework, to be combined with `plumber` in the backend. 55 | After developing an ad-hock web app based on this approach, we found there were advantages of generalising the approach. The R packaging system makes the approach accessible to other data scientists wanting a flexible, scalable yet lightweight front-end for their R applications, and encourages testing and feedback. 56 | `geoplumber`, which can be installed with the following command, was born. 57 | 58 | ### Geospatial web applications 59 | 60 | JavaScript has a rich set of frontend web mapping technologies, including LeafletJS and Mapbox JS. Since the emergence of WebGL, the possibilities for creating "web application frameworks" for displaying large geospatial datasets, have increased greatly. 61 | 62 | The package is a combination of above technologies which are loosely coupled and could be used for non-geospatial purposes. This loose coupling is done with attention, making it accessible to developers who already use ReactJS tools, without needing to engage with the R ecosystem. 63 | `geoplumber` is compatible with the `npm` (Node Package Manager), and uses the Create-React-App (CRA) [@banks2017learning] NodeJS package for deployment. 64 | 65 | ### Interactive data analysis 66 | 67 | A focus of `geoplumber` is interactive data analysis. 68 | The package includes functions to support such tasks as adding React or generic JS code to a web application, taking advantage of React's modular design. 69 | The result is a "framework" where node packages can be defined for use in the frontend and data can be served from a flexible R-based backend. 70 | 71 | ### Use case: a web app for visualising road traffic casualties 72 | 73 | A geoplumber app, as it stands, is a standard `npm` package generated by CRA. For the API, an `R` directory containing a `plumber.R` file is added, which is used by the underlying `plumber` package. To create a `geoplumber` app: 74 | 75 | ```{r pkgs, echo=FALSE, eval=TRUE, results='hide'} 76 | packages = c("plumber", "clipr", "remotes", 77 | "dplyr", "geojsonsf") 78 | if (length(setdiff(packages, rownames(installed.packages()))) > 0) { 79 | install.packages(setdiff(packages, rownames(installed.packages())),repos='http://cran.us.r-project.org') 80 | remotes::install_github("ropensci/stats19") 81 | lapply(packages, library, character.only = TRUE) 82 | print(getwd()) 83 | } 84 | ``` 85 | ```{r gp_create, echo=TRUE, eval=TRUE} 86 | dir_name = file.path(tempdir(), "my_app") 87 | dir.create(dir_name) 88 | library(geoplumber) 89 | gp_create(dir_name) 90 | setwd(dir_name) 91 | gp_build() 92 | ``` 93 | 94 | The directory and files structure of a `geoplumber` applications looks like this: 95 | 96 | \newpage 97 | 98 | ```{r dir.structure, eval=FALSE} 99 | +- R/plumber.R # backend code 100 | +- README.md 101 | +- package.json # npm package file 102 | +- public # public facing docs 103 | +- src # frontend JS code. 104 | ``` 105 | 106 | We can then do all our data processing straight from R and serve the data using API end-points. `plumber` works by adding tags in front of standard R functions. Lets get some data using `stats19` package. 107 | 108 | ```{r get_stats19, echo=TRUE, results='hide', message=FALSE} 109 | library(stats19) 110 | accidents = stats19::get_stats19(year = 2017, ask = FALSE) 111 | accidents = dplyr::sample_n(accidents, 500) 112 | accidents = stats19::format_sf(accidents, lonlat = TRUE) 113 | ``` 114 | 115 | For example, to geneate an end-point that returns an R object which contains JSON data in a parameter called `accidents_geojson`, we could write a function like this and add into a `geoplumber` app's `R/plumber.R` file: 116 | 117 | ```{r gp_endpoint, eval=FALSE} 118 | #' @get /api/stats19 # 1 119 | all_geojson <- function(res){ # 2 120 | res$headers$`Content-type` = "application/json"# 3 121 | res$body <- accidents_geojson # 4 122 | res 123 | } 124 | # copy above, run 125 | # geoplumber::gp_endpoint_from_clip() 126 | # to add it into your geoplumber app 127 | ``` 128 | 129 | In the line with `# 1` comment above, the `@get` part means `/api/stats19` is going to be a HTTP GET path. The function has a `response` parameter which can be modified and returned. In this case, we set the response `content-type` and also load the body of the response object with the JSON object to be returned. Therefore, `@get /api/stats19`, translates into `http://localhost:8000/api/stats19` which would returns the `accidents_geojson` object. 130 | 131 | In this example, `stats19` [@lovelace_stats19_2019] R package is used for data acquisition and processing. Using `stats19` we can get the crashes for years since 1979 from DfT (Department for Transport, United Kingdom). There are functions in `geoplumber` to work on the development and finally deploy our application. A screen shot of an example is shown in Table 1. 132 | 133 | Frontend view | The API serving the data 134 | :-------------------------:|:-------------------------: 135 | \includegraphics[width=200pt]{geoplumber2.png} | \includegraphics[width=200pt]{geoplumber3.png} 136 | Table 1: A geoplumber app for road casualty data. On the left, customised frontend uses Uber's DeckGL (React). On the right the same data served from `/api/stats19` end-point in R. 137 | 138 | We can also interactively see the `accidents` object and choose a column to filter using the API from the front-end: 139 | 140 | ```{r gp_sf2, eval=FALSE} 141 | geoplumber::gp_sf(accidents, 142 | props_list = 143 | list(accident_severity = unique(accidents$accident_severity))) 144 | ``` 145 | 146 | If you then visit `http://localhost:8000` on your broswer, it should give you something like Figure 2. 147 | 148 | ```{r geoplumber, echo=FALSE, fig.cap="STATS19 sample 500 points across the UK for year 2017. With an interactive dropdown querying R code subsetting the 500 sample dataset.", out.width = '100%'} 149 | knitr::include_graphics("geoplumber4.png") 150 | ``` 151 | 152 | ## Geospatial Databases 153 | 154 | Although currently the work in progress repository^[See: https://github.com/ATFutures/geoplumber] does not include one, it is possible to add a database of choice to the stack. Due to the light weight Flask/plumber type of API frameworks, it is possible to make use of the full potential of R language. For example, to connect to a MySQL database running on a Linux machine, with username and password defined at the users `~/.my.cnf` file as per MySQL convenctions. We can then create API end-points that can connect to a MySQL instance with a `geoplumber` schema defined in it, using `RMySQL` and `DBI` packages as follows: 155 | 156 | ```{r, eval=FALSE} 157 | con <- DBI::dbConnect(RMySQL::MySQL(), group = "my-db") 158 | # we can send SQL queries such as selecting a schema 159 | DBI::dbGetQuery(conn = con, "use geoplumber;") 160 | #> data frame with 0 columns and 0 rows 161 | DBI::dbListTables(con) 162 | #> character(0) 163 | ``` 164 | Add the output of the above into another end-point: 165 | ```{r, eval=FALSE} 166 | #' @get /api/tables 167 | tables = function(res){ 168 | # ... 169 | res$body <- tables_list_geojson 170 | # ... 171 | } 172 | ``` 173 | 174 | ## Deployment 175 | 176 | Standard deployment documentation^[See https://www.rplumber.io/docs/hosting.html] for `plumber` application is provided by the developers. In our small scale deployment experience, we have deployed two separate geoplumber apps using Docker virtualization technology, using reverse proxy from a standard Nginx HTTP server. The Dockerfile and other deployment details are available on a GitHub repository^[See https://github.com/ATFutures/activeTransportToolbox]. 177 | 178 | ## Acknowldgements 179 | 180 | The work carried out is funded by Consumer Data Resarch Center (CDRC) at Leeds Institute for Data Analytics (LIDA) at University of Leeds. The open source ecosystem enables projects like Linux and can benefit geoplumber immensely. The GitHub repository on GitHub^[See https://github.com/ATFutures/geoplumber] lists all contributors to the package and interested parties are invited to collaborate further. 181 | 182 | ## References 183 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # geoplumber · [![Build Status](https://travis-ci.org/ATFutures/geoplumber.svg)](https://travis-ci.org/ATFutures/geoplumber) [![codecov](https://codecov.io/gh/ATFutures/geoplumber/branch/master/graph/badge.svg)](https://codecov.io/gh/ATFutures/geoplumber) [![Project Status: Inactive](https://www.repostatus.org/badges/latest/inactive.svg)](https://www.repostatus.org/#wip) [![PRs Welcome](https://img.shields.io/badge/PRs-welcome-brightgreen.svg)](#) 3 | 4 | 5 | 6 | geoplumber is an R package which enables data scientists and developers 7 | in general to develop scalable geospatial web applications. It is work 8 | in progress, and right now we consider it an R powered web application 9 | “framework”. It utilizes 10 | [`plumber`](https://github.com/trestletech/plumber), which was designed 11 | for creating web APIs with R which is Swagger compliant. It supports 12 | [React](https://reactjs.org/) frontends at present (it may support other 13 | frontend frameworks such as VueJS in the future) and geographic data, 14 | building on [`sf`](https://github.com/r-spatial/sf). 15 | 16 | It can be installed with the following command as it is not yet on CRAN: 17 | 18 | ``` r 19 | devtools::install_github("ATFutures/geoplumber") 20 | #> the latest dev version 21 | ``` 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | ## Usage 30 | 31 | - For more detailed introduction see the 32 | [vignette](https://atfutures.github.io/geoplumber/articles/geoplumber.html) 33 | 34 | To create a new web application: 35 | 36 | ``` r 37 | library(geoplumber) 38 | gp_create("my_app") 39 | ``` 40 | 41 | This will create a `my_app` folder at your current working directory. 42 | Suppose you started an R session from a folder with path 43 | `/Users/ruser/`, you will have `/Users/ruser/my_app` on your machine. 44 | 45 | You can then build the new project 46 | 47 | ``` r 48 | setwd("my_app") 49 | gp_build() # the front end and create minified js files. 50 | ``` 51 | 52 | You can then serve endpoints and front end with: `gp_plumb()` \# provide 53 | custom port if you wish, default is 8000 54 | 55 | Then visit `localhost:8000` to see your app. 56 | 57 | ## Example (1) reproducible web app 58 | 59 | ``` r 60 | library(geoplumber) 61 | d <- file.path(tempdir(), "gp") 62 | gp_create(d) 63 | #> Creating directory: /var/folders/z7/l4z5fwqs2ksfv22ghh2n9smh0000gp/T//Rtmpee0Wxd/gp 64 | #> To build/run app, set working directory to: /var/folders/z7/l4z5fwqs2ksfv22ghh2n9smh0000gp/T//Rtmpee0Wxd/gp 65 | #> Standard output from create-react-app works. 66 | #> You can run gp_ functions from directory: /var/folders/z7/l4z5fwqs2ksfv22ghh2n9smh0000gp/T//Rtmpee0Wxd/gp 67 | #> To build the front end run: gp_build() 68 | #> To run the geoplumber app: gp_plumb() 69 | #> Happy coding. 70 | setwd(d) 71 | ps <- gp_plumb() 72 | #> WARNING: 73 | #> Looks like geoplumber was not built, serveing API only. 74 | #> To serve the front end run gp_build() first. 75 | Sys.sleep(1) # needed on automated build machines :) 76 | ps 77 | #> PROCESS 'R', running, pid 24807. 78 | require(RCurl) 79 | #> Loading required package: RCurl 80 | webpage <- getURL("http://localhost:8000") 81 | webpage <- readLines(tc <- textConnection(webpage)); close(tc) 82 | tail(webpage) 83 | #> [1] "

build missing

" " " 84 | #> [3] "" "" 85 | #> [5] "" "" 86 | ps$kill() 87 | #> [1] TRUE 88 | # should fail 89 | # getURL("http://localhost:8000") 90 | ``` 91 | 92 | ## Example (2) 93 | 94 | Serve the `geoplumber::traffic` dataset (data.frame) at a “/api/data” 95 | endpoint, and view it on the front end. 96 | 97 | The `traffic` 98 | [dataset](https://data.cdrc.ac.uk/dataset/southwark-traffic-counts) is 99 | from CDRC at University of Leeds which is traffic data locations for the 100 | larger traffic dataset. 101 | 102 | To achive this copy the following endpoint/API to the clipboard of your 103 | machine. If you like to understand the function, you need to learn 104 | `plumber` package. 105 | 106 | ``` r 107 | #' Serve geoplumber::traffic from /api/data 108 | #' @get /api/data 109 | get_traffic <- function(res) { 110 | geojson <- geojsonsf::sf_geojson(geoplumber::traffic) 111 | res$body <- geojson 112 | res 113 | } 114 | ``` 115 | 116 | Then run (re-copied into clipboard just in case): 117 | 118 | ``` r 119 | setwd("my_app") 120 | old_clip <- clipr::read_clip() 121 | # adding above to clipboard 122 | clipr::write_clip(c( 123 | "#' Serve geoplumber::traffic from /api/data", 124 | "#' @get /api/data", 125 | "get_traffic <- function(res) {", 126 | " geojson <- geojsonsf::sf_geojson(geoplumber::traffic)", 127 | " res$body <- geojson", 128 | " res", 129 | "}" 130 | )) 131 | gp_endpoint_from_clip() 132 | clipr::write_clip(old_clip) 133 | ``` 134 | 135 | This has now added a new endpoint at: `/api/data`. To consume it, we can 136 | simply run: 137 | 138 | ``` r 139 | setwd("my_app") 140 | gp_add_geojson("/api/data") 141 | ``` 142 | 143 | You can now see the data by running: 144 | 145 | ``` r 146 | gp_build() # build changes 147 | gp_plumb() 148 | ``` 149 | 150 | Or in the following “export” function a basic `leaflet` map using the 151 | “headless” `gp_map` funciton: 152 | 153 |
154 | 155 | <a href='https://www.cdrc.ac.uk/'>CDRC</a> London traffic data on geoplumber 156 | 157 |

158 | 159 | CDRC London traffic data on 160 | geoplumber 161 | 162 |

163 | 164 |
165 | 166 | ``` r 167 | # cd into a geoplumber app 168 | setwd("my-app/") 169 | library(geoplumber) 170 | # view a dataset such as the `traffic` sf object bundled 171 | t <- gp_map(geoplumber::traffic, browse_map = FALSE, 172 | height = "320px", width = "90%") 173 | # use includeHTML for markdown 174 | htmltools::includeHTML(t) 175 | ``` 176 | 177 | You can also now see the raw JSON dataset at 178 | `http://localhost:8000/api/data`, and on a map on a browser view the map 179 | at `http://localhost:8000`. 180 | 181 | ## Example (3) 182 | 183 | We would like to see default University of Leeds `uni_poly` grow/shrink 184 | using `sf::st_buffer()` function. Here is a reproducible example (please 185 | take a look at the default `plumber.R` file in your `my_app` project): 186 | 187 | ``` r 188 | gp_create(tolower(tempdir())) 189 | setwd(tolower(tempdir())) 190 | gp_is_wd_geoplumber() 191 | gp_add_slider( 192 | min = 0.001, 193 | max = 0.01, 194 | step = 0.001 195 | ) 196 | gp_change_file( 197 | path = "src/Welcome.js", 198 | what = ' 199 | ', 200 | pattern = '', 201 | replace = TRUE, 202 | verbose = TRUE 203 | ) 204 | ``` 205 | 206 | Run the project (this time at `tempdir()` location) by: 207 | 208 | ``` r 209 | gp_build() # build changes 210 | r <- gp_plumb() # run in bg 211 | r¢kill() 212 | ``` 213 | 214 | Now you can see: 215 | 216 |
217 | 218 | geoplumber::uni_poly grow/shrinking using sf::st_buffer function on server side. 219 | 220 |

221 | 222 | geoplumber::uni\_poly grow/shrinking using sf::st\_buffer function on 223 | server side. 224 | 225 |

226 | 227 |
228 | 229 | ## geoplumber stack 230 | 231 | We have worked with Shiny and 232 | [`plumber`](https://github.com/trestletech/plumber/) and we consider 233 | ourselves experienced in ReactJS, too. In order to put together a web 234 | application powered at the backend with R and React at the front-end, 235 | there is a lot of setup and boilerplate to put together. This would be 236 | also correct for other front end stack such as Angular or VueJS. 237 | 238 | Currently geoplumber uses Facebook’s `create-react-app` (CRA) npm 239 | package to deal with underlying app management (including building and 240 | running) to keep you up to date with updates. `geoplumber` will 241 | generally provide detailed installation instructions for all required 242 | `npm` packages, but if not, the following are minimally required: 243 | 244 | sudo npm i -g create-react-app 245 | 246 | ### Front end 247 | 248 | Once the geoplumber app `my_app` has been created. It will have a 249 | `create-react-app` directory structure with an extra `R` folder to hold 250 | the backend R code. The React components, as they are in CRA apps, are 251 | in the `src` folder and ready to be customised and developed for your 252 | own purposes. So, a React developer could run `npm start` on the root 253 | directory and run the built in CRA development server which is what 254 | `gp_plumb_front()` does too. 255 | 256 | ### npm packages used 257 | 258 | The following are included by default, the versions are just from old 259 | .Rmd file. geoplumber updates these as the package is developed. Feel 260 | free to replace it with your own .json package definer as and when. 261 | 262 | ``` r 263 | knitr::kable(data) 264 | ``` 265 | 266 | | package | Usage | 267 | | :---------------------- | :---------------------------------- | 268 | | create-react-app | main package to manage front end | 269 | | prop-types | React propTypes | 270 | | react | React main | 271 | | react-dom | React DOM | 272 | | react-bootstrap | bootstrapZ | 273 | | leaflet | current default web mapping library | 274 | | react-leaflet | React wrapper around leaflet above | 275 | | react-leaflet-control | React map control | 276 | | react-router | React router (RR) | 277 | | react-router-dom | React dom for RR | 278 | | react-scripts | main package to manage front end | 279 | | react-test-renderer | test suite | 280 | | enzyme | test suite | 281 | | enzyme-adapter-react-16 | test suite adapter for React | 282 | | sinon | test suite | 283 | 284 | ## Showcase 285 | 286 | An example application is deployed at 287 | [www.geoplumber.com](www.geoplumber.com). It showcases some zone and 288 | flow data using both `LeafletJS` and `MapboxGL` both in React. The 289 | application is dockerised automating the production and deployment. 290 | 291 | ## End-points 292 | 293 | R package `plumber` comes with a default end-point for documenting the 294 | API using Swagger. This is also available from `geoplumber`’s 295 | `/__swagger__/` path. 296 | 297 | We follow a pattern of `/api/` before the end-points and without for 298 | other URL’s. A new web app will have `/api/helloworld` and you can 299 | `curl` it: 300 | 301 | ``` sh 302 | curl localhost:8000/api/helloworld 303 | #> {"msg":["The message is: 'nothing given'"]} 304 | ``` 305 | 306 | ## Tests 307 | 308 | Tests currently only apply to restricted components of full 309 | functionality. 310 | 311 | ``` r 312 | devtools::test() 313 | ``` 314 | 315 | ## Roadmap 316 | 317 | What I (Layik) think will work for a version 0.1 to hit CRAN is 318 | geoplumber would be able to have: 319 | 320 | - basic structure of a R + React app running 321 | - basics of a production environment via Docker 322 | -------------------------------------------------------------------------------- /inst/geoplumber.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | geoplumber | output 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 31 | 32 | 33 | 34 |
35 | 299 | 300 | 301 | -------------------------------------------------------------------------------- /vignettes/gisruk.bib: -------------------------------------------------------------------------------- 1 | @incollection{gackenheimer2015introducing, 2 | title={Introducing flux: An application architecture for react}, 3 | author={Gackenheimer, Cory}, 4 | booktitle={Introduction to React}, 5 | pages={87--106}, 6 | year={2015}, 7 | publisher={Springer} 8 | } 9 | @misc{rstudio2015integrated, 10 | title={Integrated Development for R. RStudio, Inc., Boston, MA}, 11 | author={RStudio, RStudio Team}, 12 | year={2015} 13 | } 14 | @article{rcore, 15 | title = {R: {{A Language}} and {{Environment}} for {{Statistical Computing}}}, 16 | author = {{R Core Team}}, 17 | year = {2019}, 18 | organization = {{R Foundation for Statistical Computing}}, 19 | location = {Vienna, Austria} 20 | } 21 | @book{nedelcu2010nginx, 22 | title={Nginx HTTP Server: Adopt Nginx for Your Web Applications to Make the Most of Your Infrastructure and Serve Pages Faster Than Ever}, 23 | author={Nedelcu, Cl{\'e}ment}, 24 | year={2010}, 25 | publisher={Packt Publishing Ltd}, 26 | note = {Ch. 7} 27 | } 28 | @article{ooms2014opencpu, 29 | title={The OpenCPU system: Towards a universal interface for scientific computing through separation of concerns}, 30 | author={Ooms, Jeroen}, 31 | journal={arXiv preprint arXiv:1406.4806}, 32 | year={2014} 33 | } 34 | @book{banks2017learning, 35 | title={Learning React: Functional Web Development with React and Redux}, 36 | author={Banks, Alex and Porcello, Eve}, 37 | year={2017}, 38 | publisher={" O'Reilly Media, Inc."}, 39 | note = {pg. 107} 40 | } 41 | @book{beeley2016web, 42 | title={Web application development with R using Shiny}, 43 | author={Beeley, Chris}, 44 | year={2016}, 45 | publisher={Packt Publishing Ltd} 46 | } 47 | @article{lovelace_stats19_2019, 48 | title = {Stats19: {{A}} Package for Working with Open Road Crash Data}, 49 | doi = {10.21105/joss.01181}, 50 | journal = {Journal of Open Source Software}, 51 | author = {Lovelace, Robin and Lovelace, R and Morgan, M and Hama, L and Padgham, M}, 52 | year = {2019} 53 | } 54 | @article{farkas2017applicability, 55 | title={Applicability of open-source web mapping libraries for building massive Web GIS clients}, 56 | author={Farkas, G{\'a}bor}, 57 | journal={Journal of Geographical Systems}, 58 | volume={19}, 59 | number={3}, 60 | pages={273--295}, 61 | year={2017}, 62 | publisher={Springer} 63 | } 64 | @book{fedosejev2015react, 65 | title={React. js Essentials}, 66 | author={Fedosejev, Artemij}, 67 | year={2015}, 68 | publisher={Packt Publishing Ltd} 69 | } 70 | @inproceedings{zhao2012hiphop, 71 | title={The HipHop compiler for PHP}, 72 | author={Zhao, Haiping and Proctor, Iain and Yang, Minghui and Qi, Xin and Williams, Mark and Gao, Qi and Ottoni, Guilherme and Paroski, Andrew and MacVicar, Scott and Evans, Jason and others}, 73 | booktitle={ACM SIGPLAN Notices}, 74 | volume={47}, 75 | number={10}, 76 | pages={575--586}, 77 | year={2012}, 78 | organization={ACM} 79 | } 80 | @book{gilmore2007, 81 | title={Beginning PHP and Oracle: from novice to professional}, 82 | author={Gilmore, W Jason and Bryla, Bob}, 83 | year={2007}, 84 | publisher={Apress} 85 | } 86 | @book{grinberg2018flask, 87 | title={Flask web development: developing web applications with python}, 88 | author={Grinberg, Miguel}, 89 | year={2018}, 90 | publisher={" O'Reilly Media, Inc."} 91 | } 92 | @article{opensees, 93 | title={OpenSees command language manual}, 94 | author={Mazzoni, Silvia and McKenna, Frank and Scott, Michael H and Fenves, Gregory L and others}, 95 | journal={Pacific Earthquake Engineering Research (PEER) Center}, 96 | volume={264}, 97 | year={2006} 98 | }= 99 | @software{plumber, 100 | author = {{Trestle Technology, LLC}}, 101 | title = {plumber: An API generator for R}, 102 | url = {https://cran.r-project.org/web/packages/plumber/index.html}, 103 | version = {0.4.6}, 104 | date = {2018-06-05}, 105 | } 106 | @software{httpuv, 107 | author = {Joe Cheng, Hector Corrada Bravo, Jeroen Ooms, Winston Chang}, 108 | title = {httpuv: HTTP and WebSocket Server Library}, 109 | url = {https://cran.r-project.org/web/packages/httpuv/index.html}, 110 | version = {1.4.5.1}, 111 | date = {2018-12-18}, 112 | } 113 | @Article{lovelace_who_2016, 114 | series = {Bicycling and bicycle safety}, 115 | title = {Who, Where, When: The Demographic and Geographic Distribution of Bicycle Crashes in {{West Yorkshire}}}, 116 | volume = {41, Part B}, 117 | issn = {13698478}, 118 | doi = {10.1016/j.trf.2015.02.010}, 119 | journal = {Transportation Research Part F: Traffic Psychology and Behaviour}, 120 | author = {Robin Lovelace and Hannah Roberts and Ian Kellar}, 121 | year = {2016}, 122 | keywords = {Risk,geographical factors,corresponding author,risk,s institution,first author,university of sheffield,Cycling,safety,msc,robin lovelace,mr,exposure,Safety,Exposure,Geographical factors}, 123 | file = {/home/robin/Zotero/storage/GDJH6AUM/S136984781500039X.html;/home/robin/Zotero/storage/XC7A9MA2/S136984781500039X.html}, 124 | } 125 | 126 | @Article{edwards_relationship_1998, 127 | title = {The {{Relationship Between Road Accident Severity}} and {{Recorded Weather}}}, 128 | volume = {29}, 129 | issn = {0022-4375}, 130 | doi = {10.1016/S0022-4375(98)00051-6}, 131 | abstract = {Road accident severity may be influenced by a number of factors. This article investigates the relationship between weather and road accidents in England and Wales. The weather information recorded on Police Accident Report Forms was taken as the prevailing weather at the time of the accident. At the local authority level, accident severity for the various adverse weather categories of rain, fog, and high winds is compared with the nonhazardous condition of fine weather. Severity ratios are then calculated. Findings establish that accident severity decreases significantly in rain compared with fine weather, while severity in fog shows geographical variation. Evidence for accident severity in high winds remains inconclusive.}, 132 | number = {4}, 133 | journal = {Journal of Safety Research}, 134 | author = {Julia B Edwards}, 135 | month = {dec}, 136 | year = {1998}, 137 | keywords = {Accident severity,fog,high winds,rain,weather}, 138 | pages = {249-262}, 139 | file = {/home/robin/Zotero/storage/R6ICNAUZ/S0022437598000516.html}, 140 | } 141 | 142 | @Article{grundy_effect_2009, 143 | title = {Effect of 20 Mph Traffic Speed Zones on Road Injuries in {{London}}, 1986-2006: Controlled Interrupted Time Series Analysis}, 144 | volume = {339}, 145 | copyright = {\textcopyright{} Grundy et al 2009. This is an open-access article distributed under the terms of the Creative Commons Attribution Non-commercial License, which permits use, distribution, and reproduction in any medium, provided the original work is properly cited, the use is non commercial and is otherwise in compliance with the license. See: http://creativecommons.org/licenses/by-nc/2.0/ and http://creativecommons.org/licenses/by-nc/2.0/legalcode.}, 146 | issn = {0959-8138, 1468-5833}, 147 | shorttitle = {Effect of 20 Mph Traffic Speed Zones on Road Injuries in {{London}}, 1986-2006}, 148 | doi = {10.1136/bmj.b4469}, 149 | abstract = {$<$p$>$\textbf{Objective} To quantify the effect of the introduction of 20 mph (32 km an hour) traffic speed zones on road collisions, injuries, and fatalities in London.$<$/p$><$p$>$\textbf{Design} Observational study based on analysis of geographically coded police data on road casualties, 1986-2006. Analyses were made of longitudinal changes in counts of road injuries within each of 119 029 road segments with at least one casualty with conditional fixed effects Poisson models. Estimates of the effect of introducing 20 mph zones on casualties within those zones and in adjacent areas were adjusted for the underlying downward trend in traffic casualties.$<$/p$><$p$>$\textbf{Setting} London.$<$/p$><$p$>$\textbf{Main outcome measures} All casualties from road collisions; those killed and seriously injured (KSI).$<$/p$><$p$>$\textbf{Results} The introduction of 20 mph zones was associated with a 41.9\% (95\% confidence interval 36.0\% to 47.8\%) reduction in road casualties, after adjustment for underlying time trends. The percentage reduction was greatest in younger children and greater for the category of killed or seriously injured casualties than for minor injuries. There was no evidence of casualty migration to areas adjacent to 20 mph zones, where casualties also fell slightly by an average of 8.0\% (4.4\% to 11.5\%).$<$/p$><$p$>$\textbf{Conclusions }20 mph zones are effective measures for reducing road injuries and deaths.$<$/p$>$}, 150 | language = {en}, 151 | journal = {BMJ}, 152 | author = {Chris Grundy and Rebecca Steinbach and Phil Edwards and Judith Green and Ben Armstrong and Paul Wilkinson}, 153 | month = {dec}, 154 | year = {2009}, 155 | pages = {b4469}, 156 | file = {/home/robin/Zotero/storage/MFRGUFTA/Grundy et al. - 2009 - Effect of 20 mph traffic speed zones on road injur.pdf;/home/robin/Zotero/storage/UJV6CYNA/bmj.b4469.full.html}, 157 | pmid = {20007666}, 158 | } 159 | 160 | @Article{sarkar_street_2018, 161 | title = {Street Morphology and Severity of Road Casualties: {{A}} 5-Year Study of {{Greater London}}}, 162 | volume = {12}, 163 | issn = {1556-8318}, 164 | shorttitle = {Street Morphology and Severity of Road Casualties}, 165 | doi = {10.1080/15568318.2017.1402972}, 166 | abstract = {Built environment factors, especially street-scale design and traffic casualties, are intrinsically interlinked. Starting from Alker Tripp's seminal ideas about city design, street morphology, and accident risk, this article summarizes results from an increasingly sophisticated line of enquiry at the boundaries between transport geography, network modeling, urban geography, and planning. It goes on to specify what we believe to be the most comprehensive study yet, based on five years' worth of road casualty data from London; GIS data on street morphology and physical features captured at a street-link unit of analysis; socio-economics and other determinants of accidents; and individual data about casualty victims. We test hypotheses about links between urban morphology and casualty severity using multi-level models with individual victim attributes at level-one, street-link morphology attributes (various measure of network connectivity) at level-two, and neighborhood descriptors at level-three.Results indicate that street-level morphology and design (expressed in terms of betweenness, divergence ratio, and hull radius), together with traffic volume and physical features of streets are all significantly associated with odds of ``Killed and Seriously Injured'' (KSI) causality incidents. We find the strongest evidence yet recorded that London's 20-MPH speed-restricted residential zones reduce the incidence of KSI; while neighborhood-level factors such as population density, deprivation of living environment, and access to services are also significant predictors of KSI indicating that selective urban territorial enclosure can save lives.}, 167 | number = {7}, 168 | journal = {International Journal of Sustainable Transportation}, 169 | author = {Chinmoy Sarkar and Chris Webster and Sarika Kumari}, 170 | month = {aug}, 171 | year = {2018}, 172 | keywords = {KSI,morphometrics,multilevel,STATS19,Traffic casualty severity,urban design}, 173 | pages = {510-525}, 174 | file = {/home/robin/Zotero/storage/CKF3JGXX/Sarkar et al. - 2018 - Street morphology and severity of road casualties.pdf;/home/robin/Zotero/storage/FNTF9I3H/15568318.2017.html}, 175 | } 176 | 177 | @article{feleke_comparative_2018, 178 | title = {Comparative Fatality Risk for Different Travel Modes by Age, Sex, and Deprivation}, 179 | volume = {8}, 180 | issn = {22141405}, 181 | doi = {10.1016/j.jth.2017.08.007}, 182 | abstract = {Background: Cycling is perceived as an unsafe travel mode in many countries. However, road deaths in England have fallen sharply since 2007. We explored whether differences in fatality rates by age, gender and mode persist, and the associations of deprivation with these. Methods: Using ONS (cycling, pedestrian) and Stats19 (driving) 2007\textendash{}2012 data for travel-related deaths, including pedestrian falls, and National Travel Surveys 2007\textendash{}2012 travel data, we calculated fatality rates for England by distance (f/bnkm) and time travelled (million hours' use, f/mhu) by age, travel mode, and gender or residential Index of Multiple Deprivation. Results: Fatality rates fell significantly 2007\textendash{}2009 to 2010\textendash{}2012: male f/bnkm from 2.8 (95\%CI 2.7\textendash{}2.9) to 2.0 (1.9\textendash{}2.1) for driving; 32.1 (28.5\textendash{}36.0) to 20.8 (18.1\textendash{}23.9) for cycling; and 51.4 (48.5\textendash{}54.4) to 36.7 (34.3\textendash{}39.3) for walking. Fatality rates varied by age, gender, and mode. Driving and walking fatality rate ratios were generally higher for males than females. For males 17\textendash{}20y, fatality rates were 0.76 (0.69\textendash{}0.83)/mhu for driving and 0.28 (0.18\textendash{}0.42)/mhu for cycling but were similar by distance. Age-specific rates were J-shape for cycling, U-shape for driving, and increased exponentially with age for walking. Fatality rates aged 80+ were an order of magnitude higher in each mode than the all-age mean. Compared with those aged 17\textendash{}20, rate ratios were significantly lower for male drivers 21+ and female drivers 21\textendash{}74, but were higher for male cyclists aged 55+ and pedestrians 45+ (male) and 65+ (female). People living in the most deprived quintile generally had higher fatality rates than those in the least deprived quintile overall (three modes combined) and for walking but not for cycling; Rate ratios were highest for pedestrians 35\textendash{}64 and drivers 35\textendash{}54. Conclusions: Fatality rates for walking, cycling and driving are higher for males than females at almost every age and vary more by age than by travel mode. Deprivation exacerbates walking and driving fatality rates.}, 183 | language = {English}, 184 | journal = {Journal of Transport \& Health}, 185 | author = {Feleke, Robel and Scholes, Shaun and Wardlaw, Malcolm and Mindell, Jennifer S.}, 186 | month = mar, 187 | year = {2018}, 188 | pages = {307-320}, 189 | file = {/home/robin/Zotero/storage/5VD6FC5Z/S2214140517301457.html} 190 | } 191 | 192 | @book{elvik_handbook_2009, 193 | title = {The Handbook of Road Safety Measures}, 194 | publisher = {{Emerald Group Publishing}}, 195 | author = {Elvik, Rune and Vaa, Truls and Erke, Alena and Sorensen, Michael}, 196 | year = {2009}, 197 | file = {/home/robin/Zotero/storage/4F7KDLLY/Elvik et al. - 2009 - The handbook of road safety measures.pdf;/home/robin/Zotero/storage/ABXBEI7Y/books.html} 198 | } 199 | --------------------------------------------------------------------------------