From e814b05bf1680fba48a459edb7a5ee221f7cd3e4 Mon Sep 17 00:00:00 2001 From: Jeremy Kidwell Date: Mon, 25 Mar 2019 13:30:35 +0000 Subject: [PATCH] finalised hpc version, added calc for scenicareas --- ...draft-wilderness_section-hpc_optimised.Rmd | 93 ++++++++++++++----- 1 file changed, 72 insertions(+), 21 deletions(-) diff --git a/mapping_draft-wilderness_section-hpc_optimised.Rmd b/mapping_draft-wilderness_section-hpc_optimised.Rmd index 3393d00..e628b1c 100644 --- a/mapping_draft-wilderness_section-hpc_optimised.Rmd +++ b/mapping_draft-wilderness_section-hpc_optimised.Rmd @@ -764,8 +764,6 @@ urbanrural_centralbelt_ecs_choropleth_plot <- vp_urbanrural_centralbelt_ecs_choropleth_plot <- viewport(x = 0.5, y = 0.1, height = 6.0/centralbelt_ratio) -# Save to file - # plot full map with inset tmap_mode("plot") @@ -966,8 +964,10 @@ forestinv_simplified <- st_simplify(forestinv) # download.file("https://opendata.arcgis.com/datasets/d7f6b987c7224a72a185ce012258d500_23.zip", destfile = "data/ScenicAreas.zip") # unzip("data/ScenicAreas.zip", exdir = "data") -# scenicareas <- st_read("data/ScenicAreas.shp") -# scenicareas_sp <- readOGR("./data", "ScenicAreas") + +scenicareas <- st_read("data/SG_NationalScenicAreas_1998.shp") %>% st_transform(paste0("+init=epsg:",27700)) +# Generate simplified polygon for plots below +scenicareas_simplified <- st_simplify(scenicareas) # Set symmetrical CRS for analysis below (inserted here in order to correct errors, may be deprecated later) # st_crs(sssi) <- 27700 @@ -1012,6 +1012,9 @@ forestinv_buf500 <- st_buffer(forestinv_simplified, dist = 500) # forestinv_buf500_lines = st_union(forestinv_simplified) %>% st_buffer(500) %>% # st_cast(to = "LINESTRING") +scenicareas_buf50 <- st_buffer(scenicareas_simplified, dist = 50) +scenicareas_buf500 <- st_buffer(scenicareas_simplified, dist = 500) + # Calculate number of groups within polygons # calculate coincidence of ecs points within each polygons and buffers for each @@ -1023,21 +1026,26 @@ forestinv_buf500 <- st_buffer(forestinv_simplified, dist = 500) # plot(lnd[ sel, ], col = "turquoise", add = TRUE) # add selected zones to map # from https://gotellilab.github.io/Bio381/StudentPresentations/SpatialDataTutorial.html -ecs_sf_sssi <- st_within(ecs_sf, sssi) +ecs_sf_sssi <- st_within(ecs_sf, sssi_simplified) ecs_sf_sssi50m <- st_within(ecs_sf, sssi_buf50) ecs_sf_sssi500m <- st_within(ecs_sf, sssi_buf500) ecs_sf_sssibeyond500m <- !(st_within(ecs_sf, sssi_buf500)) -ecs_sf_wildland <- st_within(ecs_sf, wildland) +ecs_sf_wildland <- st_within(ecs_sf, wildland_simplified) ecs_sf_wildland50m <- st_within(ecs_sf, wildland_buf50) ecs_sf_wildland500m <- st_within(ecs_sf, wildland_buf500) ecs_sf_wildlandbeyond500m <- !(st_within(ecs_sf, wildland_buf500)) -ecs_sf_forestinv <- st_within(ecs_sf, forestinv) +ecs_sf_forestinv <- st_within(ecs_sf, forestinv_simplified) ecs_sf_forestinv50m <- st_within(ecs_sf, forestinv_buf50) ecs_sf_forestinv500m <- st_within(ecs_sf, forestinv_buf500) ecs_sf_forestinvbeyond500m <- !(st_within(ecs_sf, forestinv_buf500)) +ecs_sf_scenicareas <- st_within(ecs_sf, scenicareas_simplified) +ecs_sf_scenicareas50m <- st_within(ecs_sf, scenicareas_buf50) +ecs_sf_scenicareas500m <- st_within(ecs_sf, scenicareas_buf500) +ecs_sf_scenicareasbeyond500m <- !(st_within(ecs_sf, scenicareas_buf500)) + # TODO: implement more efficient code using do.call() function or sapply() as here https://stackoverflow.com/questions/3642535/creating-an-r-dataframe-row-by-row # Generate dataframe based on SSSI buffers @@ -1045,13 +1053,13 @@ ecs_sf_forestinvbeyond500m <- !(st_within(ecs_sf, forestinv_buf500)) # Calculate incidence of ecs within SSSI and within buffers at 50/500m ecs_sssi_row <- c(sum(apply(st_within(ecs_sf, sssi_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, sssi_buf500, sparse=FALSE), 1, any))) -pow_sssi_row <- c(sum(apply(st_within(pow_pointX_sf, sssi, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, sssi_buf500, sparse=FALSE), 1, any))) +pow_sssi_row <- c(sum(apply(st_within(pow_pointX_sf, sssi_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, sssi_buf500, sparse=FALSE), 1, any))) -dtas_sssi_row <- c(sum(apply(st_within(dtas_sf, sssi, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, sssi_buf500, sparse=FALSE), 1, any))) +dtas_sssi_row <- c(sum(apply(st_within(dtas_sf, sssi_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, sssi_buf500, sparse=FALSE), 1, any))) -transition_sssi_row <- c(sum(apply(st_within(transition_sf, sssi, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, sssi_buf500, sparse=FALSE), 1, any))) +transition_sssi_row <- c(sum(apply(st_within(transition_sf, sssi_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, sssi_buf500, sparse=FALSE), 1, any))) -permaculture_sssi_row <- c(sum(apply(st_within(permaculture_sf, sssi, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, sssi_buf500, sparse=FALSE), 1, any))) +permaculture_sssi_row <- c(sum(apply(st_within(permaculture_sf, sssi_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, sssi_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, sssi_buf500, sparse=FALSE), 1, any))) # Generate dataframe from rows based on counts sssi_counts <- rbind(ecs_sssi_row, pow_sssi_row) @@ -1080,18 +1088,18 @@ sssi_counts_merged <- cbind(sssi_counts, sssi_counts_pct) # Generate dataframe based on wildland buffers -ecs_wildland_row <- c(sum(apply(st_within(ecs_sf, wildland, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, wildland_buf500, sparse=FALSE), 1, any))) +ecs_wildland_row <- c(sum(apply(st_within(ecs_sf, wildland_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, wildland_buf500, sparse=FALSE), 1, any))) -pow_wildland_row <- c(sum(apply(st_within(pow_pointX_sf, wildland, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, wildland_buf500, sparse=FALSE), 1, any))) +pow_wildland_row <- c(sum(apply(st_within(pow_pointX_sf, wildland_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, wildland_buf500, sparse=FALSE), 1, any))) wildland_counts <- rbind(ecs_wildland_row, pow_wildland_row) -dtas_wildland_row <- c(sum(apply(st_within(dtas_sf, wildland, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, wildland_buf500, sparse=FALSE), 1, any))) +dtas_wildland_row <- c(sum(apply(st_within(dtas_sf, wildland_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, wildland_buf500, sparse=FALSE), 1, any))) wildland_counts <- rbind(wildland_counts, dtas_wildland_row) -transition_wildland_row <- c(sum(apply(st_within(transition_sf, wildland, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, wildland_buf500, sparse=FALSE), 1, any))) +transition_wildland_row <- c(sum(apply(st_within(transition_sf, wildland_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, wildland_buf500, sparse=FALSE), 1, any))) wildland_counts <- rbind(wildland_counts, transition_wildland_row) -permaculture_wildland_row <- c(sum(apply(st_within(permaculture_sf, wildland, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, wildland_buf500, sparse=FALSE), 1, any))) +permaculture_wildland_row <- c(sum(apply(st_within(permaculture_sf, wildland_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, wildland_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, wildland_buf500, sparse=FALSE), 1, any))) wildland_counts <- rbind(wildland_counts, permaculture_wildland_row) colnames(wildland_counts) <- c("Within Wildland Areas", "...50m", "...500m") @@ -1115,18 +1123,18 @@ wildland_counts_merged <- cbind(wildland_counts, wildland_counts_pct) # Generate dataframe based on forestinv buffers -ecs_forestinv_row <- c(sum(apply(st_within(ecs_sf, forestinv, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, forestinv_buf500, sparse=FALSE), 1, any))) +ecs_forestinv_row <- c(sum(apply(st_within(ecs_sf, forestinv_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, forestinv_buf500, sparse=FALSE), 1, any))) -pow_forestinv_row <- c(sum(apply(st_within(pow_pointX_sf, forestinv, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, forestinv_buf500, sparse=FALSE), 1, any))) +pow_forestinv_row <- c(sum(apply(st_within(pow_pointX_sf, forestinv_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, forestinv_buf500, sparse=FALSE), 1, any))) forestinv_counts <- rbind(ecs_forestinv_row, pow_forestinv_row) -dtas_forestinv_row <- c(sum(apply(st_within(dtas_sf, forestinv, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, forestinv_buf500, sparse=FALSE), 1, any))) +dtas_forestinv_row <- c(sum(apply(st_within(dtas_sf, forestinv_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, forestinv_buf500, sparse=FALSE), 1, any))) forestinv_counts <- rbind(forestinv_counts, dtas_forestinv_row) -transition_forestinv_row <- c(sum(apply(st_within(transition_sf, forestinv, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, forestinv_buf500, sparse=FALSE), 1, any))) +transition_forestinv_row <- c(sum(apply(st_within(transition_sf, forestinv_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, forestinv_buf500, sparse=FALSE), 1, any))) forestinv_counts <- rbind(forestinv_counts, transition_forestinv_row) -permaculture_forestinv_row <- c(sum(apply(st_within(permaculture_sf, forestinv, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, forestinv_buf500, sparse=FALSE), 1, any))) +permaculture_forestinv_row <- c(sum(apply(st_within(permaculture_sf, forestinv_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, forestinv_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, forestinv_buf500, sparse=FALSE), 1, any))) forestinv_counts <- rbind(forestinv_counts, permaculture_forestinv_row) colnames(forestinv_counts) <- c("Within Woodlands", "...50m", "...500m") @@ -1147,6 +1155,42 @@ colnames(forestinv_counts_pct) <- c("% Within Woodlands", "% within 50m", "% wit # Merge into larger dataframe forestinv_counts_merged <- cbind(forestinv_counts, forestinv_counts_pct) +# Generate dataframe based on scenicareas buffers + +ecs_scenicareas_row <- c(sum(apply(st_within(ecs_sf, scenicareas_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, scenicareas_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(ecs_sf, scenicareas_buf500, sparse=FALSE), 1, any))) + +pow_scenicareas_row <- c(sum(apply(st_within(pow_pointX_sf, scenicareas_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, scenicareas_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(pow_pointX_sf, scenicareas_buf500, sparse=FALSE), 1, any))) +scenicareas_counts <- rbind(ecs_scenicareas_row, pow_scenicareas_row) + +dtas_scenicareas_row <- c(sum(apply(st_within(dtas_sf, scenicareas_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, scenicareas_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(dtas_sf, scenicareas_buf500, sparse=FALSE), 1, any))) +scenicareas_counts <- rbind(scenicareas_counts, dtas_scenicareas_row) + +transition_scenicareas_row <- c(sum(apply(st_within(transition_sf, scenicareas_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, scenicareas_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(transition_sf, scenicareas_buf500, sparse=FALSE), 1, any))) +scenicareas_counts <- rbind(scenicareas_counts, transition_scenicareas_row) + +permaculture_scenicareas_row <- c(sum(apply(st_within(permaculture_sf, scenicareas_simplified, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, scenicareas_buf50, sparse=FALSE), 1, any)), sum(apply(st_within(permaculture_sf, scenicareas_buf500, sparse=FALSE), 1, any))) +scenicareas_counts <- rbind(scenicareas_counts, permaculture_scenicareas_row) + +colnames(scenicareas_counts) <- c("Within Scenic Areas", "...50m", "...500m") + +# Generate dataframe from rows based on percentages of totals + +ecs_scenicareas_row_pct <- ecs_scenicareas_row/length(ecs_sf) +pow_scenicareas_row_pct <- pow_scenicareas_row/length(pow_pointX) +dtas_scenicareas_row_pct <- dtas_scenicareas_row/length(dtas) +transition_scenicareas_row_pct <- transition_scenicareas_row/length(transition) +permaculture_scenicareas_row_pct <- permaculture_scenicareas_row/length(permaculture) + +scenicareas_counts_pct <- rbind(ecs_scenicareas_row_pct, pow_scenicareas_row_pct) +scenicareas_counts_pct <- rbind(scenicareas_counts_pct, dtas_scenicareas_row_pct) +scenicareas_counts_pct <- rbind(scenicareas_counts_pct, transition_scenicareas_row_pct) +scenicareas_counts_pct <- rbind(scenicareas_counts_pct, permaculture_scenicareas_row_pct) +colnames(scenicareas_counts_pct) <- c("% Within scenicareass", "% within 50m", "% within 500m") + +# Merge into larger dataframe +scenicareas_counts_merged <- cbind(scenicareas_counts, scenicareas_counts_pct) + + ``` # Proximity to "Wilderness" @@ -1173,10 +1217,16 @@ forestinv_counts_merged %>% kable(format = "html", col.names = colnames(forestinv_counts_merged), caption = "Group counts within woodlands") %>% kable_styling(bootstrap_options = c("striped", "hover", "condensed", full_width = F, "responsive")) +scenicareas_counts_merged %>% + kable(format = "html", col.names = colnames(scenicareas_counts_merged), caption = "Group counts within woodlands") %>% + kable_styling(bootstrap_options = c("striped", "hover", "condensed", full_width = F, "responsive")) + + # Output CSV files for tables above write.csv(sssi_counts_merged, "derivedData/sssi_counts_merged.csv", row.names=TRUE) write.csv(wildland_counts_merged, "derivedData/wildland_counts_merged.csv", row.names=TRUE) write.csv(forestinv_counts_merged, "derivedData/forestinv_counts_merged.csv", row.names=TRUE) +write.csv(scenicareas_counts_merged, "derivedData/scenicareas_counts_merged.csv", row.names=TRUE) ``` @@ -1219,6 +1269,7 @@ tm_shape(sssi_simplified, bbox = scotland) + tm_shape(sssi_simplified, bbox = scotland) + tm_fill(col = "blue", alpha = 0.4, lwd=0.01, title = "Wilderness Areas") + tm_shape(wildland_simplified, bbox = scotland) + tm_fill(col = "green", alpha = 0.4, lwd=0.01) + tm_shape(forestinv_simplified, bbox = scotland) + tm_fill(col = "orange", alpha = 0.4, lwd=0.01) + + tm_shape(scenicareas_simplified, bbox = scotland) + tm_fill(col = "orange", alpha = 0.4, lwd=0.01) + tm_shape(admin_lev1) + tm_borders(lwd=0.01) + # tm_scale_bar(breaks = c(0, 100, 200), size = 1) + tm_shape(ecs_sf) + tm_dots("red", size = .02, alpha = .4) +