xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
# d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 6, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
plot(r.clust)
plot(v.sample, add = T)
r.clust.sieve <- focal(r.clust, w = 5, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 11, fun = "modal")
writeRaster(r.clust.2ms, filename = "../results/fsc_design_subarea_6_noXY.tif", overwrite = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 6, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 7, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 11, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 5, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 6, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 8, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 7, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 6, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
# write_sf(v.sample, "../results/fsc_design_subarea_10_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
source("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/code/2_sampling_design_zones.R")
write_sf(v.sample, "../results/fsc_design_subarea_6_noXY.gpkg")
15*2
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 11, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 19, fun = "modal")
plot(r.clust.2ms)
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 11, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 31, fun = "modal")
plot(r.clust.2ms)
library(terra)
library(parallel)
library(fields)
library(sf)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
l.rast <- paste0("terrain/", c("reunion_30m.tif", "slope100m-perc.tif", "tpi_1500m.tif"))
r.dem <- rast(l.rast[1])
d.newdata <- as.data.frame(r.dem, xy = T, na.rm = F)
# compareRaster(raster(l.rast[1]), raster(l.rast[2]), orig = T)
# compareRaster(raster(l.rast[1]), raster(l.rast[3]), orig = T)
# # only use every fourth pixel
# t.sel.x <- d.newdata$x %in% seq(min(d.newdata$x), max(d.newdata$x), by = 30*2)
# t.sel.y <- d.newdata$y %in% seq(min(d.newdata$y), max(d.newdata$y), by = 30*2)
# select sub-extent
# 337362.4379,343351.1940,7680822.5380,7684939.5161 [EPSG:32740]
t.sel.x <-  d.newdata$x > 337362.4379 & d.newdata$x < 343351.1940
t.sel.y <-  d.newdata$y > 7680822.5380 & d.newdata$y < 7684939.5161
t.use <- !is.na(d.newdata$reunion_30m) & t.sel.x & t.sel.y
d.newdata <- d.newdata[ t.use, c("x", "y")]
sum(t.use)
# Read in all rasters
d.newrast <- data.frame(matrix(unlist(
t.r <- mclapply(
l.rast,
FUN = function(rr){
xx <- strsplit(rr, split = "/")[[1]]
d.rast <- as.data.frame(rast(rr), na.rm = F)
return(d.rast[ t.use, ])
},
mc.cores = 3)), ncol = length(l.rast)))
names(d.newrast) <- sapply(l.rast, function(rr){
xx <- strsplit(rr, split = "/")[[1]]
return( gsub("-", "\\.", gsub("\\.tif$", "", xx[length(xx)])) )
})
d.newdata <- cbind(d.newdata, d.newrast)
# scale numeric data
rownames(d.newdata) <- 1:nrow(d.newdata)
d.newdata.nosc <- d.newdata
t.fact <- sapply(d.newdata, is.factor)
d.newdata[, !t.fact] <- t.sc <- scale(d.newdata[, !t.fact])
# rounding, do because of convergence problems, see kmeans help page
d.newdata$tpi_1500m <- round(d.newdata$tpi_1500m, 5)
d.newdata$reunion_30m <- round(d.newdata$reunion_30m, 5)
d.newdata$slope100m.perc <- round(d.newdata$slope100m.perc, 5)
# clustering
dat <- d.newdata[, 3:5]
str(dat)
set.seed(11)
m.kmeans <- kmeans(dat, centers = 6, iter.max = 40)
# extract real points closest to cluster center
m.dist <- rdist(dat, m.kmeans$centers)
idx <- apply(m.dist, 2, which.min)
v.sample <- st_as_sf(d.newdata.nosc[idx, ], coords = c("x", "y"), crs = 32740)
write_sf(v.sample, "../results/fsc_design_subarea_6_noXY.gpkg")
d.newdata.nosc$clusters <- fitted(m.kmeans, "classes")
table(d.newdata.nosc$clusters)
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 19, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 19, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 31, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
writeRaster(r.clust.2ms, filename = "../results/fsc_design_subarea_6_smooth.tif", overwrite = T)
?hillshade
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/terrain")
library(terra)
library(terra)
r.dem <- rast("reunion_1m.tif")
r.dem2 <- aggregate(r.dem, 2)
r.dem2s <- focal(r.dem2, w = 7, filename = "reunion_2mS.tif")
r.clust <- rast(d.newdata.nosc[, c(1:2,ncol(d.newdata.nosc))], type="xyz", crs= "epsg:32740")
r.clust.sieve <- focal(r.clust, w = 9, fun = "modal")
r.clust.2m <- disagg(r.clust.sieve, fact = 15, method = "near")
r.clust.2ms <- focal(r.clust.2m, w = 15, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 15, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 15, fun = "modal")
r.clust.2ms <- focal(r.clust.2ms, w = 37, fun = "modal")
plot(r.clust.2ms)
plot(v.sample, add = T)
writeRaster(r.clust.2ms, filename = "../results/fsc_design_subarea_6_smooth.tif", overwrite = T)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/")
writeRaster(r.clust.2ms, filename = "../results/fsc_design_subarea_6_smooth.tif", overwrite = T)
setwd("~/cloud-uu/3_paper_div/2024_geomorphometry/examples/data/terrain")
library(terra)
r.dem <- rast("reunion_1m.tif")
r.dem2 <- aggregate(r.dem, 4)
r.dem2s <- focal(r.dem2, w = 9, filename = "reunion_4mS.tif")
