library(GISTools);library(rgdal);library(splancs);library(raster);library(dbscan);library(spdep)
rm(list=ls())
setwd("C:/Users/user/Desktop/fin")
#台北市人口邊界資料
tpe=readOGR(dsn = ".", layer = "tpe_subtown", encoding="utf8",verbose = F)
bondary=read.table("tpe_sqr_bnd.csv", header=TRUE, sep=",")
BDP=as.points(bondary[,2], bondary[,3])
#台北市各級學校資料
school=readOGR(dsn = ".", layer = "school", encoding="utf8",verbose = F)
high=subset(school,school@data$TYPE=="高級中等學校")
junior=subset(school,school@data$TYPE %in% c("附設國民中學","國民中學"))
primary=subset(school,school@data$TYPE %in% c("附設國民小學","國民小學"))
school_dt=school@data
high_dt=high@data
junior_dt=junior@data
primary_dt=primary@data
school.pt=as.points(school_dt$XCOORD,school_dt$YCOORD)
high.pt=as.points(high_dt$XCOORD,high_dt$YCOORD)
junior.pt=as.points(junior_dt$XCOORD,junior_dt$YCOORD)
primary.pt=as.points(primary_dt$XCOORD,primary_dt$YCOORD)
一、(20%)
「『高中職社區化』是指教育部為均衡高中職發展、整合高中職資源,使國中畢業生能就近升學高中、高職的一種策略性規劃,目的在達成均衡高中職教育品質、學生適性學習以及就近入學,以建構高中職『就學社區』的理想。」
在高中職社區化構想下,想知道台北市內高中與國中之間的分布狀況。請使用Bivariate F function回答「高中附近是否有國中群聚」,即探討國中到最近高中的距離之遠近關係。
參數設定: 請找出3公里以內的F值,以100公尺為間隔。
作答要求: 請畫出Bivariate F function的圖,同時包含隨機情形的包絡線,並以文字加以說明。#F s=seq(0,3000,100) NP.F=Fhat(high.pt,junior.pt, s) nsim=99; U.Fhat=-9999;L.Fhat=99999 for(i in 1:nsim) { NP.CSR=csr(BDP, npts(high.pt)) NP.F.CSR=Fhat(NP.CSR, junior.pt, s) U.Fhat=pmax(NP.F.CSR, U.Fhat) L.Fhat=pmin(NP.F.CSR, L.Fhat) } plot(s, NP.F, type="l", xlab="距離(單位:公尺)", ylab="F值", main="F函數:高中附近是否有國中群聚") lines(s, U.Fhat, col="red", lty=3) lines(s, L.Fhat, col="blue", lty=3)
二、(20%)
配合台北市各村里的人口數或人口密度,使用DBSCAN找出國中的空間群聚關係。
參數設定: 搭配各村里人口資料,來調整DBSCAN設定的參數。
作答要求: 請解釋如何設定參數,繪製出點群聚的地圖,並以文字說明國中的空間群聚關係。#DBSCAN shade=auto.shading(tpe@data$Sum_CENSUS/area(tpe),n=5,cols = paste(brewer.pal(5, "YlGn"),"88",sep="")) colors=c("black",brewer.pal(7, "Set1"),brewer.pal(11, "Paired")) xdbscan=function(pt,u,v){ res=dbscan(pt, eps = u, minPts = v) hullplot(pt, res, asp=1,col =colors,xlim=c(300000,315000), ylim=c(2760000,2790000),main ="",axes =F,cex=NA,xlab="",ylab="") choropleth(tpe,tpe@data$Sum_CENSUS/area(tpe),shade,add=T,border="#BBBBBB") pointmap(pt, col = colors[res$cluster +1] , pch = res$cluster +1 ,cex=1.5,add=T) plot(tpe,col=rgb(0,0,0,0),add=T) } par(mfrow=c(1,2)) xdbscan(junior.pt,1200,3) xdbscan(junior.pt,1300,3)
三、(30%)
加總國中與國小點位至台北市次分區圖層,以每個次分區中,國中小學校之「數量」與「密度」(學校數量/面積),分別繪製出LISA空間自相關地圖。
參數設定: 各次分區的空間鄰近使用距離來判斷(distance-based),在五公里以內即算是互為鄰近關係。LISA的顯著水準為 α=0.1 (雙尾)。
作答要求: 分別以學校數量和密度,繪製出兩張LISA地圖,並請在地圖上以顏色區分HH、LL、HL、LH及不顯著的地區,以文字加以說明空間群聚關係。並回答你認為使用數量或密度哪個比較適合,以及比較第二題使用點資料作群聚的方法結果有什麼差異。##Q3. xLISA=function(vec,poly,nbw,alpha=0.05,alternative ="two.sided"){ LISA=localmoran(vec,nbw,alternative ="two.sided") diff=vec - mean(vec) z=LISA[,4] quad=vector(mode="numeric",length=nrow(LISA)) quad[diff>0 & z>0]=1 # H-H quad[diff<0 & z>0]=2 # L-L quad[diff>0 & z<0]=3 # H-L quad[diff<0 & z<0]=4 # L-H quad[LISA[, 5]>alpha]=5 #因為在localmoran就設定雙尾 colors=c("red", "blue", "lightpink", "skyblue2", rgb(.95, .95, .95)) plot(poly, border="grey", col=colors[quad], main ="LISA Map") legend("bottomright",legend=c("High-High","Low-Low","High-Low","Low-High","Not Significant"), fill=colors,bty="n",cex=0.7,y.intersp=1,x.intersp=1) } coords=coordinates(tpe) tpe.dnn.nb=dnearneigh(coords, d1=0, d2=5000, row.names=tpe$OBJECTID) tpe.dnn.nb.w=nb2listw(tpe.dnn.nb) sch.count=poly.counts(junior,tpe)+poly.counts(primary,tpe) sch.density=sch.count/area(tpe) xLISA(sch.count,tpe,tpe.dnn.nb.w,0.1)
xLISA(sch.density,tpe,tpe.dnn.nb.w,0.1)
四、(30%)
欲探討台北市各次分區中,人口與國中小學的學校數量的關係。因變數受到空間自相關的影響,故選擇空間迴歸分析,使用Spatial Lag Model作為分析方法:
\(y={\rho}Wy+x{\beta}+{\varepsilon}\)
其中 y 代表各次分區之國中小學的學校數量(單位:間), x 代表各次分區人口數(單位:每萬人), W 為空間鄰近矩陣,以Queen 一階鄰近的方式來定義,並經過列標準化後得到的結果。
經過SLM模型計算後得到 ρ=0.4826 ,β=0.2594。請計算spatial multiplier 矩陣後回答下列問題。tpe.nb=poly2nb(tpe) tpe.nb.w=nb2listw(tpe.nb) tpe.nb.wmat <-nb2mat(tpe.nb, style="W") CENSUS=tpe@data$Sum_CENSUS/10000 sar=lagsarlm(sch.count~CENSUS, listw=tpe.nb.w) rho=0.4826 #coef(sar)[1] beta=0.2594 #coef(sar)[3] N=length(CENSUS) eye=diag(N)
(一) 照ID順序(即不更動順序下),列出spatial multiplier前5列×前5行的矩陣
sp_multiplier=solve(eye - rho * tpe.nb.wmat) sp_multiplier[1:5,1:5]
## 0 1 2 3 4 ## [1,] 1.051821533 0.09066754 0.01786745 0.09471168 0.009978498 ## [2,] 0.126934553 1.04799806 0.12282584 0.12531073 0.022026055 ## [3,] 0.020845356 0.10235487 1.04764594 0.10562754 0.106113732 ## [4,] 0.094711683 0.08950766 0.09053789 1.05428853 0.096766675 ## [5,] 0.008731186 0.01376628 0.07958530 0.08467084 1.060612622
(二) 若每個次分區人口都均等地成長10%,請繪製SLM估計每個次分區學校數量增加的趨勢地圖,並列出可能成長前十名的次分區(名字與預測的增加量)。
cvec=CENSUS*0.1 rus.est=sp_multiplier%*% cvec * beta rus.est=data.frame(tpe@data$SEC_NAME,rus.est) rus.est[rev(order(rus.est$rus.est)),][1:10,]
## tpe.data.SEC_NAME rus.est ## 62 石牌地區 0.7478363 ## 41 興隆地區 0.6671393 ## 5 三張犁地區 0.6386085 ## 2 東社地區 0.6280708 ## 52 金龍地區 0.6275514 ## 49 東湖地區 0.6220419 ## 42 木柵地區 0.6133745 ## 1 三民地區 0.5924985 ## 60 天母地區 0.5719952 ## 40 景美地區 0.5586238
par(mfrow=c(1,1)) tpe$rus.est=rus.est[,2] colR=colorRampPalette(c("white","orange","red"), space = "rgb") spplot(tpe, zcol="rus.est", col.regions=colR(20), main="Spillover Effects")
(三) 假設某發生事件使台北市人口有不規則的改變,在公館地區、學府地區、興隆地區、東門地區的人口各增加一萬人,在大直地區、西湖地區、金龍地區、灣仔地區的人口各減少一萬人,其餘地方保持不變。請繪製SLM估計每個次分區學校數量增減之趨勢地圖(請用視覺化方式呈現出增加或減少的差異),並列出預測增加與減少量最多的各前五名之次分區(名字與預測的增減量)。
cvec=rep(0,N) cvec[c(11,25,29,41)]=1 cvec[c(20,50,52,53)]=-1 rus.est=sp_multiplier%*% cvec * beta rus.est=data.frame(tpe@data$SEC_NAME,rus.est) rus.est[rev(order(rus.est$rus.est)),][1:5,]
## tpe.data.SEC_NAME rus.est ## 25 公館地區 0.3321525 ## 11 學府地區 0.3254932 ## 41 興隆地區 0.3175596 ## 29 東門地區 0.2800971 ## 40 景美地區 0.1248943
rus.est[rev(order(rus.est$rus.est)),][N:(N-5),]
## tpe.data.SEC_NAME rus.est ## 50 西湖地區 -0.35814339 ## 52 金龍地區 -0.33707942 ## 53 灣仔地區 -0.31168098 ## 20 大直地區 -0.29981125 ## 51 紫陽地區 -0.13126086 ## 49 東湖地區 -0.08104363
tpe$rus.est=rus.est[,2] colR=colorRampPalette(c("blue","white","red"), space = "rgb") spplot(tpe, zcol="rus.est", col.regions=colR(20), main="Spillover Effects")