-
Notifications
You must be signed in to change notification settings - Fork 0
/
map.Rmd
126 lines (97 loc) · 3.75 KB
/
map.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
---
title: "coastalsheds output"
author: "Kelly Hondula"
date: "5/28/2019"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(sf)
library(fs)
library(purrr)
library(data.table)
library(leaflet)
```
Read in points
```{r}
data_dir_coastalsheds <- "/nfs/khondula-data/coastalsheds"
ncaa_coords_sf_prj <- st_read(file.path(data_dir_coastalsheds, "ncaa_coords", "ncaa_coords_wgs84.shp")) %>%
st_transform(4269)
```
Read in unioned huc12 sheds and combine into one sf object
```{r}
huc12shed_shpfiles <- fs::dir_ls(file.path(data_dir_coastalsheds, "ncaa_huc12sheds_union"), glob = "*.shp")
length(huc12shed_shpfiles)
huc12shed_ids <- basename(huc12shed_shpfiles) %>% stringr::str_replace("_huc12shed_union.shp", "")
huc12sheds_list <- purrr::map(huc12shed_shpfiles, ~st_read(.x))
huc12sheds_list <- purrr::map(huc12sheds_list, ~st_cast(.x, "MULTIPOLYGON"))
names(huc12sheds_list) <- huc12shed_ids
huc12sheds_list <- purrr::map(huc12shed_ids, ~mutate(huc12sheds_list[[.x]], SITE_ID = .x))
huc12sheds <- sf::st_as_sf(data.table::rbindlist(huc12sheds_list))
# save as one shapefile
head(huc12sheds)
huc12sheds %>% st_write(file.path(data_dir_coastalsheds, "huc12sheds_union.shp"))
# save as google earth file
huc12sheds %>% mutate(Name = SITE_ID) %>% st_write(file.path(data_dir_coastalsheds, "huc12sheds_union.kml"))
# save points as google earth file
ncaa_coords_sf %>% mutate(Name = SITE_ID) %>% st_write(file.path(data_dir_coastalsheds, "ncaa_points.kml"))
```
Plot leaflet map for a select site id with watershed
```{r}
ncaa_coords_sf_prj <- st_read(file.path(data_dir_coastalsheds, "ncaa_coords", "ncaa_coords_wgs84.shp")) %>%
st_transform(4269)
ncaa_siteIDs <- ncaa_coords_sf_prj$SITE_ %>% unique()
huc12sheds <- st_read(file.path(data_dir_coastalsheds, "huc12sheds_union.shp"))
huc12shed_shpfiles <- fs::dir_ls(file.path(data_dir_coastalsheds, "ncaa_huc12sheds"), glob = "*.shp")
```
Select a site ID
```{r}
ncaa_siteID <- ncaa_siteIDs[510] %>% as.character()
```
Plot point and huc12shed
```{r}
huc12shed_shpfile <- grep(pattern = ncaa_siteID, huc12shed_shpfiles, value = TRUE)
huc12shed <- st_read(huc12shed_shpfile)
huc12shed_union <- filter(huc12sheds, SITE_ID == ncaa_siteID)
ncaa_pt <- filter(ncaa_coords_sf_prj, SITE_ == ncaa_siteID)
# plot
leaflet() %>%
addTiles() %>%
addPolygons(data = huc12shed, color = "green", fillOpacity = 0.1) %>%
addPolygons(data = huc12shed_union, fillOpacity = 0) %>%
addMarkers(data = ncaa_pt)
```
Save as images
```{r}
library(ggplot2)
library(rosm)
library(RStoolbox)
ncaa_siteID <- ncaa_siteIDs[510] %>% as.character()
# make sure huc12shed_shpfiles, huc12sheds, and ncaa_coords_sf_prj exist in environment
save_watershed_map <- function(ncaa_siteID){
huc12shed_shpfile <- grep(pattern = ncaa_siteID, huc12shed_shpfiles, value = TRUE)
huc12shed <- st_read(huc12shed_shpfile)
huc12shed_union <- filter(huc12sheds, SITE_ID == ncaa_siteID)
ncaa_pt <- filter(ncaa_coords_sf_prj, SITE_ == ncaa_siteID)
myextent <- sp::bbox(as(huc12shed, "Spatial"))
osm1 <- osm.raster(myextent)
huc12shed_prj <- st_transform(huc12shed, 3857)
m1 <- ggRGB(osm1, ggObj = TRUE, r = 1, g = 2, b = 3)
m2 <- m1 +
geom_sf(data = huc12shed_prj, color = "black", fill = "yellow", alpha = 0.1, lwd = 1.5) +
geom_sf(data = st_transform(ncaa_pt, 3857), pch = 21, fill = "red", size = 3) +
theme_minimal() +
ggtitle(ncaa_siteID) +
xlab(element_blank()) +
ylab(element_blank())
filename <- sprintf("maps/%s.png", ncaa_siteID)
png(filename, width = 1000, height = 800)
print(m2)
dev.off()
}
```
```{r}
ncaa_siteIDs <- ncaa_siteIDs %>% as.character()
save_watershed_map(ncaa_siteID = ncaa_siteIDs[1])
purrr::walk(ncaa_siteIDs, ~save_watershed_map(.x)) # This will take a long time.
```