├── DataIn.R ├── DataIn.RData ├── MakeLandcover.R ├── MakeMask.R ├── MakeStreets.R ├── README.md ├── ScrapeWeb.R ├── SpatInt_Jan22.R ├── buildings.RData ├── landcover.RData ├── mask.RData ├── streets.RData └── zill.RData /DataIn.R: -------------------------------------------------------------------------------- 1 | ##### Development Script ##### 2 | ##### Lex Comber ##### 3 | ##### January 2018 ##### 4 | 5 | #### -1. Check and load packages 6 | if (!is.element("pycno", installed.packages())) 7 | install.packages("pycno", dep = T) 8 | if (!is.element("tmap", installed.packages())) 9 | install.packages("tmap", dep = T) 10 | if (!is.element("GISTools", installed.packages())) 11 | install.packages("GISTools", dep = T) 12 | if (!is.element("sf", installed.packages())) 13 | install.packages("sf", dep = T) 14 | if (!is.element("gstat", installed.packages())) 15 | install.packages("gstat", dep = T) 16 | if (!is.element("grid", installed.packages())) 17 | install.packages("grid", dep = T) 18 | if (!is.element("osmdata", installed.packages())) 19 | install.packages("osmdata", dep = T) 20 | if (!is.element("reshape2", installed.packages())) 21 | install.packages("rgdal", dep = T) 22 | if (!is.element("rgdal", installed.packages())) 23 | install.packages("reshape2", dep = T) 24 | if (!is.element("OpenStreetMap", installed.packages())) 25 | install.packages("OpenStreetMap", dep = T) 26 | # load packages into the R session 27 | library(pycno) 28 | library(tmap) 29 | library(GISTools) 30 | library(sf) 31 | library(gstat) 32 | library(grid) 33 | library(osmdata) 34 | library(reshape2) 35 | library(rgdal) 36 | library(OpenStreetMap) 37 | 38 | #### 0. Load and set up data 39 | data(newhaven) 40 | 41 | # Source Zones sz 42 | sz <- tracts 43 | proj4string(sz) <- CRS(proj4string(blocks)) 44 | sz$SID <- as.numeric(rownames(sz@data))+1 45 | rownames(sz@data) <- sz$SID 46 | sz <- sz[, c("SID", "HSE_UNITS")] 47 | .proj <- CRS("+proj=lcc +lat_1=41.86666666666667 +lat_2=41.2 +lat_0=40.83333333333334 +lon_0=-72.75 +x_0=304800.6096 +y_0=152400.3048 +ellps=GRS80 +units=m +no_defs ") 48 | sz <- spTransform(sz, .proj) 49 | 50 | # Target Zones tz 51 | bb <- bbox(sz) 52 | fac = 500 53 | grd <- GridTopology(cellcentre.offset= 54 | c(bb[1,1]+(fac/2),bb[2,1]+(fac/2)), 55 | cellsize=c(fac,fac), cells.dim = c(25,25)) 56 | tz <- SpatialPolygonsDataFrame( 57 | as.SpatialPolygons.GridTopology(grd), 58 | data = data.frame(c(1:(25^2))), match.ID = FALSE) 59 | proj4string(tz) <- .proj 60 | names(tz) <- "TID" 61 | # plot to check 62 | #plot(tz) 63 | #plot(sz, add = T) 64 | # convert to SF 65 | sz_sf <- st_as_sf(sz) 66 | tz_sf <- st_as_sf(tz) 67 | sz_sf <- st_transform(sz_sf, crs = 2775) 68 | tz_sf <- st_transform(tz_sf, crs = 2775) 69 | # subset 70 | tz_sf <- tz_sf[sz_sf, ] 71 | 72 | # trim the grid with pycno (to ensure all analyses have the same TZs) 73 | tz_sp <- as(tz_sf,"Spatial") 74 | sz_sp <- as(sz_sf,"Spatial") 75 | tz_sp2 <- SpatialPoints(tz_sp) 76 | tz_sp2 <- as(tz_sp2, "SpatialPixels") 77 | tz_sp2 <- as(tz_sp2, "SpatialGrid") 78 | # do quick pycno 79 | py_res <- pycno(x = sz_sp, pops = sz_sp$HSE_UNITS, celldim = tz_sp2, r = 0.1, 5) 80 | py_res <- as(py_res, "SpatialPolygonsDataFrame") 81 | tz_sf <- st_as_sf(py_res) 82 | # renumber the intersect layer 83 | tz_sf$TID <- 1:nrow(tz_sf) 84 | tz_sf <- tz_sf[, "TID"] 85 | rownames(tz_sf) <- tz_sf$TID 86 | # plot to check 87 | #tmap_mode("view") 88 | tmap_mode("plot") 89 | data.p <- tm_shape(sz_sf) + tm_polygons("HSE_UNITS", palette = "YlGnBu", 90 | style = "kmeans", n = 9, title = "Houses Tracts") + 91 | tm_layout(frame = F, legend.show = T) + 92 | tm_shape(tz_sf) + tm_borders() + 93 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2) 94 | data.p 95 | 96 | # save 97 | # sz_sf transformed source zones in sf format 98 | # tz_sf transformed target zones in sf format 99 | # setwd("/Users/geoaco/Desktop/my_docs_mac/leeds_work/research/wen/reviewanal") 100 | # save.image(file = "part0.rda") 101 | save(list = c("tz_sf", "sz_sf", ".proj"), file = "DataIn.RData") 102 | ##### END ##### 103 | -------------------------------------------------------------------------------- /DataIn.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/DataIn.RData -------------------------------------------------------------------------------- /MakeLandcover.R: -------------------------------------------------------------------------------- 1 | ##### Development Script ##### 2 | ##### Lex Comber ##### 3 | ##### January 2018 ##### 4 | 5 | #### -1. Check and load packages 6 | if (!is.element("pycno", installed.packages())) 7 | install.packages("pycno", dep = T) 8 | if (!is.element("tmap", installed.packages())) 9 | install.packages("tmap", dep = T) 10 | if (!is.element("GISTools", installed.packages())) 11 | install.packages("GISTools", dep = T) 12 | if (!is.element("sf", installed.packages())) 13 | install.packages("sf", dep = T) 14 | if (!is.element("gstat", installed.packages())) 15 | install.packages("gstat", dep = T) 16 | if (!is.element("grid", installed.packages())) 17 | install.packages("grid", dep = T) 18 | if (!is.element("osmdata", installed.packages())) 19 | install.packages("osmdata", dep = T) 20 | if (!is.element("reshape2", installed.packages())) 21 | install.packages("rgdal", dep = T) 22 | if (!is.element("rgdal", installed.packages())) 23 | install.packages("reshape2", dep = T) 24 | if (!is.element("OpenStreetMap", installed.packages())) 25 | install.packages("OpenStreetMap", dep = T) 26 | if (!is.element("repmis", installed.packages())) 27 | install.packages("repmis", dep = T) 28 | # load packages into the R session 29 | library(pycno) 30 | library(tmap) 31 | library(GISTools) 32 | library(sf) 33 | library(gstat) 34 | library(grid) 35 | library(osmdata) 36 | library(reshape2) 37 | library(rgdal) 38 | library(OpenStreetMap) 39 | library(repmis) 40 | 41 | #### load target zones, source zones and projection 42 | source_data("https://github.com/lexcomber/SpatInt/blob/master/DataIn.RData?raw=True") 43 | #### Prepapre land cover data 44 | # USGS NLCD downlaoded from https://www.usgs.gov/core-science-systems/ngp/tnm-delivery/ 45 | # classes desceibed here https://www.mrlc.gov/sites/default/files/metadata/landcover.html 46 | # load data 47 | setwd("/Users/geoaco/Desktop/my_docs_mac/leeds_work/research/wen/reviewanal") 48 | lc.orig <- readGDAL("nlcd/NLCD2011_LC_Connecticut.tif") 49 | # convert to points 50 | lc <- as(lc.orig, "SpatialPointsDataFrame") 51 | lc <- spTransform(lc, .proj) 52 | summary(lc) 53 | # load labels 54 | lc_labels <- read.csv("lc_class.csv") 55 | lc_labels[,1:2] 56 | table(lc$band1) 57 | head(lc@data) 58 | # link data to class labels 59 | index <- match(lc$band1, lc_labels$LC_class) 60 | lc$label <- lc_labels$Label[index] 61 | 62 | # overlay Land cover points to SZ (in sp format) 63 | lc_sz <- lc[as(sz_sf, "Spatial"), ] 64 | ol <- SpatialPoints(coordinates(lc_sz),proj4string=.proj) %over% as(sz_sf,"Spatial") 65 | summary(ol) 66 | lc_sz$SID <- ol$SID 67 | head(lc_sz@data) 68 | lc_sz$count <- 1 69 | # overlay points to TZ 70 | lc_tz <- lc[as(tz_sf, "Spatial"), ] 71 | 72 | # save 73 | save(list = c("lc_sz", "lc_tz"), file = "landcover.RData") 74 | -------------------------------------------------------------------------------- /MakeMask.R: -------------------------------------------------------------------------------- 1 | ##### Development Script ##### 2 | ##### Lex Comber ##### 3 | ##### January 2018 ##### 4 | 5 | #### -1. Check and load packages 6 | if (!is.element("pycno", installed.packages())) 7 | install.packages("pycno", dep = T) 8 | if (!is.element("tmap", installed.packages())) 9 | install.packages("tmap", dep = T) 10 | if (!is.element("GISTools", installed.packages())) 11 | install.packages("GISTools", dep = T) 12 | if (!is.element("sf", installed.packages())) 13 | install.packages("sf", dep = T) 14 | if (!is.element("gstat", installed.packages())) 15 | install.packages("gstat", dep = T) 16 | if (!is.element("grid", installed.packages())) 17 | install.packages("grid", dep = T) 18 | if (!is.element("osmdata", installed.packages())) 19 | install.packages("osmdata", dep = T) 20 | if (!is.element("reshape2", installed.packages())) 21 | install.packages("rgdal", dep = T) 22 | if (!is.element("rgdal", installed.packages())) 23 | install.packages("reshape2", dep = T) 24 | if (!is.element("OpenStreetMap", installed.packages())) 25 | install.packages("OpenStreetMap", dep = T) 26 | if (!is.element("repmis", installed.packages())) 27 | install.packages("repmis", dep = T) 28 | # load packages into the R session 29 | library(pycno) 30 | library(tmap) 31 | library(GISTools) 32 | library(sf) 33 | library(gstat) 34 | library(grid) 35 | library(osmdata) 36 | library(reshape2) 37 | library(rgdal) 38 | library(OpenStreetMap) 39 | library(repmis) 40 | 41 | ## Mask for Dasymtric 42 | 43 | ## Parks data from here: https://data.ct.gov/Government/City-of-New-Haven-Offices/724p-h6p6 44 | library(rgdal) 45 | parks <- readOGR("City of New Haven Parks/geo_export_6cc83356-382c-43d7-a044-9f4770e0ff05.shp") 46 | parks <- parks[, "category"] 47 | parks <- st_as_sf(parks) 48 | parks <- st_transform(parks, 4326) 49 | 50 | ## Use OpenStreetMap to get data 51 | # from https://cran.r-project.org/web/packages/osmdata/vignettes/osm-sf-translation.html 52 | #https://wiki.openstreetmap.org/wiki/Key:landuse 53 | ## 1. Landuse 54 | osm_sf <- opq ("New Haven, USA") %>% 55 | add_osm_feature ("landuse") %>% 56 | osmdata_sf 57 | # inspect the object that we have extracted 58 | #osm_sf 59 | #class(osm_sf$osm_polygons) 60 | #names(osm_sf$osm_polygons) 61 | #summary(osm_sf$osm_polygons) 62 | # get rid of the things we are not interested in 63 | index <- osm_sf$osm_polygons$landuse != "residential" 64 | index <- which(index) 65 | dasy.mask1 <- osm_sf$osm_polygons[index,"landuse"] 66 | names(dasy.mask1)[1] <- "category" 67 | ## 2. Education 68 | osm_sf <- opq ("New Haven, USA") %>% 69 | add_osm_feature ("amenity", "university") %>% 70 | osmdata_sf 71 | # inspect the object that we have extracted 72 | summary(osm_sf$osm_polygons) 73 | dasy.mask2 <- osm_sf$osm_polygons[, "amenity"] 74 | dasy.mask2$amenity <- "university" 75 | names(dasy.mask2)[1] <- "category" 76 | ## 3. Amenities 77 | osm_sf <- opq ("New Haven, USA") %>% 78 | add_osm_feature ("amenity", "college") %>% 79 | osmdata_sf 80 | summary(osm_sf$osm_polygons) 81 | dasy.mask3 <- osm_sf$osm_polygons[, "amenity"] 82 | dasy.mask3$amenity <- "college" 83 | names(dasy.mask3)[1] <- "category" 84 | # check 85 | #tmap_mode("view") 86 | #tm_shape(parks )+tm_polygons(col = "green", alpha = 0.5)+ 87 | #tm_shape(dasy.mask1 )+tm_polygons(col = "red", alpha = 0.5) + 88 | #tm_shape(dasy.mask2 )+tm_polygons(col = "blue", alpha = 0.5) 89 | # Join through union 90 | test <- st_union(dasy.mask1, parks) 91 | test <- st_union(test, dasy.mask2) 92 | test <- st_union(test, dasy.mask3) 93 | test%>% 94 | split(.$category) %>% 95 | lapply(st_union) %>% 96 | do.call(c, .) %>% # bind the list element to a single sfc 97 | st_cast() -> test 98 | t2 <- st_simplify(test, dTolerance = 0.000001) 99 | t2 <- st_buffer(test, dist = 0) 100 | t2 <- (st_sf(t2)) 101 | t2$SID <- 1:nrow(t2) 102 | t2 <- st_as_sf(t2) 103 | # write out 104 | st_write(t2, "dm.shp") 105 | # this was dissolved in qgis to create mask.shp 106 | 107 | ## 4. Coastline 108 | # now add coast 109 | osm_sf <- opq ("New Haven, USA") %>% 110 | add_osm_feature ("natural", "coastline") %>% 111 | osmdata_sf 112 | #class(osm_sf$osm_polygons) 113 | tm_shape(osm_sf$osm_lines)+tm_lines(lwd = 2) 114 | coast <- osm_sf$osm_lines 115 | # write out 116 | st_write(coast, "coast.shp") 117 | ## edited in QGIS and converted line to polygon 118 | 119 | ## 5. Join coast and mask together 120 | coast <- st_read("coast_pol.shp") 121 | mask <- st_read("mask.shp") 122 | # join 123 | test <- st_union(mask, coast) 124 | tm_shape(test)+tm_polygons("red") 125 | # save 126 | # st_write(test, "mask.shp") 127 | save("mask_sf", file = "mask.RData") 128 | -------------------------------------------------------------------------------- /MakeStreets.R: -------------------------------------------------------------------------------- 1 | ##### Development Script ##### 2 | ##### Lex Comber ##### 3 | ##### January 2018 ##### 4 | 5 | #### -1. Check and load packages 6 | if (!is.element("pycno", installed.packages())) 7 | install.packages("pycno", dep = T) 8 | if (!is.element("tmap", installed.packages())) 9 | install.packages("tmap", dep = T) 10 | if (!is.element("GISTools", installed.packages())) 11 | install.packages("GISTools", dep = T) 12 | if (!is.element("sf", installed.packages())) 13 | install.packages("sf", dep = T) 14 | if (!is.element("gstat", installed.packages())) 15 | install.packages("gstat", dep = T) 16 | if (!is.element("grid", installed.packages())) 17 | install.packages("grid", dep = T) 18 | if (!is.element("osmdata", installed.packages())) 19 | install.packages("osmdata", dep = T) 20 | if (!is.element("reshape2", installed.packages())) 21 | install.packages("rgdal", dep = T) 22 | if (!is.element("rgdal", installed.packages())) 23 | install.packages("reshape2", dep = T) 24 | if (!is.element("OpenStreetMap", installed.packages())) 25 | install.packages("OpenStreetMap", dep = T) 26 | if (!is.element("repmis", installed.packages())) 27 | install.packages("repmis", dep = T) 28 | # load packages into the R session 29 | library(pycno) 30 | library(tmap) 31 | library(GISTools) 32 | library(sf) 33 | library(gstat) 34 | library(grid) 35 | library(osmdata) 36 | library(reshape2) 37 | library(rgdal) 38 | library(OpenStreetMap) 39 | library(repmis) 40 | 41 | #### Create Street data 42 | # Use OpenStreetMap to get streets data 43 | # from https://cran.r-project.org/web/packages/osmdata/vignettes/osm-sf-translation.html 44 | #https://wiki.openstreetmap.org/wiki/Key:landuse 45 | osm_sf <- opq ("New Haven, USA") %>% 46 | add_osm_feature ("highway") %>% 47 | osmdata_sf 48 | streets <- osm_sf$osm_lines[, "highway"] 49 | # table(osm_sf$osm_lines$highway) 50 | # select streets of interest 51 | index <- streets$highway != "unclassified" & 52 | streets$highway != "pedestrian" & 53 | streets$highway != "footway" & 54 | streets$highway != "path" & 55 | streets$highway != "track" & 56 | streets$highway != "steps" & 57 | streets$highway != "cycleway" & 58 | streets$highway != "construction" & 59 | streets$highway != "service" & 60 | streets$highway != "motorway" & 61 | streets$highway != "motorway_link" & 62 | streets$highway != "platform" 63 | streets <- streets[index, ] 64 | streets <- st_transform(streets, crs = 2775) 65 | streets <- streets[tz_sf,] 66 | 67 | # plot 68 | tmap_mode("view") 69 | tm_shape(streets)+tm_lines() + 70 | tm_shape(tz_sf)+tm_borders(col = "dodgerblue")+ 71 | tm_view(basemaps = "OpenStreetMap", set.view = 13) 72 | 73 | save("streets", file = "streets.RData") 74 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Spatial interpolation using areal features: a review of methods and opportunities using new forms of data with coded illustrations 2 | Coded examples in R of the different approaches described in *Geography Compass*. 2019; e12465, https://doi.org/10.1111/gec3.12465 3 | 4 | Alexis Comber1, Wen Zeng1,2 5 | 6 | 1School of Geography, University of Leeds, Leeds, LS2 9JT, UK. Email: a.comber@leeds.ac.uk 7 | 8 | 2Shandong University of Science and Technology, Qingdao, P.R. China. Email: alvin_z@163.com 9 | 10 | ## Abstract 11 | This paper provides a high level review of different approaches for spatial interpolation using areal features. It groups these into those that use ancillary data to constrain or guide the interpolation (dasymetric, statistical, street weighted and point-based), and those do not but instead develop and refine allocation procedures (area to point, pycnophylactic and areal weighting). Each approach is illustrated by being applied to the same case study. The analysis is extended to examine the the opportunities arising from the many new forms of spatial data that are generated by everyday activities such as social media, check-ins, websites offering services, micro-blogging sites, social sensing, etc, as well as intentional VGI activities, both supported by ubiquitous web- and GPS-enabled technologies. Here data of residential properties from a commercial website was used as ancillary data. Overall, the interpolations using many of the new forms of data perform as well as traditional, formal data, highlighting the analytical opportunities as ancillary information for spatial interpolation and for supporting spatial analysis more generally. However, the case study also highlighted the need to consider the completeness and representativeness of such data. The R code used to generate the data, to develop the analysis and to create the tables and figures is provided. 12 | 13 | ## Code 14 | The code and data are used to illustrate a Geography Compass paper: Comber A, Zeng W. Spatial interpolation using areal features: A review of methods and opportunities using new forms of data with coded illustrations. *Geography Compass*. 2019; e12465, https://doi.org/10.1111/gec3.12465. 15 | 16 | You can download the `SpatInt_Jan22.R` file (`.Rmd` file to come...perhaps!) and run this in R or RStudio. It loads the `.RData` files from this site and provides links to the `.R` files which describe how the data were created and assembled. You may need to install some of the packages but the code checks and does this. The script will load up the data (and different forms of ancillary data) and illustrate each of spatial interpolation approaches described in the text. Please contact me if you have queries! 17 | Lex (a.comber@leeds.ac.uk) 18 | 19 | ## Acknowledgements 20 | This work was supported by the Natural Science Foundation of Shandong Province (ZR201702170310, the State Scholarship Fund of China Scholarship Council (201808370092) and the Natural Environment Research Council (NE/S009124/1). All of the analyses and mapping were undertaken in R 4.0.4 the open source statistical software. 21 | 22 | ## Package and Session Info 23 | ```{r} 24 | R version 4.0.4 (2021-02-15) 25 | Platform: x86_64-apple-darwin17.0 (64-bit) 26 | Running under: macOS Big Sur 10.16 27 | 28 | Matrix products: default 29 | LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib 30 | 31 | locale: 32 | [1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8 33 | 34 | attached base packages: 35 | [1] grid stats graphics grDevices utils datasets methods base 36 | 37 | other attached packages: 38 | [1] GGally_2.1.1 ggplot2_3.3.5 raster_3.5-2 gclus_1.3.2 39 | [5] cluster_2.1.2 repmis_0.5 OpenStreetMap_0.3.4 rgdal_1.5-23 40 | [9] reshape2_1.4.4 osmdata_0.1.5 gstat_2.0-7 sf_0.9-8 41 | [13] GISTools_0.7-4 MASS_7.3-53.1 RColorBrewer_1.1-2 tmap_3.3-1 42 | [17] pycno_1.2 rgeos_0.5-5 maptools_1.1-2 sp_1.4-6 43 | 44 | loaded via a namespace (and not attached): 45 | [1] xts_0.12.1 lubridate_1.7.10 httr_1.4.2 R.cache_0.14.0 tools_4.0.4 46 | [6] utf8_1.2.1 R6_2.5.0 KernSmooth_2.23-18 DBI_1.1.1 colorspace_2.0-0 47 | [11] withr_2.4.2 tidyselect_1.1.0 leaflet_2.0.4.1 curl_4.3 compiler_4.0.4 48 | [16] leafem_0.1.3 rvest_1.0.0 xml2_1.3.2 scales_1.1.1 classInt_0.4-3 49 | [21] proxy_0.4-26 stringr_1.4.0 digest_0.6.27 foreign_0.8-81 R.utils_2.10.1 50 | [26] base64enc_0.1-3 dichromat_2.0-0 pkgconfig_2.0.3 htmltools_0.5.1.1 htmlwidgets_1.5.3 51 | [31] rlang_0.4.10 FNN_1.1.3 generics_0.1.0 zoo_1.8-9 jsonlite_1.7.2 52 | [36] crosstalk_1.1.1 dplyr_1.0.5 R.oo_1.24.0 magrittr_2.0.1 Rcpp_1.0.7 53 | [41] munsell_0.5.0 fansi_0.4.2 abind_1.4-5 lifecycle_1.0.0 R.methodsS3_1.8.1 54 | [46] terra_1.4-11 stringi_1.5.3 leafsync_0.1.0 tmaptools_3.1-1 plyr_1.8.6 55 | [51] parallel_4.0.4 crayon_1.4.1 lattice_0.20-41 stars_0.5-2 pillar_1.6.0 56 | [56] spacetime_1.2-5 codetools_0.2-18 XML_3.99-0.6 glue_1.4.2 data.table_1.14.0 57 | [61] png_0.1-7 vctrs_0.3.7 gtable_0.3.0 purrr_0.3.4 reshape_0.8.8 58 | [66] assertthat_0.2.1 lwgeom_0.2-6 e1071_1.7-9 class_7.3-18 viridisLite_0.4.0 59 | [71] tibble_3.1.1 intervals_0.15.2 rJava_1.0-5 units_0.7-1 ellipsis_0.3.1 ` 60 | ``` 61 | -------------------------------------------------------------------------------- /ScrapeWeb.R: -------------------------------------------------------------------------------- 1 | library(RCurl) 2 | library(jsonlite) 3 | library('rvest') 4 | library(tidyverse) 5 | library(GISTools) 6 | library(sf) 7 | 8 | # see https://cfss.uchicago.edu/webdata005_scraping.html 9 | # done at "Mon Jan 14 21:54:27 2019" 10 | 11 | # 1. Create list of property IDs from the website 12 | zpid_list <- vector() 13 | for (i in 1:50){ 14 | #url <- paste0("https://www.zillow.com/homes/for_sale/New-Haven-CT/6155_rid/mostrecentchange_sort/41.449417,-72.700654,41.146603,-73.157273_rect/10_zm/X1.dash.SS.dash.13t86598jwfzp_4wzn5_sse/", i,"_p/1_rs/1_fr/") 15 | #url <- paste0("https://www.zillow.com/homes/recently_sold/New-Haven-CT/6155_rid/globalrelevanceex_sort/41.392907,-72.81498,41.203585,-73.04329_rect/11_zm/", i, "_p/") 16 | url <- paste0("https://www.zillow.com/homes/for_rent/New-Haven-CT/6155_rid/41.392907,-72.81498,41.203585,-73.04329_rect/11_zm/", i, "_p/") 17 | webpage <- read_html(url) 18 | data <- html_text(webpage) 19 | length(data) 20 | nchar(data) 21 | data <- (strsplit(data, '\"search\",data:')[[1]][2]) 22 | data <- (strsplit(data, ',namespace:\"search\"')[[1]][1]) 23 | data <- gsub("\\{zpid:\\[", "", data) 24 | data <- gsub("\\],pg:\"1\"\\}", "", data) 25 | data <- unlist(strsplit(data, ',')) 26 | zpid_list <- append(zpid_list, data) 27 | cat(i, "\t") 28 | } 29 | length(unique(zpid_list)) 30 | 31 | # 2. use this to download lat lon for each property 32 | p.list <- sort(unique(zpid_list)) 33 | res_list <- matrix(nrow = 0, ncol = 2) 34 | for (i in 253:length(p.list)) { 35 | pid.i <- p.list[i] 36 | #pid.i <- "57968605" 37 | url <- paste0("https://www.zillow.com/new-haven-ct/", pid.i, "_zpid/") 38 | if(url.exists(url)){ 39 | webpage <- read_html(url) 40 | webpage %>% 41 | html_nodes("*") %>% 42 | html_attr("href") -> tmp 43 | res.i <- tmp[grep("/homes/for_sale/", tmp)] 44 | if (length(res.i) > 0) { 45 | res_list <- rbind(res_list, cbind(pid.i, res.i)) 46 | rm(list = c("res.i", "webpage")) 47 | cat("1:",i, "\t") 48 | } 49 | } 50 | } 51 | 52 | # now clean and tidy to get the data.frame 53 | #length(which(is.na(res_list))) 54 | #head(res_list) 55 | #length(unique(res_list[,"pid.i"])) 56 | 57 | options(digits=9) 58 | pid.list <- sort(unique(res_list[,"pid.i"])) 59 | pid.list <- gsub("[[:punct:]]", "", pid.list) 60 | X <- vector() 61 | Y <- vector() 62 | pid <- vector() 63 | for (i in 1:length(pid.list)){ 64 | pid.i <- pid.list[i] 65 | index.i <- res_list[,"pid.i"] == pid.i 66 | res_list.i <- res_list[index.i, ] 67 | if( length(grep("rect", res_list.i)) > 0) { 68 | res_list.i <- res_list.i[grep("rect", res_list.i[, "res.i"])[2],] 69 | tmp <- gsub("[[:alpha:]]", "", res_list.i[2]) 70 | tmp <- gsub("_/0_", " ", tmp) 71 | tmp <- gsub("([.,-])|[[:punct:]]", "\\1", tmp) 72 | tmp <- gsub("--, ", "", tmp) 73 | tmp <- as.numeric(unlist(strsplit(tmp, ","))) 74 | Y <- append(Y, round(mean(tmp[1], tmp[3]), 6)) 75 | X <- append(X, round(mean(tmp[2], tmp[4]), 6)) 76 | pid <- append(pid, pid.i) 77 | cat(i, "\t") 78 | } 79 | } 80 | # check for fuckups 81 | index <- which(is.na(Y)) 82 | # create df 83 | df <- data.frame(ID = pid, X = X, Y = Y) 84 | # create sf 85 | props_sf <- st_as_sf(SpatialPointsDataFrame(df[, 2:3], 86 | data = data.frame(df[,1]), 87 | proj4string = CRS("+proj=longlat +datum=WGS84"))) 88 | names(props_sf)[1] <- "PID" 89 | save(props_sf, file = "zill.RData") 90 | 91 | 92 | 93 | -------------------------------------------------------------------------------- /SpatInt_Jan22.R: -------------------------------------------------------------------------------- 1 | ##### Code Development Script ##### 2 | ##### Lex Comber ##### 3 | ##### a.comber@leeds.ac.uk ##### 4 | ##### July 2019 ##### 5 | ##### Full CODE and DATA CREATION Details are at ##### 6 | ##### https://github.com/lexcomber/SpatInt ##### 7 | 8 | #### -1. Check and load packages 9 | if (!is.element("pycno", installed.packages())) 10 | install.packages("pycno", dep = T) 11 | if (!is.element("tmap", installed.packages())) 12 | install.packages("tmap", dep = T) 13 | if (!is.element("GISTools", installed.packages())) 14 | install.packages("GISTools", dep = T) 15 | if (!is.element("sf", installed.packages())) 16 | install.packages("sf", dep = T) 17 | if (!is.element("gstat", installed.packages())) 18 | install.packages("gstat", dep = T) 19 | if (!is.element("grid", installed.packages())) 20 | install.packages("grid", dep = T) 21 | if (!is.element("osmdata", installed.packages())) 22 | install.packages("osmdata", dep = T) 23 | if (!is.element("reshape2", installed.packages())) 24 | install.packages("rgdal", dep = T) 25 | if (!is.element("rgdal", installed.packages())) 26 | install.packages("reshape2", dep = T) 27 | if (!is.element("OpenStreetMap", installed.packages())) 28 | install.packages("OpenStreetMap", dep = T) 29 | if (!is.element("repmis", installed.packages())) 30 | install.packages("repmis", dep = T) 31 | if (!is.element("gclus", installed.packages())) 32 | install.packages("gclus", dep = T) 33 | if (!is.element("raster", installed.packages())) 34 | install.packages("raster", dep = T) 35 | if (!is.element("ggplot2", installed.packages())) 36 | install.packages("ggplot2", dep = T) 37 | if (!is.element("GGally", installed.packages())) 38 | install.packages("GGally", dep = T) 39 | # load packages into the R session 40 | library(pycno) 41 | library(tmap) 42 | library(GISTools) 43 | library(sf) 44 | library(gstat) 45 | library(grid) 46 | library(osmdata) 47 | library(reshape2) 48 | library(rgdal) 49 | library(OpenStreetMap) 50 | library(repmis) 51 | library(gclus) 52 | library(raster) 53 | library(ggplot2) 54 | library(GGally) 55 | 56 | #### 1. Load Data 57 | # load source zones and target zones 58 | # see GitHub site for details of the creation of this data 59 | # https://github.com/lexcomber/SpatInt 60 | source_data("https://github.com/lexcomber/SpatInt/blob/master/DataIn.RData?raw=True") 61 | # or if saved locally then set your working director then load 62 | # load("DataIn.RData") 63 | 64 | #### 2. Approaches with No Ancillary Data #### 65 | 66 | #### 2.1 Areal Weighting 67 | aw_res <- st_interpolate_aw(sz_sf, tz_sf, extensive = T) 68 | fac <- sum(sz_sf$HSE_UNITS)/sum(aw_res$HSE_UNITS) 69 | aw_res$HSE_UNITS = aw_res$HSE_UNITS*fac 70 | 71 | #### 2.2 Pycno 72 | # pycno only takes sp format and SpatialGrid as TZs 73 | # prepare data 74 | tz_sp <- as(tz_sf,"Spatial") 75 | sz_sp <- as(sz_sf,"Spatial") 76 | tz_sp2 <- SpatialPoints(tz_sp) 77 | tz_sp2 <- as(tz_sp2, "SpatialPixels") 78 | tz_sp2 <- as(tz_sp2, "SpatialGrid") 79 | # do pycno 80 | py_res <- pycno(x = sz_sp, pops = sz_sp$HSE_UNITS, celldim = tz_sp2, r = 0.1, 5) 81 | py_res <- as(py_res, "SpatialPolygonsDataFrame") 82 | 83 | #### 2.3 Area to Point 84 | # Create control point for each source zone 85 | sz_pt_sp <- SpatialPointsDataFrame(as(sz_sf, "Spatial"), 86 | data = data.frame(sz_sf), proj4string = .proj) 87 | # These are interpolated to a regular grid of points 88 | # using one of the point interpolation methods 89 | # gstat for IDW requires sp format 90 | bb <- bbox(as(sz_sf, "Spatial")) 91 | fac = 100 92 | grd <- GridTopology(cellcentre.offset= 93 | c(bb[1,1]+(fac/2),bb[2,1]+(fac/2)), 94 | cellsize=c(fac,fac), cells.dim = c(125,125)) 95 | tz_pt_sp <- SpatialPolygonsDataFrame( 96 | as.SpatialPolygons.GridTopology(grd), 97 | data = data.frame(c(1:(125^2))), match.ID = FALSE) 98 | proj4string(tz_pt_sp) <- .proj 99 | # subset 100 | tz_pt_sp <- tz_pt_sp[as(sz_sf, "Spatial"), ] 101 | # Interpolate with IDW - this takes time 102 | idw_res <- krige(HSE_UNITS~1,sz_pt_sp,tz_pt_sp) 103 | # Then, the density value for each grid cell is converted back to a count value 104 | fac <- sum(sz_sf$HSE_UNITS)/sum(idw_res$var1.pred) 105 | idw_res$houses <- idw_res$var1.pred * fac 106 | # and the values are reaggregated to the target zones 107 | ol <- over(idw_res, tz_sp) 108 | tid.list <- sort(unique(tz_sp$TID)) 109 | val_vec <- vector() 110 | for (i in 1:length(tid.list)){ 111 | tid.i <- tid.list[i] 112 | index.i <- which(ol$TID == tid.i) 113 | idw_res.i <- idw_res[index.i, ] 114 | val.i <- sum(idw_res.i$houses, na.rm = T) 115 | val_vec <- append(val_vec, val.i) 116 | } 117 | # assign to TZ 118 | a2p_res <- tz_sp 119 | a2p_res$houses <- val_vec 120 | 121 | # BUT point-based interpolators are not volume preserving 122 | # Because of this a scaling step needs to be added, in which the initial raster estimates are multiplied by the ratio between the value of the source feature containing the raster and the inferred value of that source feature 123 | ol <- over(a2p_res, sz_sp) 124 | sid.list <- sort(unique(sz_sp$SID)) 125 | for (i in 1:length(sid.list)){ 126 | sid.i <- sid.list[i] 127 | index.i <- ol$SID == sid.i 128 | a2p_res.i <- a2p_res[index.i, ] 129 | val.i <- sum(a2p_res.i$houses, na.rm = T) 130 | real.val.i <- sz_sp@data[sz_sp@data$SID == sid.i, "HSE_UNITS"] 131 | fac <- real.val.i/val.i 132 | a2p_res@data[index.i, "houses"] <- (a2p_res@data[index.i, "houses"] * fac) 133 | } 134 | 135 | ## Make tmap plot items of results for Figure 1 136 | # Standardised plot breaks 137 | breaks = c(0, 50, 100, 200, 300, 500, 700, 1200, 1700, 2200) 138 | # make tmap plot item of Input data 139 | data.p <- tm_shape(tz_sf) + tm_borders()+ 140 | tm_shape(sz_sf) + 141 | tm_polygons("HSE_UNITS", palette = "YlGnBu", 142 | style = "kmeans", n = 9, title = "Houses Tracts") + 143 | tm_layout(frame = F, legend.show = T) + 144 | tm_shape(tz_sf) + tm_borders() + 145 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 146 | tm_scale_bar(position = c(0.3))+ 147 | tm_compass(position = c(0.378, 0.1)) 148 | atp.p <- tm_shape(a2p_res) + 149 | tm_polygons(col='houses',palette = "YlGnBu", 150 | breaks = breaks, title = "Houses AtP")+ 151 | tm_layout(frame = F, legend.show = T) + 152 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 153 | tm_scale_bar(position = c(0.3))+ 154 | tm_compass(position = c(0.378, 0.1)) 155 | py.p <- tm_shape(py_res) + tm_polygons("dens", palette = "YlGnBu", 156 | breaks = breaks, title = "Houses Pycno")+ 157 | tm_layout(frame = F, legend.show = T) + 158 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 159 | tm_scale_bar(position = c(0.3))+ 160 | tm_compass(position = c(0.378, 0.1)) 161 | aw.p <- tm_shape(aw_res) + tm_polygons("HSE_UNITS", palette = "YlGnBu", 162 | breaks = breaks, title = "Houses AW")+ 163 | tm_layout(frame = F, legend.show = T) + 164 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 165 | tm_scale_bar(position = c(0.3))+ 166 | tm_compass(position = c(0.378, 0.1)) 167 | 168 | # write PNG of maps 169 | # you may want to set your working directory with setwd() 170 | png(filename = "F1.png", w = 15/1.5, h = 15/1.5, units = "in", res = 300) 171 | pushViewport(viewport(layout=grid.layout(2,2))) 172 | print(data.p, vp=viewport(layout.pos.col = 1, layout.pos.row = 1, height = 5)) 173 | print(aw.p, vp=viewport(layout.pos.col = 1, layout.pos.row = 2, height = 5)) 174 | print(py.p, vp=viewport(layout.pos.col = 2, layout.pos.row = 1, height = 5)) 175 | print(atp.p, vp=viewport(layout.pos.col = 2, layout.pos.row = 2, height = 5)) 176 | dev.off() 177 | 178 | # summary table Table 2 179 | f1.df = data.frame(sz = append(summary(sz_sf$HSE_UNITS), sum(sz_sf$HSE_UNITS)), 180 | a2p = append(summary(a2p_res$houses),sum(a2p_res$houses)), 181 | pycno = append(summary(py_res$dens), sum(py_res$dens)), 182 | aw = append(summary(aw_res$HSE_UNITS), sum(aw_res$HSE_UNITS))) 183 | rownames(f1.df)[7] = "Total" 184 | write.csv(round(f1.df,0),"tab2.csv") 185 | 186 | #### 3. With Ancillary Data #### 187 | 188 | #### 3.1 Dasymetric 189 | # load in the mask data 190 | # see MakeMask.R for the creation of this data 191 | source_data("https://github.com/lexcomber/SpatInt/blob/master/mask.RData?raw=True") 192 | # transform to projection to match that of .proj 193 | mask_sf <- st_transform(mask_sf, crs = 2775) 194 | # and create the target zone mask 195 | tz_m <- st_difference(tz_sf, st_transform(mask_sf, crs(tz_sf))) 196 | ## uncomment the below to check 197 | #tm_shape(mask_sf)+tm_polygons("red") 198 | #tm_shape(tz_m)+tm_borders("red") 199 | #tmap_mode("view") 200 | #tm_shape(tz_m)+tm_polygons(col = "lightgrey", alpha = 0.7)+ 201 | # tm_view(basemaps = "OpenStreetMap", set.view = 13) 202 | #tm_shape(tz_m[211, ])+tm_fill("red")+ 203 | # tm_shape(dasy_res[211,])+tm_borders(lwd = 2) 204 | 205 | ## interpolation with the mask 206 | # and then put the results bask to the original TZs 207 | dasy_res <- st_interpolate_aw(sz_sf, tz_m, extensive = T) 208 | # rescale by ratio of loss to total 209 | dasy_res$HSE_UNITS = dasy_res$HSE_UNITS * (sum(sz_sf$HSE_UNITS)/sum(dasy_res$HSE_UNITS)) 210 | dasy_res$TID <- tz_m$TID 211 | index <- match(dasy_res$TID, tz_sf$TID) 212 | dasy <- tz_sf 213 | dasy$HSE_UNITS <- 0 214 | dasy$HSE_UNITS[index] <- dasy_res$HSE_UNITS 215 | dasy_res <- dasy 216 | ## make tmap plot item of the results 217 | dasy.p<- 218 | tm_shape(dasy_res) + tm_polygons(col='HSE_UNITS',palette = "YlGnBu", 219 | breaks = breaks, title = "Houses Dasy")+ 220 | tm_layout(frame = F, legend.show = T) + 221 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 222 | tm_scale_bar(position = c(0.3))+ 223 | tm_compass(position = c(0.378, 0.1)) 224 | 225 | #### 3.2 Street weighted 226 | # load in the OSM street data 227 | # see MakeStreets.R for the creation of this data 228 | source_data("https://github.com/lexcomber/SpatInt/blob/master/streets.RData?raw=True") 229 | 230 | # determine the proportion of SZ streets in each TZ 231 | ol <- st_intersection(st_transform(streets, crs(sz_sf)), sz_sf) 232 | ol <- st_intersection(ol, tz_sf) 233 | ol$Length <- st_length(ol) 234 | df <- data.frame(ol[, c("TID", "SID", "Length")])[, 1:3] 235 | df <- as.data.frame.matrix(xtabs(Length~TID+SID, df)) 236 | # convert to proprtions 237 | for (i in 1:ncol(df)){ 238 | df[, i] <- df[,i]/sum(df[,i]) 239 | } 240 | # insert non-overlapping TZ (ie those without streets) 241 | tid.list <- sort(unique(tz_sf$TID)) 242 | sid.list <- sort(unique(sz_sf$SID)) 243 | df_res <- matrix(0, ncol = length(sid.list), nrow = length(tid.list)) 244 | rownames(df_res) <- tid.list 245 | colnames(df_res) <- sid.list 246 | index <- match(rownames(df), rownames(df_res)) 247 | for (i in 1:length(index)) { 248 | index.i <- index[i] 249 | df_res[index.i, ] <- as.vector(unlist(df[i,])) 250 | } 251 | # do allocation 252 | pops <- sz_sf$HSE_UNITS 253 | for (i in 1:length(pops)){ 254 | pops.i <- pops[i] 255 | df_res[, i] <- as.vector(unlist(df_res[, i] * pops.i)) 256 | } 257 | sw_res <- tz_sf 258 | sw_res$Houses <- rowSums(df_res) 259 | 260 | ## make tmap plot item of the results 261 | sw.p<- tm_shape(sw_res) + tm_polygons(col='Houses',palette = "YlGnBu", 262 | breaks = breaks, title = "Houses Street")+ 263 | tm_layout(frame = F, legend.show = T) + 264 | #tm_shape(streets) +tm_lines("darkgray")+ 265 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 266 | tm_scale_bar(position = c(0.3))+ 267 | tm_compass(position = c(0.378, 0.1)) 268 | # save.image("upto3.3.RData") 269 | 270 | #### 3.3 Statistical 271 | # load in the USGS land cover data 272 | # see MakeLandcover.R for the creation of this data 273 | source_data("https://github.com/lexcomber/SpatInt/blob/master/landcover.RData?raw=True") 274 | 275 | # constuct data for regression for SZ 276 | df <- data.frame(lc_sz@data[, c("label", "SID", "count")]) 277 | df <- as.data.frame.matrix(xtabs(count~SID+label, df)) 278 | df$Houses <- sz_sf$HSE_UNITS 279 | # create regression model 280 | reg.mod <- as.formula(Houses~`Developed, High Intensity`+ `Developed, Medium Intensity`+`Grassland/Herbaceous`+0) 281 | mod <- lm(reg.mod, df) 282 | # summary(mod) 283 | # overlay points to TZ 284 | #lc_tz <- lc[as(tz_sf, "Spatial"), ] 285 | ol <- SpatialPoints(coordinates(lc_tz),proj4string=.proj) %over% as(tz_sf,"Spatial") 286 | lc_tz$TID <- ol$TID 287 | lc_tz$count <- 1 288 | # constuct data for regression TZ 289 | df_pred <- data.frame(lc_tz@data[, c("label", "TID", "count")]) 290 | df_pred <- as.data.frame.matrix(xtabs(count~TID+label, df_pred)) 291 | # use as input to model to predict houses 292 | pred <- predict(mod, newdata = df_pred) 293 | # rescale the data 294 | fac <- sum(sz_sf$HSE_UNITS)/sum(pred) 295 | pred <- pred*fac 296 | # assign to TZ 297 | stat_res <- tz_sf 298 | stat_res$houses <- pred 299 | 300 | ## make tmap plot item of the results 301 | stat.p<- tm_shape(stat_res) + tm_polygons(col='houses',palette = "YlGnBu", 302 | breaks = breaks, title = "Houses Stat")+ 303 | tm_layout(frame = F, legend.show = T) + 304 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 305 | tm_scale_bar(position = c(0.3))+ 306 | tm_compass(position = c(0.378, 0.1)) 307 | 308 | #### 3.4 Point-Based ancillary information 309 | # load in the OSM building data 310 | # see below for the creation of this data 311 | source_data("https://github.com/lexcomber/SpatInt/blob/master/buildings.RData?raw=True") 312 | # get data from OSM - this was done in January 2019 313 | #osm_sf <- opq ("New Haven, USA") %>% 314 | # add_osm_feature ("building") %>% 315 | # osmdata_sf 316 | #tm_shape(osm_sf$osm_points)+tm_dots() 317 | #buildings <- st_transform(osm_sf$osm_points, crs = 2775) 318 | #buildings <- buildings[tz_sf, "osm_id"] 319 | #save("buildings", file = "buildings.RData") 320 | 321 | # intersection 322 | ol <- st_intersection(st_transform(buildings, crs(tz_sf)), tz_sf) 323 | ol <- st_intersection(ol, sz_sf) 324 | ol$count <- 1 325 | df <- data.frame(ol[, c("TID", "SID", "count")])[, 1:3] 326 | df <- as.data.frame.matrix(xtabs(count~TID+SID, df)) 327 | # convert to proportions 328 | for (i in 1:ncol(df)){ 329 | df[, i] <- df[,i]/sum(df[,i]) 330 | } 331 | # insert non-overlapping TZ (ie those without streets) 332 | tid.list <- sort(unique(tz_sf$TID)) 333 | sid.list <- sort(unique(sz_sf$SID)) 334 | df_res <- matrix(0, ncol = length(sid.list), nrow = length(tid.list)) 335 | rownames(df_res) <- tid.list 336 | colnames(df_res) <- sid.list 337 | index <- match(rownames(df), rownames(df_res)) 338 | for (i in 1:length(index)) { 339 | index.i <- index[i] 340 | df_res[index.i, ] <- as.vector(unlist(df[i,])) 341 | } 342 | head(df_res) 343 | # do allocation 344 | pops <- sz_sf$HSE_UNITS 345 | for (i in 1:length(pops)){ 346 | pops.i <- pops[i] 347 | df_res[, i] <- as.vector(unlist(df_res[, i] * pops.i)) 348 | } 349 | pt_res <- tz_sf 350 | pt_res$Houses <- rowSums(df_res) 351 | 352 | ## make tmap plot item of the results 353 | pt.p <- tm_shape(pt_res) + tm_polygons(col='Houses',palette = "YlGnBu", 354 | breaks = breaks, title = "Houses Point")+ 355 | tm_layout(frame = F, legend.show = T) + 356 | #tm_shape(buildings) +tm_dots("darkgray", alpha = 0.5, size = 0.002)+ 357 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 358 | tm_scale_bar(position = c(0.3))+ 359 | tm_compass(position = c(0.378, 0.1)) 360 | 361 | #### 4. Plots 362 | 363 | # Figure 2 364 | png(filename = "F2.png", w = 15/1.5, h = 15/1.5, units = "in", res = 300) 365 | pushViewport(viewport(layout=grid.layout(2,2))) 366 | print(dasy.p, vp=viewport(layout.pos.col = 1, layout.pos.row = 1, height = 5)) 367 | print(sw.p, vp=viewport(layout.pos.col = 1, layout.pos.row = 2, height = 5)) 368 | print(stat.p, vp=viewport(layout.pos.col = 2, layout.pos.row = 1, height = 5)) 369 | print(pt.p, vp=viewport(layout.pos.col = 2, layout.pos.row = 2, height = 5)) 370 | dev.off() 371 | 372 | f2.df = data.frame(dasy = append(summary(dasy_res$HSE_UNITS), sum(dasy_res$HSE_UNITS)), 373 | stat = append(summary(stat_res$houses), sum(stat_res$houses)), 374 | sw = append(summary(sw_res$Houses),sum(sw_res$Houses)), 375 | pt = append(summary(pt_res$Houses), sum(pt_res$Houses))) 376 | rownames(f2.df)[7] = "Total" 377 | write.csv(round(f2.df,0),"tab3.csv") 378 | 379 | # Figure 3 (input data) 380 | # plot study area detail 381 | tmp <- as(st_transform(tz_sf, 4326), "Spatial") 382 | buf <- st_buffer(tz_sf, 500) 383 | buf <- as(st_transform(buf, 4326), "Spatial") 384 | ul <- as.vector(cbind(bbox(buf)[2,2], bbox(buf)[1,1])) 385 | lr <- as.vector(cbind(bbox(buf)[2,1], bbox(buf)[1,2])) 386 | # download the map tile 387 | MyMap <- openmap(ul,lr,13,'osm') 388 | # now plot the layer and the backdrop 389 | 390 | png(filename = "F3a.png", w = 15/3, h = 15/3, units = "in", res = 300) 391 | par(mar = c(1,1,1,1)) 392 | plot(MyMap, removeMargin=F) 393 | plot(spTransform(as(tz_m, "Spatial"), osm()), add = TRUE, col = rgb(0.75,0.25,0.25,0.15)) 394 | #scalebar(3000, label = c(0, 1.5, 3), type = "bar", below = "km", xy = c(-8119700,5047700)) 395 | title("Binary Mask (Pycno)", font.main = 1) 396 | dev.off() 397 | 398 | png(filename = "F3b.png", w = 15/3, h = 15/3, units = "in", res = 300) 399 | par(mar = c(1,1,1,1)) 400 | plot(MyMap, removeMargin=FALSE) 401 | plot(spTransform(as(streets, "Spatial"), osm()), add = TRUE) 402 | #scalebar(3000, label = c(0, 1.5, 3), type = "bar", below = "km", xy = c(-8119700,5047700)) 403 | title("OSM road network (Streets)", font.main = 1) 404 | dev.off() 405 | 406 | index <- lc_tz$band1 == 24 | lc_tz$band1 == 23 | lc_tz$band1 == 71 407 | summary(index) 408 | lc_tmp <- lc_tz[index,] 409 | col.vec <- rep("#FB6A4A", nrow(lc_tmp)) 410 | index <- lc_tmp$band1 == 24 411 | col.vec[index] <- "#252525" 412 | index <- lc_tmp$band1 == 23 413 | col.vec[index] <- "#969696" 414 | 415 | png(filename = "F3c.png", w = 15/3, h = 15/3, units = "in", res = 300) 416 | par(mar = c(1,1,1,1)) 417 | plot(MyMap, removeMargin=FALSE) 418 | plot(spTransform(lc_tmp, osm()), add = TRUE, cex = 0.2, pch = 15, col = col.vec) 419 | #scalebar(3000, label = c(0, 1.5, 3), type = "bar", below = "km", xy = c(-8119700,5047700)) 420 | title("Land cover (Statistical)", font.main = 1) 421 | dev.off() 422 | 423 | png(filename = "F3d.png", w = 15/3, h = 15/3, units = "in", res = 300) 424 | par(mar = c(1,1,1,1)) 425 | plot(MyMap, removeMargin=FALSE) 426 | plot(spTransform(as(buildings, "Spatial"), osm()), add = TRUE, cex = 0.1, pch = 15) 427 | #scalebar(3000, label = c(0, 1.5, 3), type = "bar", below = "km", xy = c(-8119700,5047700)) 428 | title("OSM Buildings (Point)", font.main = 1) 429 | dev.off() 430 | 431 | # save.image(file = "upto5.RData") 432 | 433 | #### 5.Housing sales / rental website data 434 | # load in the USGS land cover data 435 | # see ScrapeWeb.R for the creation of this data 436 | source_data("https://github.com/lexcomber/SpatInt/blob/master/zill.RData?raw=True") 437 | # transform the projection 438 | props_sf <- st_transform(props_sf, crs = 2775) 439 | 440 | # Figure 4a 441 | png(filename = "F4a.png", w = 15/3, h = 15/3, units = "in", res = 300) 442 | par(mar = c(1,1,1,1)) 443 | plot(MyMap, removeMargin=FALSE) 444 | plot(spTransform(as(props_sf, "Spatial"), osm()), add = TRUE, 445 | col = rgb(0,0,0,0.3), pch = 19, cex = 0.5) 446 | title("Web Properties", font.main = 1) 447 | dev.off() 448 | 449 | # same approach as Point-Based ancillary information 450 | ol <- st_intersection(st_transform(props_sf, crs(tz_sf)), tz_sf) 451 | ol <- st_intersection(ol, sz_sf) 452 | ol$count <- 1 453 | df <- data.frame(ol[, c("TID", "SID", "count")])[, 1:3] 454 | df <- as.data.frame.matrix(xtabs(count~TID+SID, df)) 455 | # convert to proportions 456 | for (i in 1:ncol(df)){ 457 | df[, i] <- df[,i]/sum(df[,i]) 458 | } 459 | # insert non-overlapping TZ (ie those without streets) 460 | tid.list <- sort(unique(tz_sf$TID)) 461 | sid.list <- sort(unique(sz_sf$SID)) 462 | df_res <- matrix(0, ncol = length(sid.list), nrow = length(tid.list)) 463 | rownames(df_res) <- tid.list 464 | colnames(df_res) <- sid.list 465 | index <- match(rownames(df), rownames(df_res)) 466 | for (i in 1:length(index)) { 467 | index.i <- index[i] 468 | df_res[index.i, ] <- as.vector(unlist(df[i,])) 469 | } 470 | # do allocation 471 | pops <- sz_sf$HSE_UNITS 472 | for (i in 1:length(pops)){ 473 | pops.i <- pops[i] 474 | df_res[, i] <- as.vector(unlist(df_res[, i] * pops.i)) 475 | } 476 | web_res <- tz_sf 477 | web_res$Houses <- rowSums(df_res) 478 | 479 | ## make tmap plot item of the results 480 | web.p <- tm_shape(web_res) + tm_polygons(col='Houses',palette = "YlGnBu", 481 | breaks = breaks, title = "Houses Web")+ 482 | tm_layout(frame = F, legend.show = T) + 483 | #tm_shape(buildings) +tm_dots("darkgray", alpha = 0.5, size = 0.002)+ 484 | tm_shape(sz_sf) + tm_borders(col = "black", lwd = 2)+ 485 | tm_scale_bar(position = c(0.3))+ 486 | tm_compass(position = c(0.378, 0.1)) 487 | 488 | # Figure 4b 489 | png(filename = "F4b.png", w = 15/3, h = 15/3, units = "in", res = 300) 490 | pushViewport(viewport(layout=grid.layout(1,1))) 491 | # plot using he print command 492 | print(web.p, vp=viewport(layout.pos.col = 1, layout.pos.row = 1, height = 5)) 493 | #print(wwt.p, vp=viewport(layout.pos.col = 2, layout.pos.row = 1, height = 5)) 494 | dev.off() 495 | vals = matrix(c(round(summary(web_res$Houses), 0), sum(web_res$Houses))) 496 | tab = c(names(summary(web_res$Houses)), "Total") 497 | tab = cbind(tab, vals) 498 | write.csv(tab, file = "tab4.csv") 499 | 500 | #### 6.Comparisons in Figure 5 501 | wf <- data.frame( AW = aw_res$HSE_UNITS, 502 | Pycno = py_res$dens, 503 | AtP = a2p_res$houses, 504 | Dasy = dasy_res$HSE_UNITS, 505 | Street = sw_res$Houses, 506 | Stat = stat_res$houses, 507 | Point = pt_res$Houses, 508 | Web = web_res$Houses) 509 | 510 | # original panel plot 511 | # ggpairs(wf, aes(alpha = 0.4), 512 | # upper = list(continuous = wrap('cor', size = 6, colour = "black")), 513 | # lower = list(continuous = wrap('smooth',alpha = 0.3, cex=0.2 ))) + 514 | # theme(axis.line=element_blank(), 515 | # axis.text=element_blank(), 516 | # axis.ticks=element_blank()) 517 | 518 | # functions change the layout modified from https://github.com/ggobi/ggally/issues/139 519 | # for lower panel of plots 520 | my_custom_smooth <- function(data, mapping, ...) { 521 | ggplot(data = data, mapping = mapping) + 522 | geom_point(color = I("blue"), alpha = 0.3, cex = 0.5) + 523 | geom_smooth(method = "lm", lwd = 0.5, color = I("red3"), ...) 524 | } 525 | #my_custom_smooth(iris, aes(Sepal.Length, Sepal.Width)) 526 | 527 | # for upper panel plot 528 | my_custom_cor <- function(data, mapping, color = I("black"), sizeRange = c(1.5, 3), ...) { 529 | # get the x and y data to use the other code 530 | x <- eval_data_col(data, mapping$x) 531 | y <- eval_data_col(data, mapping$y) 532 | ct <- cor.test(x,y) 533 | sig <- symnum( 534 | ct$p.value, corr = FALSE, na = FALSE, 535 | cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), 536 | symbols = c("***", "**", "*", ".", " ")) 537 | r <- unname(ct$estimate) 538 | rt <- format(r, digits=2)[1] 539 | # since we can't print it to get the strsize, just use the max size range 540 | cex <- max(sizeRange) 541 | # helper function to calculate a useable size 542 | percent_of_range <- function(percent, range) { 543 | percent * diff(range) + min(range, na.rm = TRUE)} 544 | # plot the cor value 545 | ggally_text( 546 | label = as.character(rt), 547 | mapping = aes(), 548 | xP = 0.5, yP = 0.5, 549 | size = I(percent_of_range(cex * abs(r), sizeRange)), 550 | color = color, 551 | ...) + 552 | # add the sig stars 553 | geom_text( 554 | aes_string( 555 | x = 0.8, 556 | y = 0.8), 557 | label = sig, 558 | size = I(cex), 559 | color = color, 560 | ...) + 561 | # remove all the background stuff and wrap it with a dashed line 562 | theme_classic() + 563 | theme( 564 | panel.background = element_rect( 565 | color = "grey50", 566 | linetype = "longdash"), 567 | axis.line = element_blank(), 568 | axis.ticks = element_blank(), 569 | axis.text.y = element_blank(), 570 | axis.text.x = element_blank()) 571 | } 572 | # my_custom_cor(iris, aes(Sepal.Length, Sepal.Width)) 573 | 574 | # now apply to data 575 | png(filename = "F5.png", w = 15/3, h = 15/3, units = "in", res = 300) 576 | ggpairs(wf, aes(alpha = 0.4), 577 | upper = list(continuous = my_custom_cor), 578 | lower = list(continuous = my_custom_smooth)) + 579 | theme(axis.line=element_blank(), 580 | axis.text=element_blank(), axis.ticks=element_blank()) 581 | dev.off() 582 | 583 | #save.image(file = "all_data.RData") 584 | 585 | ##### END 586 | 587 | 588 | 589 | 590 | -------------------------------------------------------------------------------- /buildings.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/buildings.RData -------------------------------------------------------------------------------- /landcover.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/landcover.RData -------------------------------------------------------------------------------- /mask.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/mask.RData -------------------------------------------------------------------------------- /streets.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/streets.RData -------------------------------------------------------------------------------- /zill.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lexcomber/SpatInt/872b30d864d20c8701c25f786e79a46f6c6e9307/zill.RData --------------------------------------------------------------------------------