add uc databases

darwinanddavis · Nov 4, 2023 · ba3db37 · ba3db37
1 parent 8d1d19f
commit ba3db37
Show file tree

Hide file tree

Showing 4 changed files with 1,574 additions and 746 deletions.
diff --git a/UsefulCode_databases.Rmd b/UsefulCode_databases.Rmd
@@ -0,0 +1,196 @@
+---
+title: Useful R code - databases
+author: |
+ | Matthew Malishev
+ | @darwinanddavis 
+fontsize: 10
+geometry: margin=1in
+documentclass: article
+linkcolor: pink
+urlcolor: blue
+citecolor: red
+always_allow_html: yes
+output:
+  html_document:
+  highlight: tango
+code_folding: show
+toc: yes
+toc_depth: 4
+number_sections: no
+toc_float: yes
+md_document: 
+  variant: markdown_github
+pdf_document:
+  includes:
+  in_header: # add .tex file with header content
+  highlight: tango
+template: null
+fig_width: 4
+fig_height: 5
+fig_caption: true
+df_print: tibble 
+citation_package: biblatex # natbib
+latex_engine: xelatex #pdflatex # lualatex
+keep_tex: true # keep .tex file in dir 
+word_document:
+  highlight: tango
+keep_md: yes
+pandoc_args: --smart
+#reference: mystyles.docx
+inludes:
+  before_body: before_body.tex
+subtitle: 
+  tags:
+  - nothing
+  - nothingness
+params: 
+  dir: "/Users/malishev/Documents/Melbourne Uni/Programs/R code/UsefulCode"
+date: !r Sys.Date()
+version: !r getRversion()
+email: "matthew.malishev [at] gmail.com"
+doi: https://github.com/darwinanddavis/UsefulCode
+classoption: portrait
+# ^['https://github.com/darwinanddavis/UsefulCode'] # footnote
+---
+
+  <script type="text/x-mathjax-config">
+  MathJax.Hub.Config({ TeX: { equationNumbers: {autoNumber: "all"} } });
+</script>
+
+  ```{r echo = FALSE}
+library(rmarkdown)
+# setwd("")
+# f <- list.files()[1]
+# render(f, output_format='pdf_document')
+# render(f, output_format='pdf_document')
+```
+
+```{r, set-options, echo = FALSE, cache = FALSE}
+options(width=100)
+knitr::opts_chunk$set(
+  eval = F, # run all code
+  results='hide',
+  # echo = FALSE, # show code chunks in output 
+  comment = "",
+  tidy.opts=list(width.cutoff=100), # set width of code chunks in output
+  tidy=TRUE, # make output as tidy
+  message = FALSE,  # mask all messages
+  warning = FALSE, # mask all warnings 
+  collapse = T,
+  size="small" # set code chunk size
+)
+
+# https://github.com/ucb-stat133/stat133-fall-2016/blob/master/hws/hw02-tables-ggplot.Rmd
+knitr::opts_knit$set(root.dir=paste0(params$dir,"/")) # set working dir
+
+setwd(paste0(params$dir,"/")) # for running just in R not knitr
+pacman::p_load(dplyr,readr,rvest,xml2,magrittr,sp,sf,rgdal,ggmap,ggplot2,stringr,ggthemes,ggnetwork,colorspace,ggtext,ggsn,ggspatial,showtext,here)
+```
+
+\  
+
+Date: `r params$date`  
+`R` version: `r params$version`  
+*Corresponding author: `r params$email`  
+This document can be found at `r params$doi`
+
+\newpage  
+
+## Overview
+
+Directory for online databases and collating useful online resources
+
+
+### Population
+
+Hi-res world population density  
+https://data.humdata.org/organization/kontur  
+
+
+
+
+###  hillshade and elevation data options
+import hillshade and bathymetry data   https://nceas.github.io/oss-lessons/spatial-data-gis-law/3-mon-intro-gis-in-r.html
+
+hillshade/relief esri plot backgrounds?  
+https://github.com/riatelab/maptiles  
+
+hires hillshade render x rayshade  
+https://github.com/pierreroudier/hillshader
+
+elevation/hillsahde mapping {stars}   https://twitter.com/ldcgodoy/status/1327462181806469120/photo/1  
+
+raster/hillshade rnaturalearth data as alt raster/hillshade method   https://www.naturalearthdata.com/downloads/10m-raster-data/  
+
+hi-res elevation relief in ggplot  
+https://timogrossenbacher.ch/2016/12/beautiful-thematic-maps-with-ggplot2-only/  
+
+hillshade/elevation in raster (ne_download)  
+https://www.naturalearthdata.com/downloads/10m-raster-data/  
+
+good ggplot examples w full country polygon ('relief map')   https://rpubs.com/MRufino/Portugal  
+
+elevation from gpx files   
+https://rpubs.com/ials2un/gpx1     
+
+mask/crop hlllshade or raster to area (plus inverse mask)   https://geocompr.robinlovelace.net/geometric-operations.html  
+
+reduce tiff/raster size using resize_matrix() {rayshader}   https://www.tylermw.com/adding-open-street-map-data-to-rayshader-maps-in-r/ 
+  {hillshader}    
+
+get image/elevation by bbox (north america)   https://elevation.nationalmap.gov/arcgis/rest/services/3DEPElevation/ImageServer/exportImage?bbox=-122.522%2C37.707%2C-122.354%2C37.84&bboxSR=4326&size=600%2C480&imageSR=4326&time=&format=jpgpng&pixelType=F32&noData=&noDataInterpretation=esriNoDataMatchAny&interpolation=+RSP_BilinearInterpolation&compression=&compressionQuality=&bandIds=&mosaicRule=&renderingRule=&f=html  
+
+global elevation by tilesets   
+https://srtm.csi.cgiar.org/srtmdata/  
+
+tanaka maps and tanaka contours with ggplot  
+https://github.com/riatelab/tanaka  
+
+###  Elevation profile 
+get elevation profile for line passing through raster layer     https://geocompr.robinlovelace.net/raster-vector.html  
+
+digital elevation profile based on xyz data   https://rdrr.io/github/ITSLeeds/slopes/man/plot_dz.html  
+
+sparkline plot for interactive elevation profile   {https://www.rpubs.com/dnchari/rcharts}  
+
+
+###  3d renders/maps 
+3d globe http://www.rayrender.net/  
+
+rayvista 3d landscapes https://github.com/h-a-graham/rayvista  
+
+spinning d3 globe https://daranzolin.github.io/software/  
+
+hires raster globe using {stars} https://ggplot2-book.org/maps.html  
+
+{webglobe} https://twitter.com/richard_vogg/status/1333032445931900928/photo/1  
+
+{globe4r} https://twitter.com/dickoah/status/1333082949638627329  
+
+city pop density maps with rayshader  
+https://github.com/Pecners/rayshader_portraits/blob/main/R/portraits/alabama/render_graphic.R L65
+
+
+### Bathymetry 
+bath1 - https://mikkovihtakari.github.io/ggOceanMaps/    
+
+bath2 w ggplot examples - https://rpubs.com/MRufino/Portugal  
+
+bath3 (marmap) - https://rdrr.io/cran/marmap/man/readGEBCO.bathy.html  
+
+routing directions    check googleway option for getting driving directions  
+  (https://stackoverflow.com/questions/40077798/r-plotting-multiple-decoded-polylines-using-leaflet)  
+
+mapbox routing directions and road network   https://walker-data.com/mapboxapi/articles/navigation.html  
+
+osrm::osrmRoute() https://github.com/daranzolin/freshAirFinderApp/blob/main/inst/freshAirFinder/app.R  
+
+  lubridate::cyclic_encoding() cycling duration/distance
+  {sfnetworks} calc distance between points  https://stackoverflow.com/questions/70186124/how-to-calculate-distances-between-points-along-a-path
+  {r5r} Rapid Realistic Routing with R5 in R https://cran.r-project.org/web/packages/r5r/vignettes/intro_to_r5r.html
+  {geobr} & {r5r} isopleth walking/routing times (for colouring osm data with multicoloured streets) https://www.urbandemographics.org/post/mapping-walking-time-osm-r5r/
+
+
+
+
+
diff --git a/UsefulCode_databases.html b/UsefulCode_databases.html
diff --git a/UsefulCode_sf.Rmd b/UsefulCode_sf.Rmd
@@ -317,6 +317,13 @@ ggmap(gg, extent = "device", darken = c(0.9,"white")) +
 
 ### Cropping 
 
+Crop out sf objects
+```{r}
+sf %>% st_crop(dd %>% filter(name == "Victoria"))
+sf %>% st_intersection(dd %>% filter(name == "Victoria"))
+```
+
+
 Crop plot region to country border   
 ```{r, cr1, eval = F}
 ggplot() +
@@ -449,6 +456,15 @@ sf %>% st_crop(bb %>% st_bbox() %>% st_as_sfc())
 ```
 
 
+Crop one side of sf object 
+```{r}
+# https://spencerschien.info/post/spatial_buffer/
+sf_use_s2(FALSE) # set first to enable geos
+sf %>% st_buffer(100, singleSide = T)
+
+```
+
+
 ### Databases
 Databases - maps, world data, natural earth, raster, DEM 
 ```{r, d1, eval = F}
@@ -481,6 +497,75 @@ sf <- fh %>% st_read(layer = fhl) # read in data using layer
 
 ```
 
+### GPX  
+
+Read .gpx files (GPS track software/apps)  
+```{r, gpx1}
+
+# option 1
+gpx <- st_read("user.gpx", "track_points")
+pathm <- gpx %>% 
+  group_by(user_ID) %>%  # get grouping variable
+  dplyr::summarize(do_union = F) %>% 
+  st_cast("LINESTRING")
+
+
+# option 2
+pacman::p_load(XML,lubridate)
+fd <- "/Volumes/Matt_timemachine/maptracks/2021/sep/sam/gpx/"
+fh <- "day182.gpx"
+gpx1 <- paste0(fd,fh) %>%  # parse gpx file
+  htmlTreeParse(error = function(...) {}, useInternalNodes = T)
+elev <- as.numeric(xpathSApply(gpx1, path = "//trkpt/ele", xmlValue))
+times <- xpathSApply(gpx1, path = "//trkpt/time", xmlValue)
+coord <- xpathSApply(gpx1, path = "//trkpt", xmlAttrs)
+
+city_df <- tibble(lat = coord["lat",] %>% as.numeric(), 
+                  lon = coord["lon",] %>% as.numeric(),
+                  elev = elev, 
+                  time = times %>% ymd_hms()  
+                  )
+
+# elev profile 
+ggplot(data = city_df) +
+  geom_line(aes(time,elev)) +
+  scale_x_datetime(date_breaks = "6 hours"
+                   # date_minor_breaks = "1 hour", # optional
+                   # date_labels = "%M%D" # full month and year
+  )
+
+
+# convert gpx coords to linestring
+pathgpx <- city_df %>% 
+  dplyr::select(lat,lon) %>% 
+  as.matrix() %>% # convert points to linestring
+  st_linestring(dim = "XY") %>% 
+  st_sfc(crs = 4326) %>% # convert sfg object to geometry 
+  st_transform(crs = 4326) # then convert projection
+  
+
+```
+
+Parse gpx data within kml    
+First manually convert file from '.kml' to '.gpx'
+```{r, gpx2}
+require(XML)
+require(dplyr)
+require(tidyr)
+coord_id <- "//coord" # tag where lat/lon/elev data are located in file 
+gpx2 <- "data/full.gpx" %>%  
+  htmlTreeParse(error = function(...) {}, useInternalNodes = T)
+pathgpx <- xpathSApply(gpx2, path = coord_id, xmlValue) %>% # read coords (lon,lat,elev)
+  as.data.frame() %>% 
+  tidyr::separate(col = ".",into = c("lon", "lat", "elev"), sep = " ", remove = T) %>% # separate char into individual values
+  mutate_all(as.numeric) 
+
+# timestamp  
+time_id <- "//when" # may vary with data  
+gpx2 <- "data/full.gpx" %>%
+  xpathSApply(gpx2, path = time_id, xmlValue) # get timestamp  
+```
+
 
 ### North arrow and scale bars  
 <!-- https://www.r-spatial.org/r/2018/10/25/ggplot2-sf.html   -->
@@ -929,63 +1014,6 @@ get_inter_func <- function(sc1,sc2){
 ```
 
 
-### Read .gpx files (GPS track software/apps)  
-```{r, gpx1}
-pacman::p_load(XML,lubridate)
-fd <- "/Volumes/Matt_timemachine/maptracks/2021/sep/sam/gpx/"
-fh <- "day182.gpx"
-gpx1 <- paste0(fd,fh) %>%  # parse gpx file
-  htmlTreeParse(error = function(...) {}, useInternalNodes = T)
-elev <- as.numeric(xpathSApply(gpx1, path = "//trkpt/ele", xmlValue))
-times <- xpathSApply(gpx1, path = "//trkpt/time", xmlValue)
-coord <- xpathSApply(gpx1, path = "//trkpt", xmlAttrs)
-
-city_df <- tibble(lat = coord["lat",] %>% as.numeric(), 
-                  lon = coord["lon",] %>% as.numeric(),
-                  elev = elev, 
-                  time = times %>% ymd_hms()  
-                  )
-
-# elev profile 
-ggplot(data = city_df) +
-  geom_line(aes(time,elev)) +
-  scale_x_datetime(date_breaks = "6 hours"
-                   # date_minor_breaks = "1 hour", # optional
-                   # date_labels = "%M%D" # full month and year
-  )
-
-
-# convert gpx coords to linestring
-pathgpx <- city_df %>% 
-  dplyr::select(lat,lon) %>% 
-  as.matrix() %>% # convert points to linestring
-  st_linestring(dim = "XY") %>% 
-  st_sfc(crs = 4326) %>% # convert sfg object to geometry 
-  st_transform(crs = 4326) # then convert projection
-  
-
-```
-
-Parse gpx data within kml    
-First manually convert file from '.kml' to '.gpx'    
-```{r, gpx2}
-require(XML)
-require(dplyr)
-require(tidyr)
-coord_id <- "//coord" # tag where lat/lon/elev data are located in file 
-gpx2 <- "data/full.gpx" %>%  
-  htmlTreeParse(error = function(...) {}, useInternalNodes = T)
-pathgpx <- xpathSApply(gpx2, path = coord_id, xmlValue) %>% # read coords (lon,lat,elev)
-  as.data.frame() %>% 
-  tidyr::separate(col = ".",into = c("lon", "lat", "elev"), sep = " ", remove = T) %>% # separate char into individual values
-  mutate_all(as.numeric) 
-
-# timestamp  
-time_id <- "//when" # may vary with data  
-gpx2 <- "data/full.gpx" %>%
-  xpathSApply(gpx2, path = time_id, xmlValue) # get timestamp  
-```
-
 ### Combine, join, union sf objects     
 Combine multiple sf/sfc geometries into one  
 ```{r, join1}