In ghTaranto/scapesClassification: User-Defined Classification of Raster Surfaces
knitr::opts_chunk$set(echo = TRUE, fig.align='center', message=FALSE, warning=FALSE, out.width = "95%" )
Functions: cond.4.nofn(), anchor.seed(), pi.sgm(), obj.border() and obj.nbs().
Object functions are functions used to identify and manipulate raster objects.
Input data
We will use a single-layer dummy raster to illustrate scapesClassification functions. We will start by computing its attribute table (where the raster is named "dummy_var") and its list of neighborhoods.
# LOAD LIBRARIES
library(scapesClassification)
library(terra)
# LOAD THE DUMMY RASTER
r <- list.files(system.file("extdata", package = "scapesClassification"),
pattern = "dummy_raster\\.tif", full.names = T)
r <- rast(r)
# COMPUTE THE ATTRIBUTE TABLE
at <- attTbl(r, "dummy_var")
head(at, 3)
# COMPUTE THE LIST OF NEIGBORHOODS
nbs <- ngbList(r)
head(nbs, 3)
Plots
In the following examples we will show how class vectors are computed. However, in order to improve the reading experience, the plots' code is hidden. It can be accessed in the *.RMD file used to generate the html file.
The plotting procedure is to (i) convert a class vectors into a raster using the function cv.2.rast() and to (ii) visualize the raster using R or an external software. In our examples we will use the R package terra and its function terra::plot().
Manipulation functions
Functions: anchor.seed() and cond.4.nofn().
Raster object manipulation functions can be used to identify and manipulate raster objects.
anchor.seed
The function anchor.seed() can be considered as an anchor cell function as well as a raster object function. Its two principal uses are: (i) identify cells having particular characteristics (seed cells) and define around them growth and isolation buffers; (ii) assign unique IDs to groups of cells having particular characteristics.
Condition arguments
The function anchor.seed() take as inputs four sets of conditions:
-
cond.filter, the conditions to define what cells have to be evaluated by the function.
-
cond.seed, the conditions to identify, at each iteration, the seed cell. The seed cell is the cell around which growth and isolation conditions are applied.
-
cond.growth, the conditions to define a buffer around the seed cell.
-
cond.isol, the conditions to isolate one seed cell (and its buffer) from another.
Condition evaluation
The first set of conditions to be evaluated is the cond.filter. The evaluation of the remaining sets of conditions is iterative (Figure 1):
-
A seed cell is identified and receives a classification number (as specified by the argument class). If the argument class=NULL, then a new ID is assigned to every new seed cell.
-
Cells connected with the seed cell meeting the conditions of cond.growth are assigned to the same class of the seed cell (growth buffer). The rule evaluation take into account class continuity.
-
Cells connected with the seed cell (or with its growth buffer) meeting the conditions of cond.isol are assigned to the isolation buffer (class = -999). The rule evaluation take into account class continuity.
-
Once seed, growth and isolation cells are identified, they are ignored in all successive iterations.
We can compute a new class vector based on the following rules. The two iterations performed by the function are showed in (Figure 1):
# Anchor seed
cv <- anchor.seed(at, nbs, class = 1,
cond.filter = "dummy_var > 2",
cond.seed = "dummy_var == max(dummy_var)",
cond.growth = NULL,
cond.isol = "dummy_var < dummy_var[]") # focal cell condition (see ?conditions)
#CONDITION FILTER
at$cf <- cond.4.all(at, cond = "dummy_var > 2", class = 1)
#ITERATION 1
cs1 <- cond.4.all(at, cond = "dummy_var == 10", class = 1)
ci1 <- cond.4.nofn(at, nbs,
classVector = cs1,
nbs_of = c(1, -1),
cond = "dummy_var < dummy_var[] & !is.na(cf)",
class = -1)
#ITERATION 2
cs2 <- cond.4.all(at, classVector = ci1,
cond = "dummy_var == 8 & !is.na(cf)",
class = 1)
ci2 <- cond.4.nofn(at, nbs,
classVector = cs2,
nbs_of = c(1, -1),
cond = "dummy_var < dummy_var[] & !is.na(cf)",
class = -1)
#CLASS VECTORS TO RASTERS
r_cf <- cv.2.rast(r, classVector = at$cf)
r_cs1 <- cv.2.rast(r, classVector = cs1)
r_ci1 <- cv.2.rast(r, classVector = ci1)
r_cs2 <- cv.2.rast(r, classVector = cs2)
r_ci2 <- cv.2.rast(r, classVector = ci2)
rl <- r;rl[]<-NA; rl[1:3]<-1:3
# PLOTS #####################################################################
# par(mfrow=c(3,3))
layout(matrix(c(1, 1, 2, 2, 3, 3,
1, 1, 2, 2, 3, 3,
4, 4, 5, 5, 6, 6,
4, 4, 5, 5, 6, 6), nrow=4, byrow=TRUE))
m <- c(0,1,0,1)
# 1. ITERATION 0
plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE,
ylim=c(-0.05,1.10), mar=m)
text(r); lines(r)
text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 0.0", family = "serif")
text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.filter", family = "serif")
# 2. ITERATION 1.1
plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m)
plot(r_cs1, type="classes", col="#98fb98", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m,
add = TRUE)
text(r); lines(r)
text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 1.1", family = "serif")
text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.seed", family = "serif")
# 3. ITERATION 1.2
plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m)
plot(r_ci1, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE,
ylim=c(-0.05,1.10), mar=m, add = TRUE)
text(r); lines(r)
text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 1.2", family = "serif")
text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.isol", family = "serif")
# 4. LEGEND
plot(rl, type="classes", col="white", legend=FALSE, axes=FALSE)
legend(x=-0.05, y=1, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5,
fill = "#78b2c4",legend = "cond.fiter")
text(x=0.22, y=0.93, cex=1.2, font=1, adj=c(0,1), "'dummy_var>2'", family = "serif",col="#818792")
legend(x=-0.05, y=0.70, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5,
fill = "#98fb98",legend = "cond.seed")
text(x=0.22, y=0.63, cex=1.2, font=1, adj=c(0,1), "'dummy_var==\nmax(dummy_var)'", family = "serif",col="#818792")
legend(x=-0.05, y=0.4, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5,
fill = "transparent",legend = "cond.growth")
text(x=0.22, y=0.33, cex=1.2, font=1, adj=c(0,1), "NULL", family = "serif",col="#818792")
legend(x=-0.05, y=0.1, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5,
fill = "#d76968",legend = "cond.isol")
text(x=0.22, y=0.03, cex=1.2, font=1, adj=c(0,1), "'dummy_var < \ndummy_var[]'", family = "serif",col="#818792")
# 5. ITERATION 2.1
plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m)
plot(r_cs2, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE,
ylim=c(-0.05,1.10), mar=m, add = TRUE)
text(r); lines(r)
text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 2.1", family = "serif")
text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.seed", family = "serif")
# 6. ITERATION 2.2
plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m)
plot(r_ci2, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE,
ylim=c(-0.05,1.10), mar=m, add = TRUE)
text(r); lines(r)
text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 2.2", family = "serif")
text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.isol", family = "serif")
**Figure 1 - Anchor.seed rule evaluation**. Before the iterations start, `cond.filter` determines what cells have to be evaluated. The other rules are applied in the following order: (i) `cond.seed` identifies a seed cell; (ii) `cond.growth` identifies a growth buffer around the seed cell; (iii) `cond.isol` identifies an isolation buffer around the seed cell and its growth buffer. The function runs for two iterations and identifies two seed cells.
Evaluation lag
The function arguments lag.growth and lag.isol control the evaluation lag of relative focal cell conditions (Figure 2).
-
When lag.* are set to 0, relative focal cell conditions have a standard behavior and compare the values of the test cells against the value of the focal cell.
-
When lag.* are set to Inf, relative focal cell conditions compare the value of the test cells against the value of the seed cell identified at the start of the iteration.
# a. lag.growth=0
cv1 <- anchor.seed(at, nbs, class = NULL, # a new class for every seed and growth buffer
cond.filter = "dummy_var>1",
cond.seed = "dummy_var == max(dummy_var)",
cond.growth = "dummy_var<dummy_var[]", # focal cell condition (see ?conditions)
lag.growth = 0,
cond.isol = NULL)
# b. lag.growth=Inf
cv2 <- anchor.seed(at, nbs, class = NULL, # a new class for every seed and growth buffer
cond.filter = "dummy_var>1",
cond.seed = "dummy_var == max(dummy_var)",
cond.growth = "dummy_var<dummy_var[]", # focal cell condition (see ?conditions)
lag.growth = Inf,
cond.isol = NULL)
# CONVERT THE CLASS VECTORS INTO A RASTER
r_cv1 <- cv.2.rast(r, classVector = cv1)
r_cv2 <- cv.2.rast(r, classVector = cv2)
layout(matrix(c(1, 2,
1, 2), nrow=2, byrow=TRUE))
m <- c(1,1,0,3)
# PLOT 1
################################################################################
plot(r_cv1, type = "classes", ylim=c(-0.15,1.10), mar = m, axes=FALSE,
col=c("#78b2c4","#98fb98"),
plg=list(x=1, y=1, cex=0.9, title = "Obj.:", title.adj = 0.2,
legend=c("1","2")))
text(r)
lines(r)
text(x=0, y=1.03, cex=1.3, font=2, adj=0, "(a) cv1", family = "serif")
text(x=1, y=1.03, cex=1.3, font=2, adj=1, "lag.growth = 0", family = "serif",
col="#818792")
text(xFromCell(r,c(20,43)),yFromCell(r,c(20,43))-0.05,c("SEED 1", "SEED 2"),
col="red",cex=0.85)
text(x=0, y=-0.04, cex=1.1, font=1, adj=0, "cond.filter:",
family = "serif", col="#818792")
text(x=0.28, y=-0.04, cex=1.1, font=1, adj=0, "dummy_var > 1",
family = "serif", col="#818792")
text(x=0, y=-0.1, cex=1.1, font=1, adj=0, "cond.seed:",
family = "serif", col="#818792")
text(x=0.28, y=-0.1, cex=1.1, font=1, adj=0, "dummy_var == max(dummy_var)",
family = "serif", col="#818792")
text(x=0, y=-0.16, cex=1.1, font=1, adj=0, "cond.growth:",
family = "serif", col="#818792")
text(x=0.28, y=-0.16, cex=1.1, font=1, adj=0, "dummy_var < dummy_var[ ]",
family = "serif", col="#818792")
# PLOT 2
################################################################################
plot(r_cv2, type = "classes", ylim=c(-0.15,1.10), mar = m, axes=FALSE,
col=c("#78b2c4"),
plg=list(x=1, y=1, cex=0.9, title = "Obj.:", title.adj = 0.2,
legend=c("1")))
text(r)
lines(r)
text(x=0, y=1.03, cex=1.3, font=2, adj=0, "(b) cv2", family = "serif")
text(x=1, y=1.03, cex=1.3, font=2, adj=1, "lag.growth = Inf", family = "serif",
col="#818792")
text(xFromCell(r,20),yFromCell(r,20)-0.05,"SEED 1",col="red",cex=0.85)
text(x=0, y=-0.04, cex=1.1, font=1, adj=0, "cond.filter:",
family = "serif", col="#818792")
text(x=0.28, y=-0.04, cex=1.1, font=1, adj=0, "dummy_var > 1",
family = "serif", col="#818792")
text(x=0, y=-0.1, cex=1.1, font=1, adj=0, "cond.seed:",
family = "serif", col="#818792")
text(x=0.28, y=-0.1, cex=1.1, font=1, adj=0, "dummy_var == max(dummy_var)",
family = "serif", col="#818792")
text(x=0, y=-0.16, cex=1.1, font=1, adj=0, "cond.growth:",
family = "serif", col="#818792")
text(x=0.28, y=-0.16, cex=1.1, font=1, adj=0, "dummy_var < dummy_var[ ]",
family = "serif", col="#818792")
**Figure 2 - Anchor.seed evaluation lag**. The function arguments `lag.*` control the evaluation lag of relative focal cell conditions (`[]`). **(a)** `lag.growth = 0`, `cond.growth` compares the values of test cells against the value of the focal cell; two objects identified. **(b)** `lag.growth = Inf`, `cond.growth` compares the values of test cells against the value of the seed cell; one objects identified.
cond.4.nofn (hgrowth) {#hgrowth}
The function cond.4.nofn() can be used to expand the borders of raster objects. This functionality is activated with the argument hgrowth = TRUE (homogeneous growth, see ?cond.4.nofn for additional details).
In the following example we will: (i) identify peak cells (peak.cell), (ii) assign a unique ID to each peak (anchor.seed) and (iii) use the function cond.4.nofn() to expand the borders of the two peak objects. The borders are expanded based on the focal cell rule dummy_var <= dummy_var[] and on the test cell rule dummy_var > 1 (Figure 3c).
Note that intermediate class vectors are added as column vectors in the attribute table; in this way they can be accessed by name and used in classification rules.
# IDENTIFY RASTER OBJECTS (a,b) AND RESHAPE THEIR BORDERS (c)
# a. cv0, identify peak cells
at$cv0 <- peak.cell(attTbl = at, ngbList = nbs, p_edge = TRUE,
p_col = "dummy_var", p_fun = "max")
# b. cv1, assign unique IDs
at$cv1 <- anchor.seed(at, nbs, silent = TRUE, class = NULL, # a new class for every seed and growth buffer
cond.filter = "!is.na(cv0)",
cond.seed = "TRUE")
# c. cv2, homogeneous growth of raster objects
at$cv2 <- cond.4.nofn(attTbl = at, ngbList = nbs, classVector = at$cv1,
nbs_of = c(1, 2), class = NULL,
cond = "dummy_var <= dummy_var[] & dummy_var > 1",
hgrowth = TRUE) # HOMOGENEOUS GROWTH
# CONVERT THE CLASS VECTORS INTO A RASTER
r_cv0 <- cv.2.rast(r, classVector = at$cv0)
r_cv1 <- cv.2.rast(r, classVector = at$cv1)
r_cv2 <- cv.2.rast(r, classVector = at$cv2)
layout(matrix(c(1, 2,
1, 2,
3, 4,
3, 4), nrow=4, byrow=TRUE))
m <- c(1,0.5,0,0.5)
# PLOT 1
################################################################################
plot(r_cv0, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#98fb98"),
plg=list(x=.99, y=1, cex=1.0, title = "Class:", title.adj = 0.2,
legend=c("peak\ncell")))
text(r);lines(r)
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(a) cv0", family = "serif")
# PLOT 2
################################################################################
plot(r_cv1, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#78b2c4","#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2")))
text(r);lines(r)
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(b) cv1", family = "serif")
# PLOT 3
################################################################################
plot(r_cv2, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#78b2c4","#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2")))
text(r);lines(r)
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(c) cv2", family = "serif")
# PLOT 4 -LEGEND
################################################################################
plot(r, type="classes", col="white", legend=FALSE, mar=m, axes=FALSE, ylim=c(-0.10,1.08))
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "Classification steps:", family = "serif")
# step 1
text(x=0.04, y=0.94, cex=1.7, font=2, adj=0, "cv0", family = "serif")
text(x=0.04, y=0.87, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif",
col="#818792")
text(x=0.24, y=0.87, cex=1.5, font=1, adj=c(0,1), "peak.cell", family = "serif",
col="#818792")
text(x=0.04, y=0.77, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif",
col="#818792")
text(x=0.24, y=0.77, cex=1.5, font=1, adj=c(0,1), "local maxima", family = "serif",
col="#818792")
# step 2
text(x=0.04, y=0.63, cex=1.7, font=2, adj=0, "cv1", family = "serif")
text(x=0.04, y=0.56, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif",
col="#818792")
text(x=0.24, y=0.56, cex=1.5, font=1, adj=c(0,1), "anchor.seed", family = "serif",
col="#818792")
text(x=0.04, y=0.46, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif",
col="#818792")
text(x=0.24, y=0.46, cex=1.5, font=1, adj=c(0,1),
"cond.filter = !is.na(cv0)", family = "serif",
col="#818792")
text(x=0.24, y=0.38, cex=1.5, font=1, adj=c(0,1),
"cond.seed = TRUE", family = "serif",
col="#818792")
# step 3
text(x=0.04, y=0.25, cex=1.7, font=2, adj=0, "cv2", family = "serif")
text(x=0.04, y=0.18, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif",
col="#818792")
text(x=0.24, y=0.18, cex=1.5, font=1, adj=c(0,1), "cond.4.nofn (hgrowth=TRUE)", family = "serif",
col="#818792")
text(x=0.04, y=0.08, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif",
col="#818792")
text(x=0.24, y=0.08, cex=1.5, font=1, adj=c(0,1), "dummy_var <= dummy_var[ ]", family = "serif",
col="#818792")
text(x=0.24, y=0.00, cex=1.5, font=1, adj=c(0,1), "& dummy_var > 1", family = "serif",
col="#818792")
**Figure 3 - Identify raster objects and reshape their borders. (a)** Two peak cells are identified. **(b)** A unique ID is assigned to each peak cell; **(c)** Homogeneous growth of raster objects; the borders of each peak object are expanded to include connected raster cells having decreasing `dummy_var` values `AND` `dummy_var` values greater than 1.
Border functions
Functions: obj.border() and obj.nbs().
Raster object border functions can be used to identify the borders of raster objects.
obj.border
The function obj.border() identifies the borders of raster objects.
When missing values are present on a raster surface, the function works only with raster cells identified by attribute table row indices (see format inputs). When no missing value is present, row cell indices and cell numbers become equivalent (i.e. n^th^ row correspond to the n^th^ cell).
As an example we will: (i) add a missing value in the dummy raster and compute the neighborhood list with neighborhoods identified by row numbers (see ?ngbList), (ii) re-compute the raster objects of cv2 (Figure 3) and (iii) identify the borders of the raster objects (Figure 4).
# (i)
# ADD NA-VALUE
r2 <- r
r2[11] <- NA
# COMPUTE THE ATTRIBUTE TABLE
at2 <- attTbl(r2, "dummy_var")
# COMPUTE THE LIST OF NEIGBORHOODS
nbs2 <- ngbList(r2, rNumb=TRUE, attTbl=at2) # rnumb MUST be true to use obj.border
# (ii)
# a. cv0, identify peak cells
at2$cv0 <- peak.cell(at2, nbs2, rNumb=TRUE, p_edge=TRUE, p_col="dummy_var", p_fun="max")
# b. cv1, assign unique IDs
at2$cv1 <- anchor.seed(at2, nbs2, rNumb=TRUE, silent=TRUE, cond.filter="!is.na(cv0)", cond.seed="TRUE")
# c. cv2b, homogeneous growth of raster objects
at2$cv2b<- cond.4.nofn(at2, nbs2, rNumb=TRUE, classVector=at2$cv1, nbs_of=c(1, 2), hgrowth=TRUE,
cond="dummy_var <= dummy_var[] & dummy_var > 1")
# (iii)
# RASTER OBJECTS
RO <- split(1:NROW(at2), at2$cv2b)
print(RO) # values are attribute table row indices
# COMPUTE BORDERS
RO_bd <- obj.border(RO, nbs2, silent = TRUE)
# CONVERT ROW INDICES TO CELL NUMBERS
RO_bd1 <- at2$Cell[RO_bd[["1"]]]
RO_bd2 <- at2$Cell[RO_bd[["2"]]]
# ROW INDICES AND CELL NUMBERS ARE NOT EQUAL
print(RO_bd) # attribute table row indices
print(RO_bd1) # cell numbers
print(RO_bd2)
# Row indices: used by scapesClassification functions (increase function speed)
# have to be converted back to cell numbers before plotting
# CONVERT THE CLASS VECTORS INTO A RASTER
r_cv2b <- cv.2.rast(r2, classVector = at2$cv2b)
# PLOT
m <- c(1,1,1,1)
plot(r_cv2b, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
legend=FALSE, col=c("#78b2c4","#cfc1af"))
lines(r)
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "cv2b", family = "serif")
points(terra::xyFromCell(r2, RO_bd1), pch=20, col="blue")
points(terra::xyFromCell(r2, RO_bd2), pch=20, col="red")
legend(1, 1, legend=c("1", "2"), bty = "n", title="Object:",
fill=c("#78b2c4", "#cfc1af"), cex=1)
legend(1, 0.75, legend=c("Obj1", "Obj2"), bty = "n", title="Border:",
col=c("blue", "red"), pch=20, cex=1, pt.cex = 1.2)
text(xyFromCell(r2, 11), "NA\nvalue", cex=0.9, font=1, adj=0.5, family = "mono")
**Figure 4 - Obj.border** identifies the borders of raster objects.
obj.nbs
The function obj.nbs() returns a named nested lists having the following characteristics:
-
Each element of the list corresponds to a raster object;
-
Each element contains a named nested list whose names correspond to the IDs of neighboring raster objects;
-
The values of the nested lists identify the raster cells comprising the shared borders.
When missing values are present on a raster surface, the function works only with raster cells identified by attribute table row indices (see format inputs). When no missing value is present, row cell indices and cell numbers become equivalent (i.e. n^th^ row correspond to the n^th^ cell).
We can use the class vector cv2 computed in the previews example (obj.border) to illustrate how the function works.
# RASTER OBJECTS
RO <- split(1:NROW(at), at2$cv2b)
print(RO) # values are attribute table row indices
# COMPUTE BORDERS
RO_bd <- obj.border(RO, nbs2, silent = TRUE) # compute borders
####################################################################################
# COMPUTE SHARED BORDERS
####################################################################################
RO_shared_bd <- obj.nbs(RO_bd, nbs2, silent = TRUE)
# Obj.1 has as neighbor Obj.2 and cells in rows 24 and 31 comprise the shared border
RO_shared_bd[["1"]]
# Obj.2 has as neighbor Obj.1 and cells in rows 30 and 37 comprise the shared border
RO_shared_bd[["2"]]
# CONVERT ROW INDICES TO CELL NUMBERS
sharedBD1 <- at2$Cell[ RO_shared_bd[["1"]][["2"]] ]
sharedBD2 <- at2$Cell[ RO_shared_bd[["2"]][["1"]] ]
# PLOT
m <- c(1,1,1,1)
plot(r_cv2b, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
legend=FALSE, col=c("#78b2c4","#cfc1af"))
lines(r)
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "cv2b", family = "serif")
points(terra::xyFromCell(r, sharedBD1), pch=20, col="blue")
points(terra::xyFromCell(r, sharedBD2), pch=20, col="red")
legend(1, 1, legend=c("1", "2"), bty = "n", title="Object:",
fill=c("#78b2c4", "#cfc1af"), cex=1)
legend(1, 0.70, legend=c("Obj1", "Obj2"), bty = "n", title="Shared\nborder:",
col=c("blue", "red"), pch=20, cex=1, pt.cex = 1.2)
text(xyFromCell(r, 11), "NA\nvalue", cex=0.9, font=1, adj=0.5, ac, family = "mono")
**Figure 5 - obj.nbs** identifies the shared borders of raster objects.
Position index functions
Functions: rel.pi(), pi.sgm() and pi.add().
Raster object position index functions can be used to compute relative position indices and to use them to manipulate raster objects.
rel.pi
The function rel.pi() computes the standardized or normalized relative position index of raster objects.
-
Standardized position index values are computed with the formula ( x - mean(x) ) / sd(x);
-
Normalized position index values are computed with the formula ( x - min(x) ) / ( max(x) - min(x) ).
In either case position index values are relative to individual raster objects: high values indicate the top positions of an object; low values indicate the bottom positions of an object. We can compute the relative position index of cv2 (Figure 3). Results are plotted in Figure 6.
# STANDARDIZED RELATIVE POSITION INDEX
relPI_s <- rel.pi(attTbl = at, RO = "cv2", el = "dummy_var",
type = "s")
# NORMALIZED RELATIVE POSITION INDEX
relPI_n <- rel.pi(attTbl = at, RO = "cv2", el = "dummy_var",
type = "n")
# CONVERT THE CLASS VECTORS INTO A RASTER
r_relPI_s <- cv.2.rast(r, classVector = relPI_s)
r_relPI_n <- cv.2.rast(r, classVector = relPI_n)
layout(matrix(c(1, 2,
1, 2,
3, 4,
3, 4), nrow=4, byrow=TRUE))
m <- c(0,0.5,0,3)
# PLOT 1
################################################################################
plot(r_cv2, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#78b2c4","#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2")))
text(r);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) cv2", family = "serif")
# PLOT 2
################################################################################
brk <- c(-2,-1,0,1,2,3,4)
plot(r_relPI_s, type="interval", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
breaks = brk, plg=list(x=1, y=1, cex=0.9))
text(xyFromCell(r,at$Cell), as.character(round(relPI_s,2)))
lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) standardized relPI", family = "serif")
points(terra::xFromCell(r, at$Cell[which(at$cv2==1)]),
terra::yFromCell(r, at$Cell[which(at$cv2==1)]) - 0.045,
pch=21, bg="#78b2c4", col="black", cex=1.4)
points(terra::xFromCell(r, at$Cell[which(at$cv2==2)]),
terra::yFromCell(r, at$Cell[which(at$cv2==2)]) - 0.045,
pch=21, bg="#cfc1af", col="black", cex=1.4)
legend(1.02, 0.65, legend=c("1", "2"), bty = "n", title="Obj.:", xpd=TRUE,
col=c("#78b2c4", "#cfc1af"), pch=20, cex=0.9, pt.cex = 1.5)
# PLOT 3
################################################################################
brk <- seq(0,1,0.1)
plot(r_relPI_n, type="interval", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
breaks = brk, plg=list(x=1, y=1, cex=0.9, xpd=TRUE))
text(xyFromCell(r,at$Cell), as.character(round(relPI_n,2)))
lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) normalized relPI", family = "serif")
points(terra::xFromCell(r, at$Cell[which(at$cv2==1)]),
terra::yFromCell(r, at$Cell[which(at$cv2==1)]) - 0.045,
pch=21, bg="#78b2c4", col="black", cex=1.4)
points(terra::xFromCell(r, at$Cell[which(at$cv2==2)]),
terra::yFromCell(r, at$Cell[which(at$cv2==2)]) - 0.045,
pch=21, bg="#cfc1af", col="black", cex=1.4)
legend(1.02, 0.45, legend=c("1", "2"), bty = "n", title="Obj.:", xpd=TRUE,
col=c("#78b2c4", "#cfc1af"), pch=20, cex=0.9, pt.cex = 1.5)
# PLOT 4 -LEGEND
################################################################################
plot(r, type="classes", col="white", legend=FALSE, mar=m, axes=FALSE,
ylim=c(-0.10,1.08))
text(x=0, y=1.04, cex=1.7, font=2, adj=0, "Relative position index (relPI):",
family = "serif")
# Standardized
text(x=0.04, y=0.87, cex=1.5, font=2, adj=0, "Standardized", family = "serif")
text(x=0.04, y=0.80, cex=1.5, font=1, adj=c(0,1), "Formula:", family = "serif",
col="#818792")
text(x=0.1, y=0.72, cex=1.4, font=3, adj=c(0,1), "x - mean(x) /\nsd(x)", family = "serif",
col="#818792")
# Normalized
text(x=0.04, y=0.40, cex=1.5, font=2, adj=0, "Normalized", family = "serif")
text(x=0.04, y=0.33, cex=1.5, font=1, adj=c(0,1), "Formula:", family = "serif",
col="#818792")
text(x=0.1, y=0.25, cex=1.4, font=3, adj=c(0,1), "x - min(x) /\nmax(x) - min(x)", family = "serif",
col="#818792")
**Figure 6 - rel.pi** identifies the relative position index of raster objects. In the presented formulae, variable x represents the elevation values of individual raster object.
pi.sgm
The function pi.sgm() segments raster objects based on position index values. As an example we will imagine that all raster values greater than 1 constitute a single raster object. We will segment the raster object at positions having normalized relative position index values of 0 (Figure 7).
# a) initial raster object
at$RO <- cond.4.all(at, "dummy_var > 1", class = 1)
# b) compute normalized relative position index
at$PI <- rel.pi(attTbl=at, RO="RO", el="dummy_var", type = "n")
# c) segment raster object
at$ROs <- pi.sgm(at, nbs, RO = "RO", mainPI = "PI", cut.mPI = 0)
# d) segment raster object, min number of cell is 5
at$ROn <- pi.sgm(at, nbs, RO = "RO", mainPI = "PI", cut.mPI = 0,
min.N = 5)
# CONVERT THE CLASS VECTORS INTO A RASTER
PIc <- at$PI
PIc[PIc>0] <- NA
r_RO <- cv.2.rast(r, classVector = at$RO)
r_PIc <- cv.2.rast(r, classVector = PIc)
r_ROs <- cv.2.rast(r, classVector = at$ROs)
r_ROn <- cv.2.rast(r, classVector = at$ROn)
r2 <- r
r2[r2<2] <- NA
layout(matrix(c(1, 2,
1, 2,
3, 4,
3, 4), nrow=4, byrow=TRUE))
m <- c(0,0.5,0.5,3)
# PLOT 1
################################################################################
plot(r_RO, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1")))
text(r2);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) RO", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: dummy_var > 1",
family = "serif", col="#818792")
# PLOT 2
################################################################################
plot(r_RO, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#cfc1af"), legend = FALSE)
plot(r_PIc, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#ff000060"), add = TRUE,
plg=list(x=1, y=1, cex=1.1, title = "Cut:", title.adj = 0.2,
legend=c("PI=0")))
text(xyFromCell(r,at$Cell), as.character(round(at$PI,2)))
lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) PI", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: PI > 0",
family = "serif", col="#818792")
# PLOT 3
################################################################################
r2[r2==2] <- NA
plot(r_ROs, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#cfc1af", "#78b2c4"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2")))
text(r2);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) ROs", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: NA",
family = "serif", col="#818792")
# PLOT 4
################################################################################
r2[which(is.na(at$ROn))] <- NA
plot(r_ROn, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE,
col=c("#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1")))
text(r2);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(d) ROn", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: 5",
family = "serif", col="#818792")
**Figure 7 - pi.sgm** segments raster objects based on position index values. **(a)** Initial raster object. **(b)** Position index values. **(c)** Segment on values equal to `0`. **(d)** Segment on values equal to `0` and remove objects with less than 5 cells.
pi.add
The function pi.add() adds new raster objects based on position index values. As an example we will (i) slightly modify the values of our dummy variable, (ii) assume to have, initially, a single raster object, (iii) compute standardized position index values based on all dummy raster values and (iv) add disjoint raster objects with position index values greater than 0.8 (Figure 8).
# Modify dummy raster values
r[c(1,2,45,46,47)] <- 6
at <- attTbl(r, "dummy_var")# re-compute at
nbs <- ngbList(r) # re-compute nbs
# a) initial raster object
at$RO <- anchor.seed(at, nbs, class=1, silent = TRUE,
cond.seed = "dummy_var == 8",
cond.growth = "dummy_var == 5")
# b) compute standardized relative position index
at$PI <- (at$dummy_var - mean(at$dummy_var))/stats::sd(at$dummy_var)
# c) add raster object
at$ROa <- pi.add(at, nbs, RO = "RO", mainPI = "PI", add.mPI = 0.8)
# d) add raster object, min number of cell is 3
at$ROn <- pi.add(at, nbs, RO = "RO", mainPI = "PI", add.mPI = 0.8,
min.N = 3)
# CONVERT THE CLASS VECTORS INTO A RASTER
PIc <- at$PI
PIc[PIc<0.8 | at$RO==1] <- NA
PIc[PIc>0.8] <- 1
r_RO <- cv.2.rast(r, classVector = at$RO)
r_PIc <- cv.2.rast(r, classVector = PIc)
r_ROa <- cv.2.rast(r, classVector = at$ROa)
r_ROn <- cv.2.rast(r, classVector = at$ROn)
layout(matrix(c(1, 2,
1, 2,
3, 4,
3, 4), nrow=4, byrow=TRUE))
m <- c(0,0.4,0.5,3.1)
# PLOT 1
################################################################################
plot(r_RO, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE,
col=c("#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1")))
text(r);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) RO", family = "serif")
text(x=0, y=-0.04, cex=1.4, font=1, adj=0, family = "serif", col="#818792",
"cond.seed: dummy_var == 8")
text(x=0, y=-0.10, cex=1.4, font=1, adj=0, family = "serif", col="#818792",
"cond.growth: dummy_var == 5")
# PLOT 2
################################################################################
plot(r_RO, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE,
col=c("#cfc1af"), legend = FALSE)
plot(r_PIc, type = "classes", ylim=c(-0.12,1.08), mar = m, axes=FALSE,
col=c("#ff000060"), add = TRUE,
plg=list(x=1, y=1, cex=1.1, title = "Add:", title.adj = 0.2,
legend=c("PI >0.8")))
text(xyFromCell(r,at$Cell), as.character(round(at$PI,2)))
lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) PI", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: PI > 0.8",
family = "serif", col="#818792")
# PLOT 3
################################################################################
plot(r_ROa, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE,
col=c("#818792", "#78b2c4", "#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2", "3")))
text(r);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) ROa", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: NA",
family = "serif", col="#818792")
# PLOT 4
################################################################################
plot(r_ROn, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE,
col=c("#78b2c4", "#cfc1af"),
plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2,
legend=c("1", "2")))
text(r);lines(r)
text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(d) ROn", family = "serif")
text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: 3",
family = "serif", col="#818792")
**Figure 8 - pi.add** adds new raster objects based on position index values. **(a)** Initial raster object. **(b)** Position index values. **(c)** Add raster objects composed of cells having position index values `>0.8`. **(d)** Add raster objects composed of cells having position index values `>0.8` and with at least 3 cells. Note that new raster objects are added only if they do not share any border with the initial object.
ghTaranto/scapesClassification documentation built on April 8, 2022, 1:43 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = TRUE, fig.align='center', message=FALSE, warning=FALSE, out.width = "95%" )
Functions: cond.4.nofn(), anchor.seed(), pi.sgm(), obj.border() and obj.nbs().
Object functions are functions used to identify and manipulate raster objects.
Input data
We will use a single-layer dummy raster to illustrate scapesClassification functions. We will start by computing its attribute table (where the raster is named "dummy_var") and its list of neighborhoods.
# LOAD LIBRARIES library(scapesClassification) library(terra) # LOAD THE DUMMY RASTER r <- list.files(system.file("extdata", package = "scapesClassification"), pattern = "dummy_raster\\.tif", full.names = T) r <- rast(r)
# COMPUTE THE ATTRIBUTE TABLE at <- attTbl(r, "dummy_var") head(at, 3) # COMPUTE THE LIST OF NEIGBORHOODS nbs <- ngbList(r) head(nbs, 3)
Plots
In the following examples we will show how class vectors are computed. However, in order to improve the reading experience, the plots' code is hidden. It can be accessed in the *.RMD file used to generate the html file.
The plotting procedure is to (i) convert a class vectors into a raster using the function cv.2.rast() and to (ii) visualize the raster using R or an external software. In our examples we will use the R package terra and its function terra::plot().
Manipulation functions
Functions: anchor.seed() and cond.4.nofn().
Raster object manipulation functions can be used to identify and manipulate raster objects.
anchor.seed
The function anchor.seed() can be considered as an anchor cell function as well as a raster object function. Its two principal uses are: (i) identify cells having particular characteristics (seed cells) and define around them growth and isolation buffers; (ii) assign unique IDs to groups of cells having particular characteristics.
Condition arguments
The function anchor.seed() take as inputs four sets of conditions:
-
cond.filter, the conditions to define what cells have to be evaluated by the function. -
cond.seed, the conditions to identify, at each iteration, the seed cell. The seed cell is the cell around which growth and isolation conditions are applied. -
cond.growth, the conditions to define a buffer around the seed cell. -
cond.isol, the conditions to isolate one seed cell (and its buffer) from another.
Condition evaluation
The first set of conditions to be evaluated is the cond.filter. The evaluation of the remaining sets of conditions is iterative (Figure 1):
-
A seed cell is identified and receives a classification number (as specified by the argument
class). If the argumentclass=NULL, then a new ID is assigned to every new seed cell. -
Cells connected with the seed cell meeting the conditions of
cond.growthare assigned to the same class of the seed cell (growth buffer). The rule evaluation take into account class continuity. -
Cells connected with the seed cell (or with its growth buffer) meeting the conditions of
cond.isolare assigned to the isolation buffer (class = -999). The rule evaluation take into account class continuity. -
Once seed, growth and isolation cells are identified, they are ignored in all successive iterations.
We can compute a new class vector based on the following rules. The two iterations performed by the function are showed in (Figure 1):
# Anchor seed cv <- anchor.seed(at, nbs, class = 1, cond.filter = "dummy_var > 2", cond.seed = "dummy_var == max(dummy_var)", cond.growth = NULL, cond.isol = "dummy_var < dummy_var[]") # focal cell condition (see ?conditions)
#CONDITION FILTER at$cf <- cond.4.all(at, cond = "dummy_var > 2", class = 1) #ITERATION 1 cs1 <- cond.4.all(at, cond = "dummy_var == 10", class = 1) ci1 <- cond.4.nofn(at, nbs, classVector = cs1, nbs_of = c(1, -1), cond = "dummy_var < dummy_var[] & !is.na(cf)", class = -1) #ITERATION 2 cs2 <- cond.4.all(at, classVector = ci1, cond = "dummy_var == 8 & !is.na(cf)", class = 1) ci2 <- cond.4.nofn(at, nbs, classVector = cs2, nbs_of = c(1, -1), cond = "dummy_var < dummy_var[] & !is.na(cf)", class = -1) #CLASS VECTORS TO RASTERS r_cf <- cv.2.rast(r, classVector = at$cf) r_cs1 <- cv.2.rast(r, classVector = cs1) r_ci1 <- cv.2.rast(r, classVector = ci1) r_cs2 <- cv.2.rast(r, classVector = cs2) r_ci2 <- cv.2.rast(r, classVector = ci2) rl <- r;rl[]<-NA; rl[1:3]<-1:3 # PLOTS ##################################################################### # par(mfrow=c(3,3)) layout(matrix(c(1, 1, 2, 2, 3, 3, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 4, 4, 5, 5, 6, 6), nrow=4, byrow=TRUE)) m <- c(0,1,0,1) # 1. ITERATION 0 plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m) text(r); lines(r) text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 0.0", family = "serif") text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.filter", family = "serif") # 2. ITERATION 1.1 plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m) plot(r_cs1, type="classes", col="#98fb98", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m, add = TRUE) text(r); lines(r) text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 1.1", family = "serif") text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.seed", family = "serif") # 3. ITERATION 1.2 plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m) plot(r_ci1, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m, add = TRUE) text(r); lines(r) text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 1.2", family = "serif") text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.isol", family = "serif") # 4. LEGEND plot(rl, type="classes", col="white", legend=FALSE, axes=FALSE) legend(x=-0.05, y=1, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5, fill = "#78b2c4",legend = "cond.fiter") text(x=0.22, y=0.93, cex=1.2, font=1, adj=c(0,1), "'dummy_var>2'", family = "serif",col="#818792") legend(x=-0.05, y=0.70, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5, fill = "#98fb98",legend = "cond.seed") text(x=0.22, y=0.63, cex=1.2, font=1, adj=c(0,1), "'dummy_var==\nmax(dummy_var)'", family = "serif",col="#818792") legend(x=-0.05, y=0.4, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5, fill = "transparent",legend = "cond.growth") text(x=0.22, y=0.33, cex=1.2, font=1, adj=c(0,1), "NULL", family = "serif",col="#818792") legend(x=-0.05, y=0.1, bty="n", cex=1.7, y.intersp=2.6, xjust=0, yjust=0.5, fill = "#d76968",legend = "cond.isol") text(x=0.22, y=0.03, cex=1.2, font=1, adj=c(0,1), "'dummy_var < \ndummy_var[]'", family = "serif",col="#818792") # 5. ITERATION 2.1 plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m) plot(r_cs2, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m, add = TRUE) text(r); lines(r) text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 2.1", family = "serif") text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.seed", family = "serif") # 6. ITERATION 2.2 plot(r_cf, type="classes", col="#78b2c4", axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m) plot(r_ci2, type="classes", col=c("#d76968","#98fb98"), axes=FALSE, legend=FALSE, ylim=c(-0.05,1.10), mar=m, add = TRUE) text(r); lines(r) text(x=0, y=1.05, cex=1.7, font=1, adj=0, "Itr 2.2", family = "serif") text(x=1, y=1.05, cex=1.7, font=3, adj=1, "cond.isol", family = "serif")
**Figure 1 - Anchor.seed rule evaluation**. Before the iterations start, `cond.filter` determines what cells have to be evaluated. The other rules are applied in the following order: (i) `cond.seed` identifies a seed cell; (ii) `cond.growth` identifies a growth buffer around the seed cell; (iii) `cond.isol` identifies an isolation buffer around the seed cell and its growth buffer. The function runs for two iterations and identifies two seed cells.
Evaluation lag
The function arguments lag.growth and lag.isol control the evaluation lag of relative focal cell conditions (Figure 2).
-
When
lag.*are set to 0, relative focal cell conditions have a standard behavior and compare the values of the test cells against the value of the focal cell. -
When
lag.*are set toInf, relative focal cell conditions compare the value of the test cells against the value of the seed cell identified at the start of the iteration.
# a. lag.growth=0 cv1 <- anchor.seed(at, nbs, class = NULL, # a new class for every seed and growth buffer cond.filter = "dummy_var>1", cond.seed = "dummy_var == max(dummy_var)", cond.growth = "dummy_var<dummy_var[]", # focal cell condition (see ?conditions) lag.growth = 0, cond.isol = NULL) # b. lag.growth=Inf cv2 <- anchor.seed(at, nbs, class = NULL, # a new class for every seed and growth buffer cond.filter = "dummy_var>1", cond.seed = "dummy_var == max(dummy_var)", cond.growth = "dummy_var<dummy_var[]", # focal cell condition (see ?conditions) lag.growth = Inf, cond.isol = NULL)
# CONVERT THE CLASS VECTORS INTO A RASTER r_cv1 <- cv.2.rast(r, classVector = cv1) r_cv2 <- cv.2.rast(r, classVector = cv2) layout(matrix(c(1, 2, 1, 2), nrow=2, byrow=TRUE)) m <- c(1,1,0,3) # PLOT 1 ################################################################################ plot(r_cv1, type = "classes", ylim=c(-0.15,1.10), mar = m, axes=FALSE, col=c("#78b2c4","#98fb98"), plg=list(x=1, y=1, cex=0.9, title = "Obj.:", title.adj = 0.2, legend=c("1","2"))) text(r) lines(r) text(x=0, y=1.03, cex=1.3, font=2, adj=0, "(a) cv1", family = "serif") text(x=1, y=1.03, cex=1.3, font=2, adj=1, "lag.growth = 0", family = "serif", col="#818792") text(xFromCell(r,c(20,43)),yFromCell(r,c(20,43))-0.05,c("SEED 1", "SEED 2"), col="red",cex=0.85) text(x=0, y=-0.04, cex=1.1, font=1, adj=0, "cond.filter:", family = "serif", col="#818792") text(x=0.28, y=-0.04, cex=1.1, font=1, adj=0, "dummy_var > 1", family = "serif", col="#818792") text(x=0, y=-0.1, cex=1.1, font=1, adj=0, "cond.seed:", family = "serif", col="#818792") text(x=0.28, y=-0.1, cex=1.1, font=1, adj=0, "dummy_var == max(dummy_var)", family = "serif", col="#818792") text(x=0, y=-0.16, cex=1.1, font=1, adj=0, "cond.growth:", family = "serif", col="#818792") text(x=0.28, y=-0.16, cex=1.1, font=1, adj=0, "dummy_var < dummy_var[ ]", family = "serif", col="#818792") # PLOT 2 ################################################################################ plot(r_cv2, type = "classes", ylim=c(-0.15,1.10), mar = m, axes=FALSE, col=c("#78b2c4"), plg=list(x=1, y=1, cex=0.9, title = "Obj.:", title.adj = 0.2, legend=c("1"))) text(r) lines(r) text(x=0, y=1.03, cex=1.3, font=2, adj=0, "(b) cv2", family = "serif") text(x=1, y=1.03, cex=1.3, font=2, adj=1, "lag.growth = Inf", family = "serif", col="#818792") text(xFromCell(r,20),yFromCell(r,20)-0.05,"SEED 1",col="red",cex=0.85) text(x=0, y=-0.04, cex=1.1, font=1, adj=0, "cond.filter:", family = "serif", col="#818792") text(x=0.28, y=-0.04, cex=1.1, font=1, adj=0, "dummy_var > 1", family = "serif", col="#818792") text(x=0, y=-0.1, cex=1.1, font=1, adj=0, "cond.seed:", family = "serif", col="#818792") text(x=0.28, y=-0.1, cex=1.1, font=1, adj=0, "dummy_var == max(dummy_var)", family = "serif", col="#818792") text(x=0, y=-0.16, cex=1.1, font=1, adj=0, "cond.growth:", family = "serif", col="#818792") text(x=0.28, y=-0.16, cex=1.1, font=1, adj=0, "dummy_var < dummy_var[ ]", family = "serif", col="#818792")
**Figure 2 - Anchor.seed evaluation lag**. The function arguments `lag.*` control the evaluation lag of relative focal cell conditions (`[]`). **(a)** `lag.growth = 0`, `cond.growth` compares the values of test cells against the value of the focal cell; two objects identified. **(b)** `lag.growth = Inf`, `cond.growth` compares the values of test cells against the value of the seed cell; one objects identified.
cond.4.nofn (hgrowth) {#hgrowth}
The function cond.4.nofn() can be used to expand the borders of raster objects. This functionality is activated with the argument hgrowth = TRUE (homogeneous growth, see ?cond.4.nofn for additional details).
In the following example we will: (i) identify peak cells (peak.cell), (ii) assign a unique ID to each peak (anchor.seed) and (iii) use the function cond.4.nofn() to expand the borders of the two peak objects. The borders are expanded based on the focal cell rule dummy_var <= dummy_var[] and on the test cell rule dummy_var > 1 (Figure 3c).
Note that intermediate class vectors are added as column vectors in the attribute table; in this way they can be accessed by name and used in classification rules.
# IDENTIFY RASTER OBJECTS (a,b) AND RESHAPE THEIR BORDERS (c) # a. cv0, identify peak cells at$cv0 <- peak.cell(attTbl = at, ngbList = nbs, p_edge = TRUE, p_col = "dummy_var", p_fun = "max") # b. cv1, assign unique IDs at$cv1 <- anchor.seed(at, nbs, silent = TRUE, class = NULL, # a new class for every seed and growth buffer cond.filter = "!is.na(cv0)", cond.seed = "TRUE") # c. cv2, homogeneous growth of raster objects at$cv2 <- cond.4.nofn(attTbl = at, ngbList = nbs, classVector = at$cv1, nbs_of = c(1, 2), class = NULL, cond = "dummy_var <= dummy_var[] & dummy_var > 1", hgrowth = TRUE) # HOMOGENEOUS GROWTH
# CONVERT THE CLASS VECTORS INTO A RASTER r_cv0 <- cv.2.rast(r, classVector = at$cv0) r_cv1 <- cv.2.rast(r, classVector = at$cv1) r_cv2 <- cv.2.rast(r, classVector = at$cv2) layout(matrix(c(1, 2, 1, 2, 3, 4, 3, 4), nrow=4, byrow=TRUE)) m <- c(1,0.5,0,0.5) # PLOT 1 ################################################################################ plot(r_cv0, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#98fb98"), plg=list(x=.99, y=1, cex=1.0, title = "Class:", title.adj = 0.2, legend=c("peak\ncell"))) text(r);lines(r) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(a) cv0", family = "serif") # PLOT 2 ################################################################################ plot(r_cv1, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#78b2c4","#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2"))) text(r);lines(r) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(b) cv1", family = "serif") # PLOT 3 ################################################################################ plot(r_cv2, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#78b2c4","#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2"))) text(r);lines(r) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "(c) cv2", family = "serif") # PLOT 4 -LEGEND ################################################################################ plot(r, type="classes", col="white", legend=FALSE, mar=m, axes=FALSE, ylim=c(-0.10,1.08)) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "Classification steps:", family = "serif") # step 1 text(x=0.04, y=0.94, cex=1.7, font=2, adj=0, "cv0", family = "serif") text(x=0.04, y=0.87, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif", col="#818792") text(x=0.24, y=0.87, cex=1.5, font=1, adj=c(0,1), "peak.cell", family = "serif", col="#818792") text(x=0.04, y=0.77, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif", col="#818792") text(x=0.24, y=0.77, cex=1.5, font=1, adj=c(0,1), "local maxima", family = "serif", col="#818792") # step 2 text(x=0.04, y=0.63, cex=1.7, font=2, adj=0, "cv1", family = "serif") text(x=0.04, y=0.56, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif", col="#818792") text(x=0.24, y=0.56, cex=1.5, font=1, adj=c(0,1), "anchor.seed", family = "serif", col="#818792") text(x=0.04, y=0.46, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif", col="#818792") text(x=0.24, y=0.46, cex=1.5, font=1, adj=c(0,1), "cond.filter = !is.na(cv0)", family = "serif", col="#818792") text(x=0.24, y=0.38, cex=1.5, font=1, adj=c(0,1), "cond.seed = TRUE", family = "serif", col="#818792") # step 3 text(x=0.04, y=0.25, cex=1.7, font=2, adj=0, "cv2", family = "serif") text(x=0.04, y=0.18, cex=1.5, font=1, adj=c(0,1), "fun:", family = "serif", col="#818792") text(x=0.24, y=0.18, cex=1.5, font=1, adj=c(0,1), "cond.4.nofn (hgrowth=TRUE)", family = "serif", col="#818792") text(x=0.04, y=0.08, cex=1.5, font=1, adj=c(0,1), "rule:", family = "serif", col="#818792") text(x=0.24, y=0.08, cex=1.5, font=1, adj=c(0,1), "dummy_var <= dummy_var[ ]", family = "serif", col="#818792") text(x=0.24, y=0.00, cex=1.5, font=1, adj=c(0,1), "& dummy_var > 1", family = "serif", col="#818792")
**Figure 3 - Identify raster objects and reshape their borders. (a)** Two peak cells are identified. **(b)** A unique ID is assigned to each peak cell; **(c)** Homogeneous growth of raster objects; the borders of each peak object are expanded to include connected raster cells having decreasing `dummy_var` values `AND` `dummy_var` values greater than 1.
Border functions
Functions: obj.border() and obj.nbs().
Raster object border functions can be used to identify the borders of raster objects.
obj.border
The function obj.border() identifies the borders of raster objects.
When missing values are present on a raster surface, the function works only with raster cells identified by attribute table row indices (see format inputs). When no missing value is present, row cell indices and cell numbers become equivalent (i.e. n^th^ row correspond to the n^th^ cell).
As an example we will: (i) add a missing value in the dummy raster and compute the neighborhood list with neighborhoods identified by row numbers (see ?ngbList), (ii) re-compute the raster objects of cv2 (Figure 3) and (iii) identify the borders of the raster objects (Figure 4).
# (i) # ADD NA-VALUE r2 <- r r2[11] <- NA # COMPUTE THE ATTRIBUTE TABLE at2 <- attTbl(r2, "dummy_var") # COMPUTE THE LIST OF NEIGBORHOODS nbs2 <- ngbList(r2, rNumb=TRUE, attTbl=at2) # rnumb MUST be true to use obj.border
# (ii) # a. cv0, identify peak cells at2$cv0 <- peak.cell(at2, nbs2, rNumb=TRUE, p_edge=TRUE, p_col="dummy_var", p_fun="max") # b. cv1, assign unique IDs at2$cv1 <- anchor.seed(at2, nbs2, rNumb=TRUE, silent=TRUE, cond.filter="!is.na(cv0)", cond.seed="TRUE") # c. cv2b, homogeneous growth of raster objects at2$cv2b<- cond.4.nofn(at2, nbs2, rNumb=TRUE, classVector=at2$cv1, nbs_of=c(1, 2), hgrowth=TRUE, cond="dummy_var <= dummy_var[] & dummy_var > 1")
# (iii) # RASTER OBJECTS RO <- split(1:NROW(at2), at2$cv2b) print(RO) # values are attribute table row indices # COMPUTE BORDERS RO_bd <- obj.border(RO, nbs2, silent = TRUE) # CONVERT ROW INDICES TO CELL NUMBERS RO_bd1 <- at2$Cell[RO_bd[["1"]]] RO_bd2 <- at2$Cell[RO_bd[["2"]]] # ROW INDICES AND CELL NUMBERS ARE NOT EQUAL print(RO_bd) # attribute table row indices print(RO_bd1) # cell numbers print(RO_bd2) # Row indices: used by scapesClassification functions (increase function speed) # have to be converted back to cell numbers before plotting
# CONVERT THE CLASS VECTORS INTO A RASTER r_cv2b <- cv.2.rast(r2, classVector = at2$cv2b) # PLOT m <- c(1,1,1,1) plot(r_cv2b, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, legend=FALSE, col=c("#78b2c4","#cfc1af")) lines(r) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "cv2b", family = "serif") points(terra::xyFromCell(r2, RO_bd1), pch=20, col="blue") points(terra::xyFromCell(r2, RO_bd2), pch=20, col="red") legend(1, 1, legend=c("1", "2"), bty = "n", title="Object:", fill=c("#78b2c4", "#cfc1af"), cex=1) legend(1, 0.75, legend=c("Obj1", "Obj2"), bty = "n", title="Border:", col=c("blue", "red"), pch=20, cex=1, pt.cex = 1.2) text(xyFromCell(r2, 11), "NA\nvalue", cex=0.9, font=1, adj=0.5, family = "mono")
**Figure 4 - Obj.border** identifies the borders of raster objects.
obj.nbs
The function obj.nbs() returns a named nested lists having the following characteristics:
-
Each element of the list corresponds to a raster object;
-
Each element contains a named nested list whose names correspond to the IDs of neighboring raster objects;
-
The values of the nested lists identify the raster cells comprising the shared borders.
When missing values are present on a raster surface, the function works only with raster cells identified by attribute table row indices (see format inputs). When no missing value is present, row cell indices and cell numbers become equivalent (i.e. n^th^ row correspond to the n^th^ cell).
We can use the class vector cv2 computed in the previews example (obj.border) to illustrate how the function works.
# RASTER OBJECTS RO <- split(1:NROW(at), at2$cv2b) print(RO) # values are attribute table row indices # COMPUTE BORDERS RO_bd <- obj.border(RO, nbs2, silent = TRUE) # compute borders #################################################################################### # COMPUTE SHARED BORDERS #################################################################################### RO_shared_bd <- obj.nbs(RO_bd, nbs2, silent = TRUE) # Obj.1 has as neighbor Obj.2 and cells in rows 24 and 31 comprise the shared border RO_shared_bd[["1"]] # Obj.2 has as neighbor Obj.1 and cells in rows 30 and 37 comprise the shared border RO_shared_bd[["2"]] # CONVERT ROW INDICES TO CELL NUMBERS sharedBD1 <- at2$Cell[ RO_shared_bd[["1"]][["2"]] ] sharedBD2 <- at2$Cell[ RO_shared_bd[["2"]][["1"]] ]
# PLOT m <- c(1,1,1,1) plot(r_cv2b, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, legend=FALSE, col=c("#78b2c4","#cfc1af")) lines(r) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "cv2b", family = "serif") points(terra::xyFromCell(r, sharedBD1), pch=20, col="blue") points(terra::xyFromCell(r, sharedBD2), pch=20, col="red") legend(1, 1, legend=c("1", "2"), bty = "n", title="Object:", fill=c("#78b2c4", "#cfc1af"), cex=1) legend(1, 0.70, legend=c("Obj1", "Obj2"), bty = "n", title="Shared\nborder:", col=c("blue", "red"), pch=20, cex=1, pt.cex = 1.2) text(xyFromCell(r, 11), "NA\nvalue", cex=0.9, font=1, adj=0.5, ac, family = "mono")
**Figure 5 - obj.nbs** identifies the shared borders of raster objects.
Position index functions
Functions: rel.pi(), pi.sgm() and pi.add().
Raster object position index functions can be used to compute relative position indices and to use them to manipulate raster objects.
rel.pi
The function rel.pi() computes the standardized or normalized relative position index of raster objects.
-
Standardized position index values are computed with the formula
( x - mean(x) ) / sd(x); -
Normalized position index values are computed with the formula
( x - min(x) ) / ( max(x) - min(x) ).
In either case position index values are relative to individual raster objects: high values indicate the top positions of an object; low values indicate the bottom positions of an object. We can compute the relative position index of cv2 (Figure 3). Results are plotted in Figure 6.
# STANDARDIZED RELATIVE POSITION INDEX relPI_s <- rel.pi(attTbl = at, RO = "cv2", el = "dummy_var", type = "s") # NORMALIZED RELATIVE POSITION INDEX relPI_n <- rel.pi(attTbl = at, RO = "cv2", el = "dummy_var", type = "n")
# CONVERT THE CLASS VECTORS INTO A RASTER r_relPI_s <- cv.2.rast(r, classVector = relPI_s) r_relPI_n <- cv.2.rast(r, classVector = relPI_n) layout(matrix(c(1, 2, 1, 2, 3, 4, 3, 4), nrow=4, byrow=TRUE)) m <- c(0,0.5,0,3) # PLOT 1 ################################################################################ plot(r_cv2, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#78b2c4","#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2"))) text(r);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) cv2", family = "serif") # PLOT 2 ################################################################################ brk <- c(-2,-1,0,1,2,3,4) plot(r_relPI_s, type="interval", ylim=c(-0.10,1.08), mar = m, axes=FALSE, breaks = brk, plg=list(x=1, y=1, cex=0.9)) text(xyFromCell(r,at$Cell), as.character(round(relPI_s,2))) lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) standardized relPI", family = "serif") points(terra::xFromCell(r, at$Cell[which(at$cv2==1)]), terra::yFromCell(r, at$Cell[which(at$cv2==1)]) - 0.045, pch=21, bg="#78b2c4", col="black", cex=1.4) points(terra::xFromCell(r, at$Cell[which(at$cv2==2)]), terra::yFromCell(r, at$Cell[which(at$cv2==2)]) - 0.045, pch=21, bg="#cfc1af", col="black", cex=1.4) legend(1.02, 0.65, legend=c("1", "2"), bty = "n", title="Obj.:", xpd=TRUE, col=c("#78b2c4", "#cfc1af"), pch=20, cex=0.9, pt.cex = 1.5) # PLOT 3 ################################################################################ brk <- seq(0,1,0.1) plot(r_relPI_n, type="interval", ylim=c(-0.10,1.08), mar = m, axes=FALSE, breaks = brk, plg=list(x=1, y=1, cex=0.9, xpd=TRUE)) text(xyFromCell(r,at$Cell), as.character(round(relPI_n,2))) lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) normalized relPI", family = "serif") points(terra::xFromCell(r, at$Cell[which(at$cv2==1)]), terra::yFromCell(r, at$Cell[which(at$cv2==1)]) - 0.045, pch=21, bg="#78b2c4", col="black", cex=1.4) points(terra::xFromCell(r, at$Cell[which(at$cv2==2)]), terra::yFromCell(r, at$Cell[which(at$cv2==2)]) - 0.045, pch=21, bg="#cfc1af", col="black", cex=1.4) legend(1.02, 0.45, legend=c("1", "2"), bty = "n", title="Obj.:", xpd=TRUE, col=c("#78b2c4", "#cfc1af"), pch=20, cex=0.9, pt.cex = 1.5) # PLOT 4 -LEGEND ################################################################################ plot(r, type="classes", col="white", legend=FALSE, mar=m, axes=FALSE, ylim=c(-0.10,1.08)) text(x=0, y=1.04, cex=1.7, font=2, adj=0, "Relative position index (relPI):", family = "serif") # Standardized text(x=0.04, y=0.87, cex=1.5, font=2, adj=0, "Standardized", family = "serif") text(x=0.04, y=0.80, cex=1.5, font=1, adj=c(0,1), "Formula:", family = "serif", col="#818792") text(x=0.1, y=0.72, cex=1.4, font=3, adj=c(0,1), "x - mean(x) /\nsd(x)", family = "serif", col="#818792") # Normalized text(x=0.04, y=0.40, cex=1.5, font=2, adj=0, "Normalized", family = "serif") text(x=0.04, y=0.33, cex=1.5, font=1, adj=c(0,1), "Formula:", family = "serif", col="#818792") text(x=0.1, y=0.25, cex=1.4, font=3, adj=c(0,1), "x - min(x) /\nmax(x) - min(x)", family = "serif", col="#818792")
**Figure 6 - rel.pi** identifies the relative position index of raster objects. In the presented formulae, variable x represents the elevation values of individual raster object.
pi.sgm
The function pi.sgm() segments raster objects based on position index values. As an example we will imagine that all raster values greater than 1 constitute a single raster object. We will segment the raster object at positions having normalized relative position index values of 0 (Figure 7).
# a) initial raster object at$RO <- cond.4.all(at, "dummy_var > 1", class = 1) # b) compute normalized relative position index at$PI <- rel.pi(attTbl=at, RO="RO", el="dummy_var", type = "n") # c) segment raster object at$ROs <- pi.sgm(at, nbs, RO = "RO", mainPI = "PI", cut.mPI = 0) # d) segment raster object, min number of cell is 5 at$ROn <- pi.sgm(at, nbs, RO = "RO", mainPI = "PI", cut.mPI = 0, min.N = 5)
# CONVERT THE CLASS VECTORS INTO A RASTER PIc <- at$PI PIc[PIc>0] <- NA r_RO <- cv.2.rast(r, classVector = at$RO) r_PIc <- cv.2.rast(r, classVector = PIc) r_ROs <- cv.2.rast(r, classVector = at$ROs) r_ROn <- cv.2.rast(r, classVector = at$ROn) r2 <- r r2[r2<2] <- NA layout(matrix(c(1, 2, 1, 2, 3, 4, 3, 4), nrow=4, byrow=TRUE)) m <- c(0,0.5,0.5,3) # PLOT 1 ################################################################################ plot(r_RO, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1"))) text(r2);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) RO", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: dummy_var > 1", family = "serif", col="#818792") # PLOT 2 ################################################################################ plot(r_RO, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#cfc1af"), legend = FALSE) plot(r_PIc, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#ff000060"), add = TRUE, plg=list(x=1, y=1, cex=1.1, title = "Cut:", title.adj = 0.2, legend=c("PI=0"))) text(xyFromCell(r,at$Cell), as.character(round(at$PI,2))) lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) PI", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: PI > 0", family = "serif", col="#818792") # PLOT 3 ################################################################################ r2[r2==2] <- NA plot(r_ROs, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#cfc1af", "#78b2c4"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2"))) text(r2);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) ROs", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: NA", family = "serif", col="#818792") # PLOT 4 ################################################################################ r2[which(is.na(at$ROn))] <- NA plot(r_ROn, type = "classes", ylim=c(-0.10,1.08), mar = m, axes=FALSE, col=c("#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1"))) text(r2);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(d) ROn", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: 5", family = "serif", col="#818792")
**Figure 7 - pi.sgm** segments raster objects based on position index values. **(a)** Initial raster object. **(b)** Position index values. **(c)** Segment on values equal to `0`. **(d)** Segment on values equal to `0` and remove objects with less than 5 cells.
pi.add
The function pi.add() adds new raster objects based on position index values. As an example we will (i) slightly modify the values of our dummy variable, (ii) assume to have, initially, a single raster object, (iii) compute standardized position index values based on all dummy raster values and (iv) add disjoint raster objects with position index values greater than 0.8 (Figure 8).
# Modify dummy raster values r[c(1,2,45,46,47)] <- 6 at <- attTbl(r, "dummy_var")# re-compute at nbs <- ngbList(r) # re-compute nbs # a) initial raster object at$RO <- anchor.seed(at, nbs, class=1, silent = TRUE, cond.seed = "dummy_var == 8", cond.growth = "dummy_var == 5") # b) compute standardized relative position index at$PI <- (at$dummy_var - mean(at$dummy_var))/stats::sd(at$dummy_var) # c) add raster object at$ROa <- pi.add(at, nbs, RO = "RO", mainPI = "PI", add.mPI = 0.8) # d) add raster object, min number of cell is 3 at$ROn <- pi.add(at, nbs, RO = "RO", mainPI = "PI", add.mPI = 0.8, min.N = 3)
# CONVERT THE CLASS VECTORS INTO A RASTER PIc <- at$PI PIc[PIc<0.8 | at$RO==1] <- NA PIc[PIc>0.8] <- 1 r_RO <- cv.2.rast(r, classVector = at$RO) r_PIc <- cv.2.rast(r, classVector = PIc) r_ROa <- cv.2.rast(r, classVector = at$ROa) r_ROn <- cv.2.rast(r, classVector = at$ROn) layout(matrix(c(1, 2, 1, 2, 3, 4, 3, 4), nrow=4, byrow=TRUE)) m <- c(0,0.4,0.5,3.1) # PLOT 1 ################################################################################ plot(r_RO, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE, col=c("#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1"))) text(r);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(a) RO", family = "serif") text(x=0, y=-0.04, cex=1.4, font=1, adj=0, family = "serif", col="#818792", "cond.seed: dummy_var == 8") text(x=0, y=-0.10, cex=1.4, font=1, adj=0, family = "serif", col="#818792", "cond.growth: dummy_var == 5") # PLOT 2 ################################################################################ plot(r_RO, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE, col=c("#cfc1af"), legend = FALSE) plot(r_PIc, type = "classes", ylim=c(-0.12,1.08), mar = m, axes=FALSE, col=c("#ff000060"), add = TRUE, plg=list(x=1, y=1, cex=1.1, title = "Add:", title.adj = 0.2, legend=c("PI >0.8"))) text(xyFromCell(r,at$Cell), as.character(round(at$PI,2))) lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(b) PI", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "cond.: PI > 0.8", family = "serif", col="#818792") # PLOT 3 ################################################################################ plot(r_ROa, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE, col=c("#818792", "#78b2c4", "#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2", "3"))) text(r);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(c) ROa", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: NA", family = "serif", col="#818792") # PLOT 4 ################################################################################ plot(r_ROn, type = "classes", ylim=c(-0.14,1.08), mar = m, axes=FALSE, col=c("#78b2c4", "#cfc1af"), plg=list(x=1, y=1, cex=1.1, title = "Obj.:", title.adj = 0.2, legend=c("1", "2"))) text(r);lines(r) text(x=0, y=1.05, cex=1.7, font=2, adj=0, "(d) ROn", family = "serif") text(x=0, y=-0.04, cex=1.5, font=1, adj=0, "min.N: 3", family = "serif", col="#818792")
**Figure 8 - pi.add** adds new raster objects based on position index values. **(a)** Initial raster object. **(b)** Position index values. **(c)** Add raster objects composed of cells having position index values `>0.8`. **(d)** Add raster objects composed of cells having position index values `>0.8` and with at least 3 cells. Note that new raster objects are added only if they do not share any border with the initial object.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.