rm(list=ls())
setwd("D:/_Lab_Data/R/R_Labs")
library(rgdal)
library(spdep)
# Loading Shapefiles
TWN <- readOGR(dsn = "shapefiles", layer = "Popn_TWN", encoding="big5")
Code<-TWN@data$Code
sel2<- Code < 42 & Code >=30
TWN_North<- TWN[sel2,]
plot(TWN_North); head(TWN_North@data)
## UNI_ID Town County Area Code towncode Male Female Age25 Age34 Age44
## 29 30 松山區 臺北市 9 30 6301 3148 2758 170 660 1109
## 30 31 信義區 臺北市 11 31 6302 4200 3402 242 934 1246
## 31 32 大安區 臺北市 11 32 6303 4036 3540 417 959 1313
## 32 33 中山區 臺北市 14 33 6304 4618 4553 439 1361 1808
## 33 34 中正區 臺北市 8 34 6305 4054 3243 417 1005 1174
## 34 35 大同區 臺北市 6 35 6306 3611 3020 189 856 1242
## Age54 Age64 Age_L65 Popn
## 29 1392 1252 1323 5906
## 30 1795 1617 1768 7602
## 31 1604 1528 1755 7576
## 32 2123 1867 1573 9171
## 33 1577 1429 1695 7297
## 34 1506 1351 1487 6631
#?poly2nb: Construct neighbours list
TWN_nbq<-poly2nb(TWN_North) #QUEEN = TRUE
summary(TWN_nbq)
## Neighbour list object:
## Number of regions: 12
## Number of nonzero links: 48
## Percentage nonzero weights: 33.33333
## Average number of links: 4
## Link number distribution:
##
## 1 2 4 5 6
## 1 1 6 3 1
## 1 least connected region:
## 40 with 1 link
## 1 most connected region:
## 32 with 6 links
TWN_nbq2<-poly2nb(TWN_North,queen=FALSE )
TWN_nbq_w.mat <-nb2mat(TWN_nbq, style="B"); TWN_nbq_w.mat
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
## 29 0 1 1 1 0 0 0 0 1 1 0 0
## 30 1 0 1 0 0 0 0 1 1 0 0 0
## 31 1 1 0 1 1 0 0 1 0 0 0 0
## 32 1 0 1 0 1 1 0 0 0 1 1 0
## 33 0 0 1 1 0 1 1 1 0 0 0 0
## 34 0 0 0 1 1 0 1 0 0 0 1 0
## 35 0 0 0 0 1 1 0 0 0 0 0 0
## 36 0 1 1 0 1 0 0 0 1 0 0 0
## 37 1 1 0 0 0 0 0 1 0 1 0 0
## 38 1 0 0 1 0 0 0 0 1 0 1 0
## 39 0 0 0 1 0 1 0 0 0 1 0 1
## 40 0 0 0 0 0 0 0 0 0 0 1 0
## attr(,"call")
## nb2mat(neighbours = TWN_nbq, style = "B")
TWN.region.id <- attr(TWN_nbq, "region.id")
TWN.neighbors.index = TWN_nbq[[match("33", TWN.region.id)]]
TWN.neighbors = rownames(TWN_nbq_w.mat[TWN.neighbors.index,]); TWN.neighbors
## [1] "31" "32" "34" "35" "36"
coords<-coordinates(TWN_North)
plot(TWN_North)
plot(TWN_nbq, coords, add=T)
IDs <-TWN_North@data$UNI_ID
TWN_kn1<-knn2nb(knearneigh(coords, k=1), row.names=IDs)
plot(TWN_North)
plot(TWN_kn1, coords, add=T)
TWN_PTS<-SpatialPointsDataFrame(coords, TWN_North@data)
sel<- TWN_PTS@data$Area > 30
plot(TWN_PTS[sel,], col="blue", add=TRUE)
#?nbdists; ?dnearneigh
dist<-unlist(nbdists(TWN_kn1, coords)); summary(dist)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2249 2261 2752 3188 4167 4660
TWN_ran1<-dnearneigh(coords, d1=0, d2=7000, row.names=IDs)
plot(TWN_North)
plot(TWN_ran1, coords, add=T)
# Row-standardized weights matrix
TWN_nbq_w<- nb2listw(TWN_nbq, zero.policy=T) # default: style = "W"
TWN_nbq_w
## Characteristics of weights list object:
## Neighbour list object:
## Number of regions: 12
## Number of nonzero links: 48
## Percentage nonzero weights: 33.33333
## Average number of links: 4
##
## Weights style: W
## Weights constants summary:
## n nn S0 S1 S2
## W 12 144 12 6.776667 49.63833
# Binary matrix
TWN_nbq_wb2<-nb2listw(TWN_nbq, style="B", zero.policy=T); TWN_nbq_wb2
## Characteristics of weights list object:
## Neighbour list object:
## Number of regions: 12
## Number of nonzero links: 48
## Percentage nonzero weights: 33.33333
## Average number of links: 4
##
## Weights style: B
## Weights constants summary:
## n nn S0 S1 S2
## B 12 144 48 96 848
Popn<-TWN_North@data$Popn; Area<-TWN_North@data$Area
Density<-Popn/Area
TWN_North@data$Density<- Density
M<-moran.test(Density, listw=TWN_nbq_w, zero.policy=T); M
##
## Moran's I test under randomisation
##
## data: Density
## weights: TWN_nbq_w
##
## Moran I statistic standard deviate = 2.4554, p-value = 0.007037
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.36409091 -0.09090909 0.03433907
set.seed(123456)
bperm<-moran.mc(Density,listw=TWN_nbq_w,nsim=999)
hist(bperm$res, freq=TRUE, breaks=20, xlab="Simulated Moran's I")
abline(v=0.39519718, col="red")
cor2<-sp.correlogram(TWN_nbq, Density, order=2, method="I", style="W")
print(cor2); plot(cor2)
## Spatial correlogram for Density
## method: Moran's I
## estimate expectation variance standard deviate Pr(I) two sided
## 1 (12) 0.364091 -0.090909 0.034339 2.4554 0.01407 *
## 2 (12) -0.305631 -0.090909 0.024241 -1.3791 0.16786
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
TWN_ran1_wb<-nb2listw(TWN_ran1, style="B", zero.policy=T)
G<-globalG.test(Density, listw=TWN_ran1_wb); G
##
## Getis-Ord global G statistic
##
## data: Density
## weights: TWN_ran1_wb
##
## standard deviate = 3.264, p-value = 0.0005492
## alternative hypothesis: greater
## sample estimates:
## Global G statistic Expectation Variance
## 0.747403137 0.500000000 0.005745246
LISA.Density <- localmoran(Density, TWN_nbq_w, zero.policy=T)
LISA.Density2 <- as.data.frame(localmoran.exact(lm(Density ~1, TWN_North@data), nb=TWN_nbq, style="C"))
class(LISA.Density)
## [1] "localmoran" "matrix"
printCoefmat(data.frame(LISA.Density))
## Ii E.Ii Var.Ii Z.Ii Pr.z...0.
## 29 -0.032517 -0.090909 0.116304 0.171221 0.4320
## 30 -0.107933 -0.090909 0.166793 -0.041683 0.5166
## 31 0.122681 -0.090909 0.116304 0.626303 0.2656
## 32 0.084420 -0.090909 0.082645 0.609884 0.2710
## 33 0.560185 -0.090909 0.116304 1.909179 0.0281
## 34 0.460745 -0.090909 0.166793 1.350760 0.0884
## 35 1.228949 -0.090909 0.419236 2.038439 0.0208
## 36 -0.347543 -0.090909 0.166793 -0.628384 0.7351
## 37 0.217835 -0.090909 0.166793 0.755980 0.2248
## 38 0.335753 -0.090909 0.166793 1.044709 0.1481
## 39 0.076730 -0.090909 0.166793 0.410475 0.3407
## 40 1.769785 -0.090909 0.924124 1.935574 0.0265
LISA.Density[,5] # p-value
## 29 30 31 32 33 34
## 0.43202490 0.51662448 0.26555822 0.27096920 0.02811951 0.08838617
## 35 36 37 38 39 40
## 0.02075302 0.73512385 0.22483046 0.14807871 0.34072870 0.02645992
TWN_North$Density <- Density
TWN_North$z.li <- LISA.Density[,4]
TWN_North$pvalue <- LISA.Density[,5]
lm.palette <- colorRampPalette(c("white","orange", "red"), space = "rgb")
spplot(TWN_North, zcol="Density", col.regions=lm.palette(20), main="Density")
spplot(TWN_North, zcol="z.li", col.regions=lm.palette(20), main="Local Moran")
head(TWN_North@data, n=12)
## UNI_ID Town County Area Code towncode Male Female Age25 Age34
## 29 30 松山區 臺北市 9 30 6301 3148 2758 170 660
## 30 31 信義區 臺北市 11 31 6302 4200 3402 242 934
## 31 32 大安區 臺北市 11 32 6303 4036 3540 417 959
## 32 33 中山區 臺北市 14 33 6304 4618 4553 439 1361
## 33 34 中正區 臺北市 8 34 6305 4054 3243 417 1005
## 34 35 大同區 臺北市 6 35 6306 3611 3020 189 856
## 35 36 萬\xb5?\xcf 臺北市 9 36 6307 4090 3188 164 737
## 36 37 文山區 臺北市 32 37 6308 3818 3173 326 766
## 37 38 南港區 臺北市 22 38 6309 4001 2844 136 849
## 38 39 內湖區 臺北市 32 39 6310 3933 3093 202 981
## 39 40 士林區 臺北市 62 40 6311 4394 3253 442 777
## 40 41 北投區 臺北市 57 41 6312 3805 2675 210 632
## Age44 Age54 Age64 Age_L65 Popn Density z.li pvalue
## 29 1109 1392 1252 1323 5906 656.2222 0.17122125 0.43202490
## 30 1246 1795 1617 1768 7602 691.0909 -0.04168347 0.51662448
## 31 1313 1604 1528 1755 7576 688.7273 0.62630266 0.26555822
## 32 1808 2123 1867 1573 9171 655.0714 0.60988439 0.27096920
## 33 1174 1577 1429 1695 7297 912.1250 1.90917894 0.02811951
## 34 1242 1506 1351 1487 6631 1105.1667 1.35075995 0.08838617
## 35 1238 1759 1586 1794 7278 808.6667 2.03843907 0.02075302
## 36 1485 1784 1365 1265 6991 218.4688 -0.62838418 0.73512385
## 37 1385 1725 1413 1337 6845 311.1364 0.75598043 0.22483046
## 38 1550 2061 1396 836 7026 219.5625 1.04470912 0.14807871
## 39 1415 1868 1660 1485 7647 123.3387 0.41047519 0.34072870
## 40 1187 1705 1526 1220 6480 113.6842 1.93557450 0.02645992
writeOGR(TWN_North, dsn="shapefiles", layer="Popn_LISA", driver="ESRI Shapefile")
nci <- moran.plot (Density, TWN_nbq_w, labels=IDs , xlab="Popn Density", ylab="SL Popn Density")
chk<-Density-mean(Density)
zi<- LISA.Density[,4]
quadrant <- vector(mode="numeric",length=nrow(LISA.Density))
quadrant[chk>0 & zi>0] <- 1 # H-H
quadrant[chk<0 & zi>0] <- 2 # L-L
quadrant[chk>0 & zi<0] <- 3 # H-L
quadrant[chk<0 & zi<0] <- 4 # L-H
signif <- 0.05
quadrant[LISA.Density[, 5]> signif] <- 5
colors <- c("red", "blue", "lightpink", "skyblue2", rgb(.95, .95, .95))
par(mar=c(0,0,1,0)) # sets margin parameters for plot space;
# A numeric vector of length 4, which sets the margin sizes in the following order: bottom, left, top, and right. The default is c(5.1, 4.1, 4.1, 2.1).
plot(TWN_North, border="grey", col=colors[quadrant], main = "LISA Cluster Map, Population Density")
legend("bottomright",legend=c("High-High","Low-Low","High-Low","Low-High"), fill=colors,bty="n",cex=0.7,y.intersp=1,x.intersp=1)
#dev.off()
TWN_North$p.adj <- p.adjust(LISA.Density[,5], method="bonferroni")
head(TWN_North@data[,16:19], n=12)
## Density z.li pvalue p.adj
## 29 656.2222 0.17122125 0.43202490 1.0000000
## 30 691.0909 -0.04168347 0.51662448 1.0000000
## 31 688.7273 0.62630266 0.26555822 1.0000000
## 32 655.0714 0.60988439 0.27096920 1.0000000
## 33 912.1250 1.90917894 0.02811951 0.3374341
## 34 1105.1667 1.35075995 0.08838617 1.0000000
## 35 808.6667 2.03843907 0.02075302 0.2490363
## 36 218.4688 -0.62838418 0.73512385 1.0000000
## 37 311.1364 0.75598043 0.22483046 1.0000000
## 38 219.5625 1.04470912 0.14807871 1.0000000
## 39 123.3387 0.41047519 0.34072870 1.0000000
## 40 113.6842 1.93557450 0.02645992 0.3175190
TWN_nbq_in<-include.self(TWN_nbq); summary(TWN_nbq_in)
## Neighbour list object:
## Number of regions: 12
## Number of nonzero links: 60
## Percentage nonzero weights: 41.66667
## Average number of links: 5
## Link number distribution:
##
## 2 3 5 6 7
## 1 1 6 3 1
## 1 least connected region:
## 40 with 2 links
## 1 most connected region:
## 32 with 7 links
TWN_nbq_in_w<- nb2listw(TWN_nbq_in, zero.policy=T)
LG<-localG(Density, TWN_nbq_in_w); LG
## [1] -0.05179141 -0.25373181 0.99011884 0.99812167 1.97406323
## [6] 1.57593542 2.40689738 0.19703028 -1.08014601 -1.31116043
## [11] -0.86816724 -1.97333072
## attr(,"gstari")
## [1] TRUE
## attr(,"call")
## localG(x = Density, listw = TWN_nbq_in_w)
## attr(,"class")
## [1] "localG"
class(LG)
## [1] "localG"
LG1<-0
for (i in 1:12){LG1[i]<-LG[i]}
TWN_North$LG<-LG1
lm.palette <- colorRampPalette(c("white","orange", "red"), space = "rgb")
spplot(TWN_North, zcol="LG", col.regions=lm.palette(20), main="Local G")