Nothing
context("spatial function tests")
library(terra)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### Testing the global and local moran I
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_that("The global moran I calculated is the same as the one in raster package",{
set.seed(1254)
mat <- matrix(sample(1:10, size = 100, replace = TRUE), nrow = 10, ncol = 10)
w <- matrix(1, nrow = 3, ncol = 3)
w[2,2] <- 0
# raster::Moran(raster::raster(mat), w = w), expected value : 0.07608944
expected <- 0.07608944
val <- calc_moran_raster(terra::rast(mat), w = w)
expect_equal(val, expected)
})
test_that("The local moran I calculated is the same as the one in raster package",{
set.seed(1254)
mat <- matrix(sample(1:10, size = 25, replace = TRUE), nrow = 5, ncol = 5)
#v1 <- raster::as.matrix(MoranLocal(raster::raster(mat)))
expected <- c(-1.158590254, -0.008237818, 0.087379712, -0.005295740, -0.220802942)
v2 <- terra::as.matrix(calc_local_moran_raster(terra::rast(mat), window = matrix(1, nrow = 3, ncol = 3)), wide = TRUE)
expect_equal(expected, v2[1,])
})
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### Testing the ELSA function
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
### for vector
test_that("The ELSA index calculated on vector should give the same values as in the original paper",{
categories <- rep(1, times = 9)
categories[[5]] <- 2
dists <- rbind(c(0,1), c(1,0))
neighmat <- matrix(0, ncol = 9, nrow = 9)
p1 <- c(1,1,1,2,2,2,2,2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6,7,7,7,8,8,8,8,8,9,9,9)
p2 <- c(2,4,5,1,4,5,6,3,2,5,6,1,2,5,7,8,1,2,3,4,6,7,8,9,2,3,5,8,9,4,5,8,4,5,6,7,9,5,6,8)
for(i in 1:length(p1)){
neighmat[p1[[i]], p2[[i]]] <- 1
}
nb <- spdep::mat2listw(neighmat)
## testA
vals <- elsa_vector(rep(1,9), nb, dists)
testA <- round(vals[[5]],3) == 0
## test B
vals <- calcELSA(categories, nb, matdist = dists)
testB <- round(vals[[5]],3) == 0.503
## test C
categories <- rep(1, times = 9)
categories[[3]] <- 2
vals <- calcELSA(categories, nb, matdist = dists)
testC <- round(vals[[5]],3) == 0.063
## test D
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
categories <- c(1,2,1,2,3,2,1,2,1)
vals <- elsa_vector(categories, nb, dists)
testD <- round(vals[[5]],3) == 0.878
## test E
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
categories <- c(2,2,2,1,3,1,2,2,2)
vals <- elsa_vector(categories, nb, dists)
testE <- round(vals[[5]],3) == 0.773
expect_true(testA & testB & testC & testD & testE)
})
test_that("The fuzzy ELSA index calculated on vector should give the same values as in the original paper",{
dists <- rbind(c(0,1), c(1,0))
neighmat <- matrix(0, ncol = 9, nrow = 9)
p1 <- c(1,1,1,2,2,2,2,2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6,7,7,7,8,8,8,8,8,9,9,9)
p2 <- c(2,4,5,1,4,5,6,3,2,5,6,1,2,5,7,8,1,2,3,4,6,7,8,9,2,3,5,8,9,4,5,8,4,5,6,7,9,5,6,8)
for(i in 1:length(p1)){
neighmat[p1[[i]], p2[[i]]] <- 1
}
nb <- spdep::mat2listw(neighmat)
## testA
mat <- matrix(0, nrow = 9, ncol =2)
mat[,1] <- 1
vals <- elsa_fuzzy_vector(mat, nb, dists)
testA <- round(vals[[5]],3) == 0
## test B
mat <- matrix(0, nrow = 9, ncol =2)
mat[,1] <- 1
mat[5,] <- c(0,1)
vals <- calcFuzzyELSA(mat, nb, matdist = dists)
testB <- round(vals[[5]],3) == 0.503
## test C
mat <- matrix(0, nrow = 9, ncol =2)
mat[,1] <- 1
mat[3,] <- c(0,1)
my_object <- FCMres(list(
"Data" = data.frame(x = rep(0, times = 9),
y =rep(0, times = 9)),
"Belongings" = mat,
"Centers" = rbind(c(0,1),
c(0,0)),
"m" = 1,
"algo" = "cmeans"
))
vals <- calcFuzzyELSA(my_object, nb, matdist = dists)
testC <- round(vals[[5]],3) == 0.063
## test D
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
mat <- cbind(
c(1,0,1,0,0,0,1,0,1),
c(0,1,0,1,0,1,0,1,0),
c(0,0,0,0,1,0,0,0,0)
)
vals <- elsa_fuzzy_vector(mat, nb, matdist = dists)
testD <- round(vals[[5]],3) == 0.878
## test E
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
mat <- cbind(
c(1,1,1,0,0,0,1,1,1),
c(0,0,0,1,0,1,0,0,0),
c(0,0,0,0,1,0,0,0,0)
)
vals <- elsa_fuzzy_vector(mat, nb, dists)
testE <- round(vals[[5]],3) == 0.773
expect_true(testA & testB & testC & testD & testE)
})
### for raster
test_that("The ELSA index calculated on raster should give the same values as in the original paper",{
dists <- rbind(c(0,1), c(1,0))
window <- matrix(1, ncol = 3, nrow = 3)
## testA
mat <- matrix(0, ncol = 3, nrow = 3)
vals <- elsa_raster(mat, window, dists)
testA <- round(vals[[5]],3) == 0
## test B
mat <- matrix(0, ncol = 3, nrow = 3)
mat[2,2] <- 1
#vals <- raster::values(elsa_raster(raster::raster(mat), window, dists))
vals <- terra::values(elsa_raster(terra::rast(mat),window, dists),mat = FALSE)
testB <- round(vals[[5]],3) == 0.503
## test C
mat <- matrix(0, ncol = 3, nrow = 3)
mat[1,3] <- 1
vals <- Elsa_categorical_matrix_window(mat, window, dists)
testC <- round(vals[[5]],3) == 0.063
## test D
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
mat <- matrix(c(0,1,0,1,2,1,0,1,0), ncol = 3, nrow = 3)
vals <- Elsa_categorical_matrix_window(mat, window, dists)
testD <- round(vals[[5]],3) == 0.878
## test E
dists <- rbind(c(0,1,1), c(1,0,1),c(1,1,0))
mat <- matrix(c(0,0,0,2,1,2,0,0,0), ncol = 3, nrow = 3)
vals <- Elsa_categorical_matrix_window(mat, window, dists)
testE <- round(vals[[5]],3) == 0.773
expect_true(testA & testB & testC & testD & testE)
})
test_that("The fuzzy ELSA index calculated on raster should give the same values as in the original paper",{
dists <- rbind(c(0,1), c(1,0))
mat <- matrix(0, ncol = 3, nrow = 3)
window <- matrix(1, ncol = 3, nrow = 3)
## testA
mat1 <- matrix(0, nrow = 3, ncol =3)
mat2 <- matrix(1, nrow = 3, ncol =3)
arr <- array(c(mat1,mat2), c(3,3,2))
vals <- Elsa_fuzzy_matrix_window(arr, window, dists)
testA <- round(vals[[5]],3) == 0
## test B
mat1 <- matrix(0, nrow = 3, ncol =3)
mat2 <- matrix(1, nrow = 3, ncol =3)
mat1[2,2] <- 1
mat2[2,2] <- 0
vals <- terra::values(calcFuzzyELSA(object = list(
terra::rast(mat1),
terra::rast(mat2)),
window = window, matdist = dists
))
testB <- round(vals[[5]],3) == 0.503
## test C
mat1 <- matrix(0, nrow = 3, ncol =3)
mat2 <- matrix(1, nrow = 3, ncol =3)
mat1[1,3] <- 1
mat2[1,3] <- 0
my_object <- FCMres(list(
"Data" = list(terra::rast(mat1),terra::rast(mat1)),
"rasters" = list(terra::rast(mat1),terra::rast(mat2)),
"Centers" = rbind(c(0,1),
c(0,0)),
"m" = 1,
"algo" = "cmeans"
))
vals <- terra::values(calcFuzzyELSA(object = my_object,
window = window, matdist = dists
), mat = FALSE)
testC <- round(vals[[5]],3) == 0.063
## test D
dists <- matrix(1, nrow = 3, ncol = 3)
diag(dists) <- 0
mat1 <- cbind(c(0,0,0),
c(0,1,0),
c(0,0,0)
)
mat2 <- cbind(c(0,1,0),
c(1,0,1),
c(0,1,0)
)
mat3 <- cbind(c(1,0,1),
c(0,0,0),
c(1,0,1)
)
vals <- terra::values(calcFuzzyElsa_raster(list(
terra::rast(mat1),
terra::rast(mat2),
terra::rast(mat3)),
window = window, matdist = dists
), mat = FALSE)
#arr <- array(c(mat1,mat2,mat3), c(3,3,3))
#vals <- Elsa_fuzzy_matrix_window(arr, window, dists)
testD <- round(vals[[5]],3) == 0.878
## test E
mat1 <- cbind(c(0,0,0),
c(0,1,0),
c(0,0,0)
)
mat2 <- cbind(c(1,1,1),
c(0,0,0),
c(1,1,1)
)
mat3 <- cbind(c(0,0,0),
c(1,0,1),
c(0,0,0)
)
arr <- array(c(mat1,mat2, mat3), c(3,3,3))
vals <- Elsa_fuzzy_matrix_window(arr, window, dists)
testE <- round(vals[[5]],3) == 0.773
expect_true(testA & testB & testC & testD & testE)
})
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### Testing sp consistency index
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_that("Testing the spatial consistency index for a vector dataset",{
# first, creating a membership matrix for 4 observations (squarred 2x2) and 2 groups
belong_mat <- matrix(0,nrow = 4, ncol = 2)
belong_mat[1,1] <- 1
belong_mat[2,1] <- 1
belong_mat[3,2] <- 1
belong_mat[4,2] <- 1
# second, creating the spatial neighbouring matrix
neighmat <- matrix(0, ncol = 4, nrow = 4)
neighmat[1,2] <- 1
neighmat[2,1] <- 1
neighmat[1,3] <- 1
neighmat[3,1] <- 1
neighmat[4,2] <- 1
neighmat[2,4] <- 1
neighmat[4,3] <- 1
neighmat[3,4] <- 1
nb <- spdep::mat2listw(neighmat)
# each observation has a diff of 2 with a neighbour
expected <- 4*2
obtained <- spConsistency(belong_mat, nblistw = nb,nrep = 5)
expect_equal(expected, obtained$sum_diff)
})
test_that("Testing the spatial consistency index for a raster dataset",{
# first, creating a membership matrix for 4 observations (squarred 2x2) and 2 groups
rast1 <- rbind(
c(1,1),
c(0,0)
)
rast1 <- terra::rast(rast1)
rast2 <- rbind(
c(0,0),
c(1,1)
)
rast2 <- terra::rast(rast2)
rasters <- list(rast1,rast2)
W <- matrix(1, nrow = 3, ncol = 3)
Data <- rasters
centers <- data.frame(
x1 = c(1,0),
x2 = c(0,1)
)
myFCMres <- FCMres(list(
"Data" = Data,
"Centers" = centers,
"rasters" = rasters,
"m" = 1,
"algo" = "kmeans"
))
# each observation has a diff of 2 with two neighbours
expected <- 2 * 2 * 4
obtained <- spConsistency(myFCMres, window = matrix(1, nrow = 3, ncol = 3),nrep = 5)
expect_equal(expected, obtained$sum_diff)
})
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### Testing the adjusting of spatial weight by semantical distance
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_that("Testing the function adjustSpatialWeights",{
df1 <- data.frame(
x = c(1,1,0,0),
y = c(1,1,0,0)
)
neighmat <- rbind(
c(0,1,1,0),
c(1,0,0,1),
c(1,0,0,1),
c(0,1,1,0)
)
nb <- spdep::mat2listw(neighmat, style = "W")
# expected weights
distmat <- as.matrix(dist(df1)**2)
distmat <- 1/distmat
distmat[is.infinite(distmat)] <- 0
distmat <- distmat * neighmat
distmat <- distmat / rowSums(distmat)
# obtained weight
expect_warning({adj_nb <- adjustSpatialWeights(data = df1, listw = nb$neighbours, style = "W")})
obtained <- round(spdep::listw2mat(adj_nb),5)
diff <- sum(abs((distmat - obtained)))
expect_equal(diff, 0)
})
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### Testing the adjusted spatial consistency index
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_that("Testing the spatial consistency index for a raster dataset with an adjusted matrix",{
# first, creating a membership matrix for 4 observations (squarred 2x2) and 2 groups
rast1 <- rbind(
c(1,1),
c(0,0)
)
rast1 <- terra::rast(rast1)
rast2 <- rbind(
c(0,0),
c(1,1)
)
rast2 <- terra::rast(rast2)
rasters <- list(rast1,rast2)
W <- matrix(1, nrow = 3, ncol = 3)
Data <- rasters
centers <- data.frame(
x1 = c(1,0),
x2 = c(0,1)
)
myFCMres <- FCMres(list(
"Data" = Data,
"Centers" = centers,
"rasters" = rasters,
"m" = 1,
"algo" = "kmeans"
))
w <- matrix(1, nrow = 3, ncol = 3)
w[2,2] <- 0
obtained <- spConsistency(object = myFCMres,
window = w,
nblistw = NULL,
nrep = 1,
adj = TRUE,
mindist = 0.001)
# first, I will calculate the eucldiean distances
mindist <- 0.001
m1 <- rbind(
c(1,1),
c(0,0)
)
m2 <- rbind(
c(0,0),
c(1,1)
)
U1 <- rbind(
c(1,1),
c(0,0)
)
U2 <- rbind(
c(0,0),
c(1,1)
)
# first sequence of iterations to have the global weight
total_dist <- 0
for(i in 1:nrow(m1)){
for(j in 1:ncol(m2)){
tub1 <- c(m1[i,j], m2[i,j])
for(i2 in 1:nrow(m1)){
for(j2 in 1:ncol(m1)){
if(i!=i2 | j!=j2){
tub2 <- c(m1[i2,j2], m2[i2,j2])
dist <- sum((tub1 - tub2) ** 2)
if(dist < mindist){
total_dist <- total_dist + 1/ mindist
}else{
total_dist <- total_dist + 1/ dist
}
}
}
}
}
}
# second sequence of iterations to have the index
total_index <- 0
for(i in 1:nrow(U1)){
for(j in 1:ncol(U1)){
tub1 <- c(m1[i,j], m2[i,j])
u1 <- c(U1[i,j],U2[i,j])
for(i2 in 1:nrow(U1)){
for(j2 in 1:ncol(U1)){
if(i!=i2 | j!=j2){
tub2 <- c(m1[i2,j2], m2[i2,j2])
u2 <- c(U1[i2,j2],U2[i2,j2])
dist <- sum((tub1 - tub2) ** 2)
if(dist < mindist){
dist <- mindist
}
wij <- (1/dist) / total_dist
total_index <- total_index + (wij * sum((u1-u2)**2))
}
}
}
}
}
expect_equal(total_index, obtained$sum_diff)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.