# 空間自相關問題處理 (Spatial modelling)
###### tags: `R教學` `生態統計`
**範例**:"indicspecies" 套件運用
[Spatial modelling: a comprehensive framework for principal coordinate analysis of neighbour matrices (PCNM))
](https://www.sciencedirect.com/science/article/pii/S0304380006000925)
```r=
library('dplyr')
library('vegan')
library('adespatial')
library('spdep')
library('ggplot2')
set.seed(1)
n = 10
data = data.frame(id = 1:n,
x1 = runif(n),
x2 = runif(n),
x3 = runif(n),
pos_x = runif(n),
pos_y = runif(n),
pos_z = round(runif(n)*10,0)/10)
a0 = 5
a1 = 4
a2 = 3
a3 = 2
data$y = a0 + a1*data$x1 + a2*data$x2 + a3*data$x3 + rnorm(n,0,1)
print(data)
model = lm(y~x1+x2+x3, data = data)
model %>% summary
dist = matrix(0,nrow = n, ncol = n)
thres = 0.4
for(i in 1:n){
for(j in 1:n){
# spatial distance
d_spa = sqrt((data$pos_x[i]-data$pos_x[j])^2 + (data$pos_y[i]-data$pos_y[j])^2)
# temporal distance
d_tem = data$pos_z[i]-data$pos_z[j]
# 3-dimensional distance
d = (((data$pos_x[i]-data$pos_x[j])^2 + (data$pos_y[i]-data$pos_y[j])^2 + (data$pos_z[i]-data$pos_z[j])^2) ^ (1/3)) %>% round(.,2)
if(d_spa > thres | d_tem == 0){
dist[i,j] = thres*4
}else{
dist[i,j] = d
}
}
}
print(dist)
ac = 0.2
data$y_ac = ac*((matrix(thres*4,nrow = n, ncol = n)-dist) %*% data$y) + (1-ac*thres*4)*data$y
data %>% head(.,10)
dist
model_ori = lm(y_ac~x1+x2+x3, data = data)
model_ori %>% summary
eign = eigen(dist)
data$v1 = round(scale(eign$vectors[,1]),3)
data$v2 = scale(eign$vectors[,2])
# data$v3 = scale(eign$vectors[,3])
model = lm(y_ac~x1+x2+x3+v1 , data = data)
model %>% summary
model = lm(y_ac~x1+x2+x3+v1+v2 , data = data)
model %>% summary
model = lm(y_ac~x1+x2+x3+v1+v2+v3 , data = data)
model %>% summary
g = ggplot(data =data , aes(x = pos_x, y = pos_y))+
geom_point()+
geom_text(aes(label = v1), vjust = -0.8)+
geom_text(aes(label = id), vjust = 1.5)
g
## MEM
data(mite)
spe <- mite[, 2]
data(mite.env)
env <- mite.env[, 1:2]
dim(env)
data(mite.xy)
coord <- mite.xy
mod <- lm(spe ~ ., data = env)
w <- listw.candidates(coord, nb = "gab", weights = "flin")
y <- residuals(mod)
MEM <- mem.select(x = y, listw = w[[1]], method = "MIR", MEM.autocor = "positive",
nperm = 999, alpha = 0.05)
dim(MEM$MEM.select)
env2 <- cbind(env, MEM$MEM.select)
mod_complete <- lm(spe ~ ., data = env2)
summary(mod_complete) # Coefficient estimates
summary(mod_complete) # Standard errors
# round area
r = sqrt(2240000/pi)
r = sqrt(450000/pi)
r
# listw.candidates: Function to create a list of spatial weighting matrices
xy <- matrix(nrow = 100, ncol = 2)
xy[, 1] <- sample(c(1:120), 100, replace = FALSE)
xy[, 2] <- sample(c(1:120), 100, replace = FALSE)
candidates <- listw.candidates(coord = xy, nb = c("gab", "mst", "dnear"),
weights = c("binary", "flin"))
names(candidates)
plot(candidates[[1]], xy)
plot(candidates[[6]], xy)
```
```r=
library('dplyr')
library('vegan')
library('adespatial')
library('ggplot2')
set.seed(1)
n = 30
data = data.frame(id = 1:n,
x1 = runif(n),
x2 = runif(n),
x3 = runif(n),
pos_x = runif(n),
pos_y = runif(n))
a0 = 5
a1 = 4
a2 = 3
a3 = 2
data$y = a0 + a1*data$x1 + a2*data$x2 + a3*data$x3 + rnorm(n,0,1)
print(data)
model = lm(y~x1+x2+x3, data = data)
model %>% summary
dist = matrix(0,nrow = n, ncol = n)
thres = 0.4
for(i in 1:n){
for(j in 1:n){
d = sqrt((data$pos_x[i]-data$pos_x[j])^2 + (data$pos_y[i]-data$pos_y[j])^2) %>% round(.,2)
if(d > 0.4){
dist[i,j] = thres*4
}else{
dist[i,j] = d
}
}
}
print(dist)
ac = 0.2
data$y_ac = ac*((matrix(4*thres,nrow = n, ncol = n)-dist) %*% data$y) + (1-ac*4*thres)*data$y
data %>% head(.,10)
dist
model_ori = lm(y_ac~x1+x2+x3, data = data)
model_ori %>% summary
eign = eigen(dist)
data$v1 = round(scale(eign$vectors[,1]),3)
data$v2 = scale(eign$vectors[,2])
# data$v3 = scale(eign$vectors[,3])
model = lm(y_ac~x1+x2+x3+v1 , data = data)
model %>% summary
model = lm(y_ac~x1+x2+x3+v1+v2 , data = data)
model %>% summary
model = lm(y_ac~x1+x2+x3+v1+v2+v3 , data = data)
model %>% summary
g = ggplot(data =data , aes(x = pos_x, y = pos_y))+
geom_point()+
geom_text(aes(label = v1), vjust = -0.8)+
geom_text(aes(label = id), vjust = 1.5)
g
## MEM
w = listw.candidates(data[,c(5,6)], nb = "gab", weights = "flin")
y = residuals(model_ori)
MEM <- mem.select(x = y, listw = w[[1]], method = "MIR", MEM.autocor = "positive",
nperm = 999, alpha = 0.05)
dim(MEM$MEM.select)
data = cbind(data, MEM$MEM.select)
model = lm(y_ac~x1+x2+x3+MEM1+MEM5+MEM3+MEM4, data = data)
model %>% summary
g = ggplot(data =data , aes(x = pos_x, y = pos_y))+
geom_point()+
geom_text(aes(label = round(MEM1,3)), vjust = -0.8)+
geom_text(aes(label = id), vjust = 1.5)
g
```