Skip to content

Commit

Permalink
Merge pull request #26 from bevingtona/patch-2
Browse files Browse the repository at this point in the history
Create raster_to_clean_polygon.R function to clean and polygonize the wetland raster output
  • Loading branch information
dfilatow authored Nov 27, 2020
2 parents f060038 + bd46fb5 commit 36472e3
Showing 1 changed file with 93 additions and 0 deletions.
93 changes: 93 additions & 0 deletions R/raster_to_clean_polygon.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
# SCRIPT TO POLYGONIZE, CLEAN, and SMOOTH RASTER OUTPUT (in tiles)
# To do: add functionnality to stitch tiles using "summarize"
# To do: compare smoothing results

# *****REQUIRES DEV VERSION OF STARS**** devtools::install_github("r-spatial/stars")

library(smoothr)
library(dplyr)
library(stars)
library(sf)

#### RASTER TO POLYGON FUNCTION ####

# READ CLASSIFIED RASTER
r <- stars::read_stars('data/out/3CategoryPrediction/20190926-103025_map_recl.tif', proxy = F)
d <- st_dimensions(r)
int <- 1000
x_seq <- seq(d$x$from,d$x$to+int,int)

# CLEANING FUNCTION (PER TILE)
ras_to_clean_pol <- function(seq_along = 1,
out_folder = "data/clean/",
out_format = "kml",
wetland_class_number = c(2),
min_area_drop_m2 = 625 * 4,
max_area_fill_m2 = 625 * 4,
raw_out = F,
clean_out = F,
smooth_out = T,
smooth_method = "chaikin",
return = T
){

write.csv("", paste0(out_folder,seq_along,"_start.txt"))
# CLIP MY TILE
my_tile <- r[1,x_seq[seq_along]:x_seq[seq_along+1],] %>% st_as_stars()
# print("ok subset")

# POLYGONIZE (AND DISSOLVE/MERGE BY CLASS)
p <- sf::st_as_sf(my_tile,
as_points = F,
merge = T)
# print("ok poly")

# RENAME FIELDS
names(p) <- c("class","geometry")

# SELECT WETLANDS OF INTEREST
p <- p %>%
filter(class %in% wetland_class_number)

# CALCULATE AREA (m2) (based on trim 25x25 data, so 625 m2 is one pixel)
p <- p %>%
mutate(area = st_area(.))
# print("ok area")

if(raw_out == T){
write_sf(p, paste0(out_folder,seq_along,"_raw.",out_format))
# print("ok raw")
}

# FILTER AREA (i.e. DROP CRUMBS)
p <- p %>%
filter(area > units::as_units(min_area_drop_m2, "m2"))
# print("ok crumbs")

# FILL HOLES
p <- p %>%
fill_holes(threshold = units::as_units(max_area_fill_m2, "m2"))
# print("ok holes")

# WRITE CLEAN
if(clean_out == T){
write_sf(p, paste0(out_folder,seq_along,"_clean.",out_format))
# print("ok clean")
}

# SMOOTH POLYGONS
if(smooth_out == T){
p_sm <- smooth(p, method = smooth_method)
write_sf(p_sm, paste0(out_folder,seq_along,"_smooth.",out_format))
# print("ok smooth")
}

if(return == "clean"){
return(p)
}
if(return == "smooth"){
return(p_sm)
}
}

pol <- do.call(rbind, lapply(1:length(x_seq), ras_to_clean_pol))

0 comments on commit 36472e3

Please sign in to comment.