Spatial Analysis: 05

#

Contents

Using R package:aspace

Measures of Centrality
1.(Weighted) Mean center
2.Median center
3.Central feature

Measures of Dispersion
1.Standard Distance
2.Weighted Std. Distance
3.Standard Deviational Ellipse

#

0. Laoding Data

rm(list = ls())
library(sf)
library(tmap)
library(aspace) #install.packages("aspace")

警告： 套件 ‘aspace’ 是用 R 版本 4.3.3 來建造的警告： 套件 ‘splancs’ 是用 R 版本 4.3.3 來建造的警告： 套件 ‘sp’ 是用 R 版本 4.3.3 來建造的警告： 套件 ‘Hmisc’ 是用 R 版本 4.3.3 來建造的

library(tidyverse)

schools_sf = st_read("./data/Schools.shp",options="ENCODING=BIG5")

options:        ENCODING=BIG5 
Reading layer `Schools' from data source `C:\Users\wenth\Desktop\WK05\data\Schools.shp' using driver `ESRI Shapefile'
Simple feature collection with 424 features and 10 fields
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: 155883 ymin: 2535016 xmax: 207754.2 ymax: 2588604
Projected CRS: Transverse Mercator

head(schools_sf)

Simple feature collection with 6 features and 10 fields
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: 156258.5 ymin: 2543261 xmax: 171221.4 ymax: 2550982
Projected CRS: Transverse Mercator
  AREA PERIMETER SCHOOL_ SCHOOL_ID           NAME   X_coor  Y_coor ID1 NEAR_FID NEAR_DIST
1    0         0      38        39 土城子國小分校 156258.5 2550982  39       29 3293.0748
2    0         0      81        82       鎮海國小 160475.1 2546815  82       18  668.7404
3    0         0      82        83         幼稚園 162749.6 2545007  83       26  327.9155
4    0         0      86        87       慈幼高工 171221.4 2543562  87        4  139.6705
5    0         0      87        88     母佑幼稚園 171159.1 2543437  88        3  139.6705
6    0         0      88        89     牧群幼稚園 171164.3 2543261  89        4  176.0769
                  geometry
1 POINT (156258.5 2550982)
2 POINT (160475.1 2546815)
3 POINT (162749.6 2545007)
4 POINT (171221.4 2543562)
5 POINT (171159.1 2543437)
6 POINT (171164.3 2543261)

schools_lyr <- tm_shape(schools_sf)+tm_dots(col="red", size= 0.1) + tm_layout(frame = F)

#

1. Data Preparation

(creating required fields)

# Generating no. of student in each school
schools_sf$Students<-as.integer(runif(424,1000,10000))

# Generating school type: cluster vs. isolation
for (i in 1: 424) {
  
  if (schools_sf$NEAR_DIST[i]< 500) {
    schools_sf$type[i]<- "Cluster"
  } else schools_sf$type[i]<- "Isolation"
  
}

index<- schools_sf$type == "Cluster"
school_cluster <- schools_sf[index,]

length(school_cluster)

[1] 13

schools.c_lyr <- tm_shape(school_cluster)+tm_dots(col="red", size= 0.1) + tm_layout(frame = F)

School_df <- data.frame(x=schools_sf$X_coor, y=schools_sf$Y_coor, 
                       type=schools_sf$type, students=schools_sf$Students)

#

2. Mean Center

# calc_mnc() Mean Centre Calculator
Mean.Center <- calc_mnc(id=1, weighted=FALSE, weights=NULL, points=School_df[,1:2])
W.Mean.Center <- calc_mnc(id=1, weighted=TRUE, weights=School_df$students, points=School_df[,1:2])

Mean.xcoor <- Mean.Center$LOCATIONS[2]
Mean.ycoor <- Mean.Center$LOCATIONS[3]

Mean.Center_sfg = st_point(c(Mean.xcoor, Mean.ycoor))
Mean.Center_sfc = st_sfc(Mean.Center_sfg)
Mean.Center_sf <- st_sf(Mean.Center_sfc)
head(Mean.Center_sf) 

Simple feature collection with 1 feature and 0 fields
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: 173823.8 ymin: 2557130 xmax: 173823.8 ymax: 2557130
CRS:           NA
           Mean.Center_sfc
1 POINT (173823.8 2557130)

# using pipe coding style
Mean.Center.Coor <- c(Mean.xcoor, Mean.ycoor)
Mean.Center_sf1 <- Mean.Center.Coor %>% st_point %>% st_sfc %>% st_sf 
class(Mean.Center_sf1)

[1] "sf"         "data.frame"

st_crs(Mean.Center_sf1) <- st_crs(schools_sf)
Mean.Center_lyr <- tm_shape(Mean.Center_sf1)+tm_dots(fill="blue", size=1)

# Weighted Mean Center

W.Mean.xcoor <- W.Mean.Center$LOCATIONS[2]
W.Mean.ycoor <- W.Mean.Center$LOCATIONS[3]

W.Mean.Center.Coor <- c(W.Mean.xcoor, W.Mean.ycoor)
W.Mean.Center_sf <- W.Mean.Center.Coor %>% st_point %>% st_sfc %>% st_sf 
st_crs(W.Mean.Center_sf) <- st_crs(schools_sf)
W.Mean.Center_lyr <- tm_shape(W.Mean.Center_sf)+tm_dots(fill="green", size= 0.5)

schools_lyr + Mean.Center_lyr + W.Mean.Center_lyr

#

3. Median Center

# calc_mdc(): Median Centre Calculator
Median.Center <- calc_mdc(id=1,points=School_df[,1:2])

Median.xcoor <- Median.Center$LOCATIONS[2]
Median.ycoor <- Median.Center$LOCATIONS[3]

Median.Center.Coor <- c(Median.xcoor, Median.ycoor)
Median.Center_sf <- Median.Center.Coor %>% st_point %>% st_sfc %>% st_sf 
st_crs(Median.Center_sf) <- st_crs(schools_sf)
Median.Center_lyr <- tm_shape(Median.Center_sf)+tm_dots(fill = "green", size= 0.5)

### Compare Mean vs. Median
schools_lyr + Mean.Center_lyr + Median.Center_lyr

#

4. SDD: Standard Distance

using plot_sdd

# calc_sdd(): Calculate the Standard Distance Deviation (Standard Distance)
school.SDD <- calc_sdd(id=1, points=School_df[,1:2])
plot_sdd(school.SDD, centre.col="red")

using tmap

center.x<- school.SDD$ATTRIBUTES$CENTRE.x
center.y<- school.SDD$ATTRIBUTES$CENTRE.y

center.coor <- c(center.x, center.y)
center_sf<- center.coor %>% st_point %>% st_sfc %>% st_sf 

st_crs(center_sf) <-  st_crs(schools_sf)

rad<- school.SDD$ATTRIBUTES$SDD.radius
SD_sf<- st_buffer(center_sf, rad)
SD_lyr <- tm_shape(SD_sf) + tm_borders(col = "blue")+tm_layout(frame = F)
Center_lyr <-  tm_shape(center_sf) + tm_dots(fill="blue", size= 0.5)
schools_lyr+ Center_lyr+ SD_lyr 

# weighted SDD
school.SDD2 <- calc_sdd(id=1, points = School_df[,1:2], 
                       weighted = TRUE, weights=School_df$students)

#

5. SDE:Standard Deviational Ellipse

using plot_sde

## SDE Center: sdeatt
# calc_sde() Calculate the Standard Deviation Ellipse
school.SDE<- calc_sde(id=1, points=School_df[,1:2])
plot_sde(school.SDE)

using tmap

## Creating SDE center

SDE.center.x<- school.SDE$ATTRIBUTES$CENTRE.x
SDE.center.y<- school.SDE$ATTRIBUTES$CENTRE.y
SDE.center.coor <- c(SDE.center.x, SDE.center.y)
SDE.center_sf <- SDE.center.coor %>% st_point %>% st_sfc %>% st_sf 
st_crs(SDE.center_sf) <-  st_crs(schools_sf)
SDE.center_lyr <- tm_shape(SDE.center_sf) + tm_dots(fill = "blue", size=0.5)+tm_layout(frame = F)

## Creating SDE Polygon

xcoor <- school.SDE$LOCATIONS$x
ycoor <- school.SDE$LOCATIONS$y
xy = data.frame(x=xcoor, y=ycoor)
xys = st_as_sf(xy, coords=c("x","y"))
st_crs(xys)<-st_crs(schools_sf)

SDE_sfc <- st_cast(st_combine(xys),"POLYGON")
SDE_sf <- st_sf(SDE_sfc)
SDE_lyr <- tm_shape(SDE_sf) + tm_borders(col = "blue") +tm_layout(frame = F)

schools_lyr + SDE.center_lyr + SDE_lyr

#

6. Central Feature

school.CF <- calc_cf(id=1, points=School_df[,1:2])

CF.x<- school.CF$ATTRIBUTES$CF.x
CF.y<- school.CF$ATTRIBUTES$CF.y
CF.coor <- c(CF.x, CF.y)
CF_sf <- CF.coor %>% st_point %>% st_sfc %>% st_sf 
st_crs(CF_sf) <-  st_crs(schools_sf)
CF_lyr <- tm_shape(CF_sf) + tm_dots(fill = "blue", size= 0.5) +tm_layout(frame = F)
schools_lyr + CF_lyr

#

7. Mean Centers by Grouping Attribubtes

type <- schools_sf$type
newid <- unique(type)

schools_lyr2 <- tm_shape(schools_sf) + 
                tm_dots(col="type", palette=c(Cluster='red', Isolation='orange'), size= 0.3) +
                tm_layout(frame = F)

── tmap v3 code detected ────────────────────────────────────────────────────────────────────
[v3->v4] `tm_tm_dots()`: migrate the argument(s) related to the scale of the visual variable
`fill` namely 'palette' (rename to 'values') to fill.scale = tm_scale(<HERE>).

schools_lyr2

xx<-vector(); yy<-vector(); ctype<-vector()

for (i in 1:2){
  index<-(type == newid[i])
  newschool<-schools_sf[index,]
  xcoor<-newschool$X_coor
  ycoor<-newschool$Y_coor
  newschool.mc <- calc_mnc(id=1, points=cbind(xcoor, ycoor))
  
  xx[i]<-newschool.mc$LOCATIONS[2]
  yy[i]<-newschool.mc$LOCATIONS[3]
  ctype[i]<-newid[i]
}

newcenterxy <- data.frame(xx,yy, ctype)
New_sf <- st_as_sf(newcenterxy , coords=c("xx","yy"))
st_crs(New_sf) <-  st_crs(schools_sf)

New_lyr <- tm_shape(New_sf) + 
           tm_dots(col="ctype", palette=c(Cluster='blue', Isolation='cyan'), size= 0.5) +
           tm_layout(frame = F) 

── tmap v3 code detected ────────────────────────────────────────────────────────────────────
[v3->v4] `tm_tm_dots()`: migrate the argument(s) related to the scale of the visual variable
`fill` namely 'palette' (rename to 'values') to fill.scale = tm_scale(<HERE>).

schools_lyr2 + New_lyr 

Multiple palettes called "blue" found: "kovesi.blue", "tableau.blue". The first one, "kovesi.blue", is returned.