IS415: Take-Home Exercise1
Lu Zhimao
5/7/2020
Objective
In view of this, we are going to conduct a use-case to demonstrate the potential contribution of geospatial analytics in R to integrate, analyse and communicate the analysis results by using open data provided by different government agencies. The specific objectives of the study are as follow:
1. Calibrating a simple linear regression to reveal the relation between public bus commuters’ flows (i.e. tap-in or tap-out) data and residential population at the planning sub-zone level.
2. Performing spatial autocorrelation analysis on the residual of the regression model to test if the model conforms to the randomization assumption.
3. Performing localized geospatial statistics analysis by using commuters’ tap-in and tap-out data to identify geographical clustering.
Data Used
Aspatial
- passenger volume by busstop.csv - Provided
- respopagesextod2011to2019.csv
Geospatial
Aspatial/Geospatial Data Wrangling
Install relevant R packages
packages = c('rgdal', 'sf', 'spdep', 'sp','tmap', 'tidyverse','gridExtra' )
for (p in packages){
if(!require(p, character.only = T)){
install.packages(p)
}
library(p,character.only = T)
}Import BusStop data
busstop <- st_read(dsn = "data/geospatial", layer = "BusStop")## Reading layer `BusStop' from data source `C:\IS415 Geospatial Analytics and Applications\take-home1\Take-Home_Exe1\data\geospatial' using driver `ESRI Shapefile'
## Simple feature collection with 5040 features and 3 fields
## geometry type: POINT
## dimension: XY
## bbox: xmin: 4427.938 ymin: 26482.1 xmax: 48282.5 ymax: 52983.82
## epsg (SRID): NA
## proj4string: +proj=tmerc +lat_0=1.366666666666667 +lon_0=103.8333333333333 +k=1 +x_0=28001.642 +y_0=38744.572 +datum=WGS84 +units=m +no_defsAdding EPSG 3414 to busstop layer and perform a Coordinate Reference System check
busstop <- st_set_crs(busstop,3414)
st_crs(busstop)## Coordinate Reference System:
## EPSG: 3414
## proj4string: "+proj=tmerc +lat_0=1.366666666666667 +lon_0=103.8333333333333 +k=1 +x_0=28001.642 +y_0=38744.572 +ellps=WGS84 +units=m +no_defs"Import respopagesextod2011to2019 data using read_csv function and named it as rawdata_pop
rawdata_pop <- read_csv("Data/aspatial/respopagesextod2011to2019.csv")Import passenger volume by busstop data using read_csv function and named it as rawdata_Passengervolume
rawdata_Passengervolume <- read_csv("Data/aspatial/passenger volume by busstop.csv")Import MP14_SUBZONE_WEB_PL using st_read function and named it as sf_mpsz
sf_mpsz = st_read(dsn = "data/geospatial",
layer = "MP14_SUBZONE_WEB_PL")## Reading layer `MP14_SUBZONE_WEB_PL' from data source `C:\IS415 Geospatial Analytics and Applications\take-home1\Take-Home_Exe1\data\geospatial' using driver `ESRI Shapefile'
## Simple feature collection with 323 features and 15 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: 2667.538 ymin: 15748.72 xmax: 56396.44 ymax: 50256.33
## epsg (SRID): NA
## proj4string: +proj=tmerc +lat_0=1.366666666666667 +lon_0=103.8333333333333 +k=1 +x_0=28001.642 +y_0=38744.572 +datum=WGS84 +units=m +no_defsSet sf_mpsz EPSG to 3414 and perform a Coordinate Reference System check
sf_mpsz <- st_set_crs(sf_mpsz,3414)
st_crs(sf_mpsz)## Coordinate Reference System:
## EPSG: 3414
## proj4string: "+proj=tmerc +lat_0=1.366666666666667 +lon_0=103.8333333333333 +k=1 +x_0=28001.642 +y_0=38744.572 +ellps=WGS84 +units=m +no_defs"Filter the data set by “Time” and as the passenger volume by busstop data set only provoding year 2019 data. Therefore, we will filter the TIME == “2019”. After that, dding up all the population size according to SubZone name. The new set of data, we will named it as popSZ_2019.
popSZ_2019 <- rawdata_pop %>%
group_by(Time,SZ,PA,AG) %>%
summarise(Pop=sum(Pop))%>%
ungroup()%>%
filter(Time == 2019) %>%
spread(AG,Pop) %>%
mutate(total_pop = `0_to_4`+`5_to_9`+`10_to_14`+`15_to_19`+`20_to_24` + `25_to_29` + `30_to_34` + `35_to_39`+`40_to_44`+`45_to_49`+`50_to_54`+`55_to_59`+`60_to_64`+`65_to_69`+`70_to_74`+`75_to_79`+`80_to_84`+`85_to_89`+`90_and_over`) %>%
mutate_at(.vars = vars(PA, SZ), .funs = funs(toupper))
popSZ_2019 <- subset(popSZ_2019, select = -c(PA,Time,`0_to_4`,`5_to_9`,`10_to_14`,`15_to_19`,`20_to_24` , `25_to_29` , `30_to_34` , `35_to_39`,`40_to_44`,`45_to_49`,`50_to_54`,`55_to_59`,`60_to_64`,`65_to_69`,`70_to_74`,`75_to_79`,`80_to_84`,`85_to_89`,`90_and_over`))I will perform a left_join to join both sf_mpsz and popSZ_2019 data sets together, based on their common factor which is the SubZone name.
sf_mpsz_popSZ_2019 <- left_join(sf_mpsz,popSZ_2019, by = c("SUBZONE_N" = "SZ"))In order to perform a insightful analysis, we should not only focusing on the overall population. As in the question, it mentions that the analysis want us to focus on the residents trend. Therefore, I decided to do a further filter function to filter the current tap_in and tap_out volume into the following 8 categories:
1. TOTAL_TAP_OUT_VOLUME_WeekendNP (non-peak: 9pm to 11am)
2. TOTAL_TAP_OUT_VOLUME_WeekendP (peak: 11am to 8pm)
3. TOTAL_TAP_IN_VOLUME_WeekendNP (non-peak: 9pm to 11am)
4. TOTAL_TAP_IN_VOLUME_WeekendP (peak: 11am to 8pm)
5. TOTAL_TAP_OUT_VOLUME_WeekdayP (Peak: 6am to 10am and 4pm to 9pm )
6. TOTAL_TAP_OUT_VOLUME_WeekdayNP (non-peak: 10am to 4pm and 9pm to 6am)
7. TOTAL_TAP_IN_VOLUME_WeekdayP (Peak: 6am to 10am and 4pm to 9pm )
8. TOTAL_TAP_IN_VOLUME_WeekdayP (non-peak: 10am to 4pm and 9pm to 6am)
testing1 <-rawdata_Passengervolume %>%
group_by(DAY_TYPE,PT_CODE)%>%
filter(DAY_TYPE == "WEEKDAY") %>%
#filter(PT_CODE == "01012") %>%
filter(TIME_PER_HOUR != "0")%>%
filter(TIME_PER_HOUR != "1")%>%
filter(TIME_PER_HOUR != "2")%>%
filter(TIME_PER_HOUR != "3")%>%
filter(TIME_PER_HOUR != "4")%>%
filter(TIME_PER_HOUR != "5")%>%
filter(TIME_PER_HOUR != "10")%>%
filter(TIME_PER_HOUR != "11")%>%
filter(TIME_PER_HOUR != "12")%>%
filter(TIME_PER_HOUR != "13")%>%
filter(TIME_PER_HOUR != "14")%>%
filter(TIME_PER_HOUR != "15")%>%
filter(TIME_PER_HOUR != "16")%>%
filter(TIME_PER_HOUR != "21")%>%
filter(TIME_PER_HOUR != "22")%>%
filter(TIME_PER_HOUR != "23")%>%
summarise(TOTAL_TAP_OUT_VOLUME_WeekdayP = sum(TOTAL_TAP_OUT_VOLUME),TOTAL_TAP_IN_VOLUME_WeekdayP = sum(TOTAL_TAP_IN_VOLUME)) %>%
ungroup() testing2 <-rawdata_Passengervolume %>%
group_by(DAY_TYPE,PT_CODE)%>%
filter(DAY_TYPE == "WEEKDAY") %>%
#filter(PT_CODE == "01012") %>%
filter(TIME_PER_HOUR != "6")%>%
filter(TIME_PER_HOUR != "7")%>%
filter(TIME_PER_HOUR != "8")%>%
filter(TIME_PER_HOUR != "9")%>%
filter(TIME_PER_HOUR != "17")%>%
filter(TIME_PER_HOUR != "18")%>%
filter(TIME_PER_HOUR != "19")%>%
filter(TIME_PER_HOUR != "20")%>%
summarise(TOTAL_TAP_OUT_VOLUME_WeekdayNP = sum(TOTAL_TAP_OUT_VOLUME),TOTAL_TAP_IN_VOLUME_WeekdayNP = sum(TOTAL_TAP_IN_VOLUME)) %>%
ungroup()testing3 <-rawdata_Passengervolume %>%
group_by(DAY_TYPE,PT_CODE)%>%
filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
filter(TIME_PER_HOUR != "11")%>%
filter(TIME_PER_HOUR != "12")%>%
filter(TIME_PER_HOUR != "13")%>%
filter(TIME_PER_HOUR != "14")%>%
filter(TIME_PER_HOUR != "15")%>%
filter(TIME_PER_HOUR != "16")%>%
filter(TIME_PER_HOUR != "17")%>%
filter(TIME_PER_HOUR != "18")%>%
filter(TIME_PER_HOUR != "19")%>%
filter(TIME_PER_HOUR != "20")%>%
filter(TIME_PER_HOUR != "21")%>%
summarise(TOTAL_TAP_OUT_VOLUME_WeekendNP = sum(TOTAL_TAP_OUT_VOLUME),TOTAL_TAP_IN_VOLUME_WeekendNP = sum(TOTAL_TAP_IN_VOLUME)) %>%
ungroup()testing4 <-rawdata_Passengervolume %>%
group_by(DAY_TYPE,PT_CODE)%>%
filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
filter(TIME_PER_HOUR != "0")%>%
filter(TIME_PER_HOUR != "1")%>%
filter(TIME_PER_HOUR != "2")%>%
filter(TIME_PER_HOUR != "3")%>%
filter(TIME_PER_HOUR != "4")%>%
filter(TIME_PER_HOUR != "5")%>%
filter(TIME_PER_HOUR != "6")%>%
filter(TIME_PER_HOUR != "7")%>%
filter(TIME_PER_HOUR != "8")%>%
filter(TIME_PER_HOUR != "9")%>%
filter(TIME_PER_HOUR != "10")%>%
filter(TIME_PER_HOUR != "22")%>%
filter(TIME_PER_HOUR != "23")%>%
summarise(TOTAL_TAP_OUT_VOLUME_WeekendP = sum(TOTAL_TAP_OUT_VOLUME),TOTAL_TAP_IN_VOLUME_WeekendP = sum(TOTAL_TAP_IN_VOLUME)) %>%
ungroup()Combining all the 8 categories into one data set and perform a to those irrelevant informtion.
try1 <- left_join(testing1,testing2, by = c("PT_CODE" = "PT_CODE"))try2 <- left_join(testing3,testing4, by = c("PT_CODE" = "PT_CODE"))try3 <- left_join(try1,try2, by = c("PT_CODE" = "PT_CODE"))
try3 <- subset(try3, select = -c(DAY_TYPE.x.x,DAY_TYPE.x.y,DAY_TYPE.y.x,DAY_TYPE.y.y))Performing a left_join to join the busstop data set and tap_in and tap_out data set together by a common facter which is the PT_CODE as known as the BUS_STOP_N.
busstoploc_volume <- left_join(busstop,try3, by= c("BUS_STOP_N" = "PT_CODE"))
busstoploc_volume = subset(busstoploc_volume, select = -c(LOC_DESC))Remove those Busstop names with missing data information.
busvolume_NOmissing <- na.omit(busstoploc_volume, cols = "TOTAL_TAP_OUT_VOLUME_WeekendNP","TOTAL_TAP_OUT_VOLUME_WeekendP", "TOTAL_TAP_IN_VOLUME_WeekendNP","TOTAL_TAP_IN_VOLUME_WeekendP", "TOTAL_TAP_OUT_VOLUME_WeekdayP","TOTAL_TAP_OUT_VOLUME_WeekdayNP", "TOTAL_TAP_IN_VOLUME_WeekdayP", "TOTAL_TAP_IN_VOLUME_WeekdayNP")To identify which are the busstop fall within the same subzone area.
poly_withVol <- st_intersection(sf_mpsz_popSZ_2019,busstop)poly_withVol <- st_join(busvolume_NOmissing,poly_withVol) Perform a calculation, summing up all the individual value on those bus stops fall in the same subzone area. With that we are able to see a overall of the tapin and tapout volume according to each subzone.
poly_withVol <- poly_withVol%>%
group_by(SUBZONE_N) %>%
summarise(TOTAL_TAP_OUT_VOLUME_WeekendNP = sum(TOTAL_TAP_OUT_VOLUME_WeekendNP),
TOTAL_TAP_OUT_VOLUME_WeekendP = sum(TOTAL_TAP_OUT_VOLUME_WeekendP),
TOTAL_TAP_IN_VOLUME_WeekendNP = sum(TOTAL_TAP_IN_VOLUME_WeekendNP),
TOTAL_TAP_IN_VOLUME_WeekendP = sum(TOTAL_TAP_IN_VOLUME_WeekendP),
TOTAL_TAP_OUT_VOLUME_WeekdayP = sum(TOTAL_TAP_OUT_VOLUME_WeekdayP),
TOTAL_TAP_OUT_VOLUME_WeekdayNP = sum(TOTAL_TAP_OUT_VOLUME_WeekdayNP),
TOTAL_TAP_IN_VOLUME_WeekdayP = sum(TOTAL_TAP_IN_VOLUME_WeekdayP),
TOTAL_TAP_IN_VOLUME_WeekdayNP = sum(TOTAL_TAP_IN_VOLUME_WeekdayNP)) %>%
ungroup()Using st_drop_geometry to remove the geometry of each busstop.
poly_withVol<-st_drop_geometry(poly_withVol)Join the tap_in and tap_out volume with the singapore subzone map layer by common factor “SUBZONE_N” and named it as final_output.
final_output <- left_join(sf_mpsz_popSZ_2019,poly_withVol, by = c("SUBZONE_N" = "SUBZONE_N"))Before removing some of the subzone areas.
qtm(final_output)
Remove those subzone without any tapin or tapout volume as it will not be useful to our analysis.
final_output <- final_output[-c(13,16,17,18,319,280,286,19,44,50,73,98,234,274,295,298,301,302,304,312),]After removed those subzone areas
qtm(final_output)
Task 1: Calibrating a simple linear regression to reveal the relation between public bus commuters’ flows (i.e. tap-in or tap-out) data and residential population at the planning sub-zone level.
TOTAL_TAP_OUT_VOLUME_WeekendNP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_OUT_VOLUME_WeekendNP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- final_output
fit <- lm(final_output$TOTAL_TAP_OUT_VOLUME_WeekendNP ~ final_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_OUT_WeekendNP <- predict(fit) #save the predicted values
q2_output$residuals_OUT_WeekendNP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_OUT_VOLUME_WeekendNP )) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_OUT_WeekendNP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_OUT_WeekendNP), size = abs(residuals_OUT_WeekendNP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_OUT_WeekendNP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_OUT_WeekendNP)
Report for residuals_OUT_WeekendNP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP
## Min. : 10269 Min. :-68649
## 1st Qu.: 10401 1st Qu.:-10581
## Median : 19910 Median : -5493
## Mean : 29836 Mean : 0
## 3rd Qu.: 39641 3rd Qu.: 2660
## Max. :205887 Max. :142659
## summary(fit)##
## Call:
## lm(formula = final_output$TOTAL_TAP_OUT_VOLUME_WeekendNP ~ final_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -68649 -10581 -5493 2660 142659
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.027e+04 1.778e+03 5.776 1.91e-08 ***
## final_output$total_pop 1.472e+00 7.882e-02 18.675 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 25000 on 301 degrees of freedom
## Multiple R-squared: 0.5368, Adjusted R-squared: 0.5352
## F-statistic: 348.8 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_OUT_VOLUME_WeekendP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_OUT_VOLUME_WeekendP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_OUT_WeekendP <- predict(fit) #save the predicted values
q2_output$residuals_OUT_WeekendP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_OUT_VOLUME_WeekendP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_OUT_WeekendP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_OUT_WeekendP), size = abs(residuals_OUT_WeekendP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_OUT_WeekendP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_OUT_WeekendP)
Report for residuals_OUT_WeekendP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP
## Min. :-150683
## 1st Qu.: -23235
## Median : -13710
## Mean : 0
## 3rd Qu.: 4664
## Max. : 335045
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -150683 -23235 -13710 4664 335045
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.207e+04 4.077e+03 5.414 1.26e-07 ***
## q2_output$total_pop 3.489e+00 1.807e-01 19.304 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 57330 on 301 degrees of freedom
## Multiple R-squared: 0.5532, Adjusted R-squared: 0.5517
## F-statistic: 372.7 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_IN_VOLUME_WeekendNP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_IN_VOLUME_WeekendNP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_IN_WeekendNP <- predict(fit) #save the predicted values
q2_output$residuals_IN_WeekendNP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_IN_VOLUME_WeekendNP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_IN_WeekendNP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_IN_WeekendNP), size = abs(residuals_IN_WeekendNP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_IN_WeekendNP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_IN_WeekendNP)
Report for residuals_IN_WeekendNP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -71847 -9147 -5313 3232 154399
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.968e+03 1.649e+03 5.439 1.11e-07 ***
## q2_output$total_pop 1.597e+00 7.309e-02 21.848 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23190 on 301 degrees of freedom
## Multiple R-squared: 0.6133, Adjusted R-squared: 0.612
## F-statistic: 477.3 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_IN_VOLUME_WeekendP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_IN_VOLUME_WeekendP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_IN_VOLUME_WeekendP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_IN_WeekendP <- predict(fit) #save the predicted values
q2_output$residuals_IN_WeekendP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_IN_VOLUME_WeekendP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_IN_WeekendP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_IN_WeekendP), size = abs(residuals_IN_WeekendP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_IN_WeekendP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_IN_WeekendP)
Report for residuals_IN_WeekendP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
##
## predicted_IN_WeekendP residuals_IN_WeekendP
## Min. : 23541 Min. :-155510
## 1st Qu.: 23844 1st Qu.: -25249
## Median : 45541 Median : -14983
## Mean : 68193 Mean : 0
## 3rd Qu.: 90566 3rd Qu.: 4794
## Max. :469926 Max. : 368794
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_IN_VOLUME_WeekendP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -155510 -25248 -14983 4794 368794
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.354e+04 4.318e+03 5.452 1.04e-07 ***
## q2_output$total_pop 3.359e+00 1.914e-01 17.548 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 60720 on 301 degrees of freedom
## Multiple R-squared: 0.5057, Adjusted R-squared: 0.5041
## F-statistic: 307.9 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_OUT_VOLUME_WeekdayP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_OUT_VOLUME_WeekdayP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_OUT_WeekdayP <- predict(fit) #save the predicted values
q2_output$residuals_OUT_WeekdayP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_OUT_VOLUME_WeekdayP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_OUT_WeekdayP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_OUT_WeekdayP), size = abs(residuals_OUT_WeekdayP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_OUT_WeekdayP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_OUT_WeekdayP)
Report for residuals_OUT_WeekdayP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
##
## predicted_IN_WeekendP residuals_IN_WeekendP predicted_OUT_WeekdayP
## Min. : 23541 Min. :-155510 Min. : 56537
## 1st Qu.: 23844 1st Qu.: -25249 1st Qu.: 57223
## Median : 45541 Median : -14983 Median : 106475
## Mean : 68193 Mean : 0 Mean : 157892
## 3rd Qu.: 90566 3rd Qu.: 4794 3rd Qu.: 208678
## Max. :469926 Max. : 368794 Max. :1069795
##
## residuals_OUT_WeekdayP
## Min. :-332428
## 1st Qu.: -53842
## Median : -26334
## Mean : 0
## 3rd Qu.: 25220
## Max. : 645044
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -332428 -53842 -26334 25220 645044
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.654e+04 8.336e+03 6.783 6.26e-11 ***
## q2_output$total_pop 7.624e+00 3.695e-01 20.633 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 117200 on 301 degrees of freedom
## Multiple R-squared: 0.5858, Adjusted R-squared: 0.5844
## F-statistic: 425.7 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_OUT_VOLUME_WeekdayNP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_OUT_VOLUME_WeekdayNP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_OUT_WeekdayNP <- predict(fit) #save the predicted values
q2_output$residuals_OUT_WeekdayNP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_OUT_VOLUME_WeekdayNP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_OUT_WeekdayNP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_OUT_WeekdayNP), size = abs(residuals_OUT_WeekdayNP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_OUT_WeekdayNP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_OUT_WeekdayNP)
Report for residuals_OUT_WeekdayNP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
##
## predicted_IN_WeekendP residuals_IN_WeekendP predicted_OUT_WeekdayP
## Min. : 23541 Min. :-155510 Min. : 56537
## 1st Qu.: 23844 1st Qu.: -25249 1st Qu.: 57223
## Median : 45541 Median : -14983 Median : 106475
## Mean : 68193 Mean : 0 Mean : 157892
## 3rd Qu.: 90566 3rd Qu.: 4794 3rd Qu.: 208678
## Max. :469926 Max. : 368794 Max. :1069795
##
## residuals_OUT_WeekdayP predicted_OUT_WeekdayNP residuals_OUT_WeekdayNP
## Min. :-332428 Min. : 37139 Min. :-270799
## 1st Qu.: -53842 1st Qu.: 37728 1st Qu.: -38295
## Median : -26334 Median : 79955 Median : -17879
## Mean : 0 Mean :124038 Mean : 0
## 3rd Qu.: 25220 3rd Qu.:167579 3rd Qu.: 11308
## Max. : 645044 Max. :905866 Max. : 520488
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -270799 -38295 -17879 11308 520488
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.714e+04 6.627e+03 5.604 4.73e-08 ***
## q2_output$total_pop 6.537e+00 2.938e-01 22.250 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 93200 on 301 degrees of freedom
## Multiple R-squared: 0.6219, Adjusted R-squared: 0.6206
## F-statistic: 495.1 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_IN_VOLUME_WeekdayP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_IN_VOLUME_WeekdayP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_IN_WeekdayP <- predict(fit) #save the predicted values
q2_output$residuals_IN_WeekdayP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_IN_VOLUME_WeekdayP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_IN_WeekdayP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_IN_WeekdayP), size = abs(residuals_IN_WeekdayP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_IN_WeekdayP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_IN_WeekdayP)
Report for residuals_IN_WeekdayP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
##
## predicted_IN_WeekendP residuals_IN_WeekendP predicted_OUT_WeekdayP
## Min. : 23541 Min. :-155510 Min. : 56537
## 1st Qu.: 23844 1st Qu.: -25249 1st Qu.: 57223
## Median : 45541 Median : -14983 Median : 106475
## Mean : 68193 Mean : 0 Mean : 157892
## 3rd Qu.: 90566 3rd Qu.: 4794 3rd Qu.: 208678
## Max. :469926 Max. : 368794 Max. :1069795
##
## residuals_OUT_WeekdayP predicted_OUT_WeekdayNP residuals_OUT_WeekdayNP
## Min. :-332428 Min. : 37139 Min. :-270799
## 1st Qu.: -53842 1st Qu.: 37728 1st Qu.: -38295
## Median : -26334 Median : 79955 Median : -17879
## Mean : 0 Mean :124038 Mean : 0
## 3rd Qu.: 25220 3rd Qu.:167579 3rd Qu.: 11308
## Max. : 645044 Max. :905866 Max. : 520488
##
## predicted_IN_WeekdayP residuals_IN_WeekdayP
## Min. : 51182 Min. :-353975
## 1st Qu.: 51907 1st Qu.: -52762
## Median : 103944 Median : -27353
## Mean : 158269 Mean : 0
## 3rd Qu.: 211926 3rd Qu.: 23524
## Max. :1121731 Max. : 786128
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -353975 -52762 -27353 23524 786128
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.118e+04 8.259e+03 6.197 1.89e-09 ***
## q2_output$total_pop 8.055e+00 3.661e-01 22.001 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 116200 on 301 degrees of freedom
## Multiple R-squared: 0.6166, Adjusted R-squared: 0.6153
## F-statistic: 484 on 1 and 301 DF, p-value: < 2.2e-16TOTAL_TAP_IN_VOLUME_WeekdayNP
ggplot(final_output, aes(x = total_pop, y = TOTAL_TAP_IN_VOLUME_WeekdayNP)) +
geom_point(color = 'red') +
geom_smooth(method = "lm", se = TRUE)
q2_output <- q2_output
fit <- lm(q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP ~ q2_output$total_pop, data = q2_output) #fit the model
q2_output$predicted_IN_WeekdayNP <- predict(fit) #save the predicted values
q2_output$residuals_IN_WeekdayNP <- residuals(fit) #save the residual values
ggplot(q2_output, aes(x = total_pop , y = TOTAL_TAP_IN_VOLUME_WeekdayNP)) +
geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = total_pop, yend = predicted_IN_WeekdayNP), alpha = 0.5) +
geom_point(aes(color = abs(residuals_IN_WeekdayNP), size = abs(residuals_IN_WeekdayNP)), alpha = 0.4) +
scale_color_continuous(low = "green", high = "red") +
theme_bw()
Residual Map
tm_shape(q2_output) +
tm_fill(col = "residuals_IN_WeekdayNP",
style = "pretty")+
tm_borders(alpha = 0.5)
plot(q2_output$residuals_IN_WeekdayNP)
Report for residuals_IN_WeekdayP
summary(q2_output)## OBJECTID SUBZONE_NO SUBZONE_N SUBZONE_C CA_IND
## Min. : 1.0 Min. : 1.000 Length:303 AMSZ01 : 1 N:257
## 1st Qu.: 84.5 1st Qu.: 2.000 Class :character AMSZ02 : 1 Y: 46
## Median :161.0 Median : 4.000 Mode :character AMSZ03 : 1
## Mean :161.0 Mean : 4.733 AMSZ04 : 1
## 3rd Qu.:237.5 3rd Qu.: 7.000 AMSZ05 : 1
## Max. :323.0 Max. :17.000 AMSZ06 : 1
## (Other):297
## PLN_AREA_N PLN_AREA_C REGION_N REGION_C
## BUKIT MERAH : 17 BM : 17 CENTRAL REGION :128 CR :128
## QUEENSTOWN : 15 QT : 15 EAST REGION : 29 ER : 29
## ANG MO KIO : 12 AM : 12 NORTH-EAST REGION: 42 NER: 42
## DOWNTOWN CORE: 12 DT : 12 NORTH REGION : 37 NR : 37
## TOA PAYOH : 12 TP : 12 WEST REGION : 67 WR : 67
## HOUGANG : 10 HG : 10
## (Other) :225 (Other):225
## INC_CRC FMEL_UPD_D X_ADDR Y_ADDR
## 00F5E30B5C9B7AD8: 1 Min. :2014-12-05 Min. : 5093 Min. :25813
## 013B509B8EDF15BE: 1 1st Qu.:2014-12-05 1st Qu.:21720 1st Qu.:31822
## 01A4287FB060A0A6: 1 Median :2014-12-05 Median :28083 Median :35113
## 029BD940F4455194: 1 Mean :2014-12-05 Mean :26940 Mean :36082
## 0524461C92F35D94: 1 3rd Qu.:2014-12-05 3rd Qu.:31448 3rd Qu.:39638
## 05FD555397CBEE7A: 1 Max. :2014-12-05 Max. :46662 Max. :49553
## (Other) :297
## SHAPE_Leng SHAPE_Area total_pop
## Min. : 871.5 Min. : 39438 Min. : 0
## 1st Qu.: 3637.2 1st Qu.: 602773 1st Qu.: 90
## Median : 5112.5 Median : 1160017 Median : 6550
## Mean : 5978.4 Mean : 2129116 Mean : 13294
## 3rd Qu.: 6851.9 3rd Qu.: 2086941 3rd Qu.: 19955
## Max. :54928.1 Max. :69748299 Max. :132900
##
## TOTAL_TAP_OUT_VOLUME_WeekendNP TOTAL_TAP_OUT_VOLUME_WeekendP
## Min. : 339 Min. : 243
## 1st Qu.: 6782 1st Qu.: 13998
## Median : 17371 Median : 40668
## Mean : 29836 Mean : 68450
## 3rd Qu.: 36126 3rd Qu.: 84936
## Max. :285019 Max. :684160
##
## TOTAL_TAP_IN_VOLUME_WeekendNP TOTAL_TAP_IN_VOLUME_WeekendP
## Min. : 10 Min. : 39
## 1st Qu.: 6236 1st Qu.: 14985
## Median : 18108 Median : 39207
## Mean : 30195 Mean : 68193
## 3rd Qu.: 40910 3rd Qu.: 81888
## Max. :293550 Max. :690044
##
## TOTAL_TAP_OUT_VOLUME_WeekdayP TOTAL_TAP_OUT_VOLUME_WeekdayNP
## Min. : 2859 Min. : 772
## 1st Qu.: 43859 1st Qu.: 27092
## Median : 99359 Median : 71850
## Mean : 157892 Mean : 124038
## 3rd Qu.: 195621 3rd Qu.: 159322
## Max. :1458953 Max. :1232165
##
## TOTAL_TAP_IN_VOLUME_WeekdayP TOTAL_TAP_IN_VOLUME_WeekdayNP geometry
## Min. : 442 Min. : 433 MULTIPOLYGON :303
## 1st Qu.: 42633 1st Qu.: 28041 epsg:3414 : 0
## Median : 98361 Median : 75092 +proj=tmer...: 0
## Mean : 158269 Mean : 124214
## 3rd Qu.: 199528 3rd Qu.: 157336
## Max. :1508674 Max. :1262069
##
## predicted_OUT_WeekendNP residuals_OUT_WeekendNP predicted_OUT_WeekendP
## Min. : 10269 Min. :-68649 Min. : 22071
## 1st Qu.: 10401 1st Qu.:-10581 1st Qu.: 22385
## Median : 19910 Median : -5493 Median : 44922
## Mean : 29836 Mean : 0 Mean : 68450
## 3rd Qu.: 39641 3rd Qu.: 2660 3rd Qu.: 91689
## Max. :205887 Max. :142659 Max. :485722
##
## residuals_OUT_WeekendP predicted_IN_WeekendNP residuals_IN_WeekendNP
## Min. :-150683 Min. : 8968 Min. :-71847
## 1st Qu.: -23235 1st Qu.: 9111 1st Qu.: -9147
## Median : -13710 Median : 19427 Median : -5313
## Mean : 0 Mean : 30195 Mean : 0
## 3rd Qu.: 4664 3rd Qu.: 40832 3rd Qu.: 3232
## Max. : 335045 Max. :221184 Max. :154399
##
## predicted_IN_WeekendP residuals_IN_WeekendP predicted_OUT_WeekdayP
## Min. : 23541 Min. :-155510 Min. : 56537
## 1st Qu.: 23844 1st Qu.: -25249 1st Qu.: 57223
## Median : 45541 Median : -14983 Median : 106475
## Mean : 68193 Mean : 0 Mean : 157892
## 3rd Qu.: 90566 3rd Qu.: 4794 3rd Qu.: 208678
## Max. :469926 Max. : 368794 Max. :1069795
##
## residuals_OUT_WeekdayP predicted_OUT_WeekdayNP residuals_OUT_WeekdayNP
## Min. :-332428 Min. : 37139 Min. :-270799
## 1st Qu.: -53842 1st Qu.: 37728 1st Qu.: -38295
## Median : -26334 Median : 79955 Median : -17879
## Mean : 0 Mean :124038 Mean : 0
## 3rd Qu.: 25220 3rd Qu.:167579 3rd Qu.: 11308
## Max. : 645044 Max. :905866 Max. : 520488
##
## predicted_IN_WeekdayP residuals_IN_WeekdayP predicted_IN_WeekdayNP
## Min. : 51182 Min. :-353975 Min. : 41860
## 1st Qu.: 51907 1st Qu.: -52762 1st Qu.: 42418
## Median : 103944 Median : -27353 Median : 82437
## Mean : 158269 Mean : 0 Mean :124214
## 3rd Qu.: 211926 3rd Qu.: 23524 3rd Qu.:165479
## Max. :1121731 Max. : 786128 Max. :865158
##
## residuals_IN_WeekdayNP
## Min. :-281751
## 1st Qu.: -42803
## Median : -22763
## Mean : 0
## 3rd Qu.: 6225
## Max. : 640233
## summary(fit)##
## Call:
## lm(formula = q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP ~ q2_output$total_pop,
## data = q2_output)
##
## Residuals:
## Min 1Q Median 3Q Max
## -281751 -42803 -22763 6225 640233
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.186e+04 7.292e+03 5.741 2.3e-08 ***
## q2_output$total_pop 6.195e+00 3.232e-01 19.165 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 102500 on 301 degrees of freedom
## Multiple R-squared: 0.5496, Adjusted R-squared: 0.5481
## F-statistic: 367.3 on 1 and 301 DF, p-value: < 2.2e-16Task 2: Performing spatial autocorrelation analysis on the residual of the regression model to test if the model conforms to the randomization assumption.
Hypothesis
Null Hypothesis: Residual for Regression model is randomly distributed.
Alternative Hypothesis: Residual for Regression model is not randomly distributed.
Confident Interval: 95%
Weight matrix: Queen Method
wm_q <-poly2nb(q2_output, queen = TRUE)
summary(wm_q)## Neighbour list object:
## Number of regions: 303
## Number of nonzero links: 1830
## Percentage nonzero weights: 1.993269
## Average number of links: 6.039604
## Link number distribution:
##
## 2 3 4 5 6 7 8 9 10 11 12 14 17
## 6 12 26 79 75 49 36 13 2 2 1 1 1
## 6 least connected regions:
## 20 75 179 271 277 297 with 2 links
## 1 most connected region:
## 313 with 17 linksYou can display the complete weight matrix by using str()
str(wm_q)## List of 303
## $ : int [1:4] 18 26 36 39
## $ : int [1:9] 3 7 8 14 27 29 31 34 35
## $ : int [1:6] 2 8 32 33 34 42
## $ : int [1:6] 5 7 12 23 30 37
## $ : int [1:5] 4 6 12 30 92
## $ : int [1:8] 5 10 11 12 28 30 43 92
## $ : int [1:7] 2 4 12 14 35 37 87
## $ : int [1:6] 2 3 14 34 42 79
## $ : int [1:6] 11 25 44 49 66 70
## $ : int [1:5] 6 11 28 43 60
## $ : int [1:8] 6 9 10 24 25 28 44 60
## $ : int [1:6] 4 5 6 7 87 92
## $ : int [1:4] 14 41 48 79
## $ : int [1:7] 2 7 8 13 48 79 87
## $ : int [1:2] 16 19
## $ : int [1:8] 15 17 18 19 23 26 54 56
## $ : int [1:5] 16 26 31 55 56
## $ : int [1:4] 1 16 26 36
## $ : int [1:7] 15 16 20 24 25 49 54
## $ : int [1:6] 19 23 24 28 30 54
## $ : int [1:3] 22 31 55
## $ : int [1:5] 21 26 31 33 55
## $ : int [1:9] 4 16 20 27 30 35 37 54 56
## $ : int [1:5] 11 19 20 25 28
## $ : int [1:5] 9 11 19 24 49
## $ : int [1:9] 1 16 17 18 22 33 36 38 55
## $ : int [1:6] 2 23 29 31 35 56
## $ : int [1:6] 6 10 11 20 24 30
## $ : int [1:3] 2 27 31
## $ : int [1:7] 4 5 6 20 23 28 37
## $ : int [1:10] 2 17 21 22 27 29 33 34 55 56
## $ : int [1:3] 3 33 34
## $ : int [1:8] 3 22 26 31 32 34 38 42
## $ : int [1:6] 2 3 8 31 32 33
## $ : int [1:5] 2 7 23 27 37
## $ : int [1:5] 1 18 26 38 39
## $ : int [1:5] 4 7 23 30 35
## $ : int [1:5] 26 33 36 39 42
## $ : int [1:5] 1 36 38 42 91
## $ : int [1:5] 42 47 50 52 79
## $ : int [1:5] 13 46 48 50 79
## $ : int [1:11] 3 8 33 38 39 40 51 52 79 88 ...
## $ : int [1:6] 6 10 57 60 63 92
## $ : int [1:5] 9 11 60 64 70
## $ : int [1:5] 48 53 75 87 93
## $ : int [1:7] 41 48 50 53 68 75 76
## $ : int [1:7] 40 50 52 59 77 89 111
## $ : int [1:8] 13 14 41 45 46 53 75 87
## $ : int [1:5] 9 19 25 66 119
## $ : int [1:7] 40 41 46 47 76 79 89
## $ : int [1:5] 42 52 88 90 91
## $ : int [1:7] 40 42 47 51 59 77 90
## $ : int [1:5] 45 46 48 75 87
## $ : int [1:5] 16 19 20 23 56
## $ : int [1:5] 17 21 22 26 31
## $ : int [1:6] 16 17 23 27 31 54
## $ : int [1:5] 43 60 63 92 110
## $ : int [1:4] 76 89 111 122
## $ : int [1:5] 47 52 77 90 117
## $ : int [1:8] 10 11 43 44 57 64 110 116
## $ : int [1:4] 62 74 91 154
## $ : int [1:5] 61 94 109 154 161
## $ : int [1:5] 43 57 92 110 160
## $ : int [1:5] 44 60 70 116 120
## $ : int [1:7] 80 82 87 92 93 155 160
## $ : int [1:6] 9 49 70 83 119 121
## $ : int [1:2] 81 169
## $ : int [1:5] 46 76 112 122 156
## $ : int [1:3] 84 94 158
## $ : int [1:7] 9 44 64 66 120 121 159
## $ : int [1:3] 78 86 102
## $ : int [1:4] 95 113 119 162
## $ : int [1:3] 75 82 118
## $ : int [1:6] 61 91 117 123 124 154
## $ : int [1:8] 45 46 48 53 73 82 93 118
## $ : int [1:5] 46 50 58 68 122
## $ : int [1:6] 47 52 59 89 111 117
## $ : int [1:4] 71 85 86 115
## $ : int [1:7] 8 13 14 40 41 42 50
## $ : int [1:4] 65 107 155 160
## $ : int [1:3] 67 102 169
## $ : int [1:8] 65 73 75 93 98 118 155 186
## $ : int [1:6] 66 97 105 119 121 162
## $ : int [1:4] 69 99 158 204
## $ : int [1:7] 78 86 103 106 114 115 157
## $ : int [1:7] 71 78 85 102 103 131 182
## $ : int [1:9] 7 12 14 45 48 53 65 92 93
## $ : int [1:4] 42 51 90 91
## $ : int [1:5] 47 50 58 77 111
## $ : int [1:6] 51 52 59 88 91 117
## $ : int [1:8] 39 42 51 61 74 88 90 117
## $ : int [1:9] 5 6 12 43 57 63 65 87 160
## $ : int [1:5] 45 65 75 82 87
## $ : int [1:4] 62 69 109 158
## $ : int [1:7] 72 106 113 137 138 157 162
## $ : int [1:7] 100 104 123 124 129 130 154
## $ : int [1:5] 83 105 121 145 159
## $ : int [1:7] 82 101 118 146 156 186 191
## $ : int [1:5] 84 158 190 204 205
## [list output truncated]
## - attr(*, "class")= chr "nb"
## - attr(*, "region.id")= chr [1:303] "1" "2" "3" "4" ...
## - attr(*, "call")= language poly2nb(pl = q2_output, queen = TRUE)
## - attr(*, "type")= chr "queen"
## - attr(*, "sym")= logi TRUEConverting from sf to sp format
sp_q2_output <- as(q2_output,"Spatial")Plotting Queen Contiguity based neighbours maps
plot(sp_q2_output, border = "lightgrey")
plot(wm_q, coordinates(sp_q2_output),pch=19,cex = 0.6, add = TRUE, col = "red")
Weight matrix: Distance Based Neighbours
Determine the cut off distance
k1 <- knn2nb(knearneigh(coordinates(sp_q2_output)))
k1dists <- unlist(nbdists(k1, coordinates(sp_q2_output), longlat = FALSE))
summary(k1dists)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 182.5 621.0 891.7 943.8 1169.8 5403.9Computing fix distance weight matrix with a distance of 5405m
wm_d5405 <- dnearneigh(coordinates(sp_q2_output),0,5405,longlat = FALSE)
wm_d5405## Neighbour list object:
## Number of regions: 303
## Number of nonzero links: 16442
## Percentage nonzero weights: 17.90892
## Average number of links: 54.26403str(wm_d5405)## List of 303
## $ : int [1:75] 2 3 4 7 8 12 13 14 15 16 ...
## $ : int [1:89] 1 3 4 5 6 7 8 10 11 12 ...
## $ : int [1:88] 1 2 4 5 6 7 8 12 13 14 ...
## $ : int [1:93] 1 2 3 5 6 7 8 9 10 11 ...
## $ : int [1:93] 2 3 4 6 7 8 9 10 11 12 ...
## $ : int [1:86] 2 3 4 5 7 8 9 10 11 12 ...
## $ : int [1:93] 1 2 3 4 5 6 8 10 11 12 ...
## $ : int [1:93] 1 2 3 4 5 6 7 10 12 13 ...
## $ : int [1:44] 4 5 6 10 11 12 19 20 23 24 ...
## $ : int [1:71] 2 4 5 6 7 8 9 11 12 13 ...
## $ : int [1:56] 2 4 5 6 7 9 10 12 13 14 ...
## $ : int [1:96] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:100] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:96] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:42] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:71] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:76] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:68] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:65] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:86] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:82] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:81] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:84] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:72] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:53] 2 4 5 6 7 9 10 11 12 13 ...
## $ : int [1:75] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:86] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:79] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:86] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:88] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:81] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:85] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:82] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:85] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:88] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:78] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:88] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:85] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:85] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:96] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:101] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:95] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:81] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:46] 4 5 6 9 10 11 12 19 20 24 ...
## $ : int [1:101] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:103] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:98] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:103] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:33] 4 5 6 9 10 11 12 19 20 24 ...
## $ : int [1:99] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:96] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:96] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:102] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:81] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:77] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:81] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:70] 2 4 5 6 7 9 10 11 12 13 ...
## $ : int [1:102] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:99] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:61] 4 5 6 7 9 10 11 12 13 14 ...
## $ : int [1:83] 1 2 3 7 8 13 14 17 18 21 ...
## $ : int [1:57] 1 3 8 18 22 26 32 33 34 36 ...
## $ : int [1:74] 2 4 5 6 7 8 9 10 11 12 ...
## $ : int [1:51] 4 5 6 9 10 11 12 24 25 28 ...
## $ : int [1:96] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:43] 9 10 11 25 43 44 49 57 60 63 ...
## $ : int 81
## $ : int [1:107] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:17] 62 84 94 99 108 109 128 140 144 154 ...
## $ : int [1:45] 6 9 10 11 25 28 43 44 49 57 ...
## $ : int [1:13] 78 81 85 86 102 103 114 115 131 134 ...
## $ : int [1:35] 9 44 49 64 66 70 83 95 97 105 ...
## $ : int [1:107] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:90] 1 2 3 7 8 13 14 17 18 21 ...
## $ : int [1:104] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:105] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:102] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:17] 71 81 85 86 102 103 106 113 114 115 ...
## $ : int [1:98] 1 2 3 4 5 6 7 8 10 12 ...
## $ : int [1:76] 2 4 5 6 7 8 9 10 11 12 ...
## $ : int [1:8] 67 71 78 86 102 131 169 182
## $ : int [1:106] 2 3 4 5 6 7 8 10 11 12 ...
## $ : int [1:48] 9 44 49 57 60 63 64 66 70 72 ...
## $ : int [1:15] 69 94 99 108 109 140 144 158 173 180 ...
## $ : int [1:23] 71 78 86 95 102 103 106 113 114 115 ...
## $ : int [1:18] 71 78 81 85 102 103 106 114 115 131 ...
## $ : int [1:100] 1 2 3 4 5 6 7 8 9 10 ...
## $ : int [1:99] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:100] 1 2 3 4 5 6 7 8 12 13 ...
## $ : int [1:98] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:93] 1 2 3 4 5 7 8 12 13 14 ...
## $ : int [1:89] 2 3 4 5 6 7 8 9 10 11 ...
## $ : int [1:103] 1 2 3 4 5 6 7 8 10 11 ...
## $ : int [1:26] 1 61 62 69 74 84 88 91 96 99 ...
## $ : int [1:41] 66 70 72 83 85 97 105 106 113 114 ...
## $ : int [1:87] 1 2 3 8 13 14 21 22 32 33 ...
## $ : int [1:48] 9 44 57 60 63 64 66 70 72 80 ...
## $ : int [1:103] 2 3 4 5 6 7 8 12 13 14 ...
## $ : int [1:17] 69 84 94 108 109 140 144 158 161 173 ...
## [list output truncated]
## - attr(*, "class")= chr "nb"
## - attr(*, "nbtype")= chr "distance"
## - attr(*, "distances")= num [1:2] 0 5405
## - attr(*, "region.id")= chr [1:303] "1" "2" "3" "4" ...
## - attr(*, "call")= language dnearneigh(x = coordinates(sp_q2_output), d1 = 0, d2 = 5405, longlat = FALSE)
## - attr(*, "dnn")= num [1:2] 0 5405
## - attr(*, "bounds")= chr [1:2] "GT" "LE"
## - attr(*, "sym")= logi TRUEPlotting fixed distance weight matrix
par(mfrow = c(1,2))
plot(sp_q2_output, border = "lightgrey")
plot(wm_d5405, coordinates(sp_q2_output), add = TRUE)
plot(sp_q2_output, border = "lightgrey")
plot(k1, coordinates(sp_q2_output), add = TRUE, col = "red", length= 0.08, main = "1st nearest neighbours")
Computing adaptive distance weight matrix
wm_knn20 <- knn2nb(knearneigh(coordinates(sp_q2_output),k=20))
wm_knn20## Neighbour list object:
## Number of regions: 303
## Number of nonzero links: 6060
## Percentage nonzero weights: 6.60066
## Average number of links: 20
## Non-symmetric neighbours liststr(wm_knn20)## List of 303
## $ : int [1:20] 3 18 21 22 26 31 32 33 34 36 ...
## $ : int [1:20] 3 7 8 13 14 17 21 22 27 29 ...
## $ : int [1:20] 2 8 14 21 22 26 29 31 32 33 ...
## $ : int [1:20] 2 5 6 7 12 13 14 20 23 24 ...
## $ : int [1:20] 4 6 7 10 12 19 20 23 24 28 ...
## $ : int [1:20] 4 5 10 11 12 19 20 23 24 25 ...
## $ : int [1:20] 2 4 5 8 12 13 14 23 27 29 ...
## $ : int [1:20] 2 3 13 14 21 22 29 31 32 33 ...
## $ : int [1:20] 6 10 11 24 25 28 43 44 49 57 ...
## $ : int [1:20] 4 5 6 9 11 12 19 20 24 25 ...
## $ : int [1:20] 5 6 9 10 19 24 25 28 30 43 ...
## $ : int [1:20] 4 5 6 7 13 14 20 23 28 30 ...
## $ : int [1:20] 2 3 7 8 14 29 32 34 35 40 ...
## $ : int [1:20] 2 3 7 8 13 27 29 31 32 34 ...
## $ : int [1:20] 2 16 17 18 19 20 21 22 23 24 ...
## $ : int [1:20] 2 15 17 18 20 21 22 23 26 27 ...
## $ : int [1:20] 2 3 8 16 18 21 22 23 26 27 ...
## $ : int [1:20] 1 2 3 8 16 17 21 22 26 29 ...
## $ : int [1:20] 4 5 6 10 11 12 15 16 20 23 ...
## $ : int [1:20] 2 4 5 6 7 12 14 16 19 23 ...
## $ : int [1:20] 2 3 8 14 17 22 26 27 29 31 ...
## $ : int [1:20] 1 2 3 8 17 18 21 26 27 29 ...
## $ : int [1:20] 2 4 5 7 12 14 16 17 19 20 ...
## $ : int [1:20] 4 5 6 7 10 11 12 19 20 23 ...
## $ : int [1:20] 4 5 6 9 10 11 12 19 20 24 ...
## $ : int [1:20] 1 2 3 8 17 18 21 22 27 29 ...
## $ : int [1:20] 2 4 7 8 13 14 16 17 20 21 ...
## $ : int [1:20] 4 5 6 10 11 12 19 20 23 24 ...
## $ : int [1:20] 2 3 7 8 13 14 17 21 22 23 ...
## $ : int [1:20] 4 5 6 7 10 12 14 19 20 23 ...
## $ : int [1:20] 2 3 8 13 14 17 21 22 26 27 ...
## $ : int [1:20] 2 3 8 14 17 21 22 26 29 31 ...
## $ : int [1:20] 1 2 3 8 17 18 21 22 26 29 ...
## $ : int [1:20] 2 3 8 13 14 17 21 22 26 27 ...
## $ : int [1:20] 2 4 5 7 8 12 13 14 20 21 ...
## $ : int [1:20] 1 3 8 17 18 21 22 26 31 32 ...
## $ : int [1:20] 2 4 5 6 7 12 13 14 20 23 ...
## $ : int [1:20] 1 3 8 18 21 22 26 29 31 32 ...
## $ : int [1:20] 1 3 8 32 33 34 36 38 40 42 ...
## $ : int [1:20] 3 8 32 38 39 41 42 46 47 50 ...
## $ : int [1:20] 2 3 7 8 13 14 40 42 46 47 ...
## $ : int [1:20] 3 8 32 33 34 36 38 39 40 41 ...
## $ : int [1:20] 4 5 6 10 11 12 24 25 28 30 ...
## $ : int [1:20] 9 10 11 25 43 49 57 60 63 64 ...
## $ : int [1:20] 4 5 7 12 13 14 41 46 48 53 ...
## $ : int [1:20] 8 13 14 40 41 45 47 48 50 53 ...
## $ : int [1:20] 40 41 42 46 50 51 52 58 59 68 ...
## $ : int [1:20] 2 7 8 12 13 14 35 41 45 46 ...
## $ : int [1:20] 6 9 10 11 24 25 28 43 44 57 ...
## $ : int [1:20] 3 8 13 14 40 41 42 46 47 48 ...
## $ : int [1:20] 3 8 38 39 40 42 47 50 52 58 ...
## $ : int [1:20] 3 8 39 40 41 42 47 50 51 58 ...
## $ : int [1:20] 4 7 12 13 14 41 45 46 48 50 ...
## $ : int [1:20] 2 4 5 6 7 12 16 17 19 20 ...
## $ : int [1:20] 2 3 8 14 16 17 18 21 22 26 ...
## $ : int [1:20] 2 7 8 14 16 17 20 21 22 23 ...
## $ : int [1:20] 6 9 10 11 25 28 43 44 60 63 ...
## $ : int [1:20] 40 41 46 47 50 51 52 59 68 76 ...
## $ : int [1:20] 39 40 42 47 50 51 52 58 68 74 ...
## $ : int [1:20] 6 9 10 11 25 28 43 44 57 63 ...
## $ : int [1:20] 1 36 39 42 47 51 52 59 62 74 ...
## $ : int [1:20] 1 39 61 74 88 90 91 94 96 104 ...
## $ : int [1:20] 5 6 10 11 12 28 43 57 60 64 ...
## $ : int [1:20] 9 10 11 43 44 57 60 63 66 70 ...
## $ : int [1:20] 4 5 6 10 12 43 45 53 57 60 ...
## $ : int [1:20] 9 44 49 60 64 70 72 83 97 105 ...
## $ : int [1:20] 71 78 81 85 86 102 103 106 113 114 ...
## $ : int [1:20] 13 40 41 46 47 48 50 52 53 58 ...
## $ : int [1:20] 61 62 84 94 99 108 109 128 140 144 ...
## $ : int [1:20] 9 44 49 57 60 64 66 72 83 97 ...
## $ : int [1:20] 67 78 81 85 86 102 103 106 113 114 ...
## $ : int [1:20] 44 66 70 83 95 97 105 113 119 121 ...
## $ : int [1:20] 13 41 45 46 48 50 53 58 68 75 ...
## $ : int [1:20] 39 47 51 52 59 61 77 88 89 90 ...
## $ : int [1:20] 7 13 14 41 45 46 48 50 53 58 ...
## $ : int [1:20] 13 40 41 46 47 48 50 52 58 59 ...
## $ : int [1:20] 40 42 47 50 51 52 58 59 68 76 ...
## $ : int [1:20] 71 81 85 86 102 103 106 113 114 115 ...
## $ : int [1:20] 2 3 8 13 14 32 33 34 38 40 ...
## $ : int [1:20] 43 45 57 60 63 65 73 82 87 92 ...
## $ : int [1:20] 67 71 78 85 86 102 103 106 113 114 ...
## $ : int [1:20] 12 45 46 48 53 65 68 73 75 76 ...
## $ : int [1:20] 64 66 70 72 95 97 105 119 120 121 ...
## $ : int [1:20] 69 94 99 108 109 128 140 144 158 161 ...
## $ : int [1:20] 71 78 86 95 102 103 106 113 114 115 ...
## $ : int [1:20] 71 78 81 85 102 103 106 113 114 115 ...
## $ : int [1:20] 4 5 6 7 12 13 14 30 35 37 ...
## $ : int [1:20] 39 40 42 47 50 51 52 58 59 74 ...
## $ : int [1:20] 8 40 41 42 46 47 50 51 52 58 ...
## $ : int [1:20] 39 40 42 47 50 51 52 58 59 74 ...
## $ : int [1:20] 36 38 39 40 42 47 51 52 58 59 ...
## $ : int [1:20] 4 5 6 10 11 12 24 28 30 43 ...
## $ : int [1:20] 4 7 12 13 14 41 45 46 48 53 ...
## $ : int [1:20] 61 62 69 74 84 96 99 104 108 109 ...
## $ : int [1:20] 72 83 97 105 106 113 114 119 126 137 ...
## $ : int [1:20] 59 61 74 90 100 101 104 117 122 123 ...
## $ : int [1:20] 66 70 72 83 105 119 120 121 125 126 ...
## $ : int [1:20] 45 46 53 58 68 73 75 76 82 93 ...
## $ : int [1:20] 69 84 94 108 109 128 140 144 158 161 ...
## [list output truncated]
## - attr(*, "region.id")= chr [1:303] "1" "2" "3" "4" ...
## - attr(*, "call")= language knearneigh(x = coordinates(sp_q2_output), k = 20)
## - attr(*, "sym")= logi FALSE
## - attr(*, "type")= chr "knn"
## - attr(*, "knn-k")= num 20
## - attr(*, "class")= chr "nb"Plotting distance based neighbours
plot(sp_q2_output, border = "lightgrey")
plot(wm_knn20, coordinates(sp_q2_output),pch =19, cex = 0.6, add = TRUE, col = "red")
Weighs based on IDW
dist <- nbdists(wm_q, coordinates(sp_q2_output),longlat = FALSE)
ids <- lapply(dist, function(x) 1/(x))
idsDaptive distance method will be use for spatial autocorrelation test on the residual of the simple regression model.
Row standardised weight matrix for adaptive distance
rswm_knn20 <- nb2listw(wm_knn20, style = "W")
rswm_knn20## Characteristics of weights list object:
## Neighbour list object:
## Number of regions: 303
## Number of nonzero links: 6060
## Percentage nonzero weights: 6.60066
## Average number of links: 20
## Non-symmetric neighbours list
##
## Weights style: W
## Weights constants summary:
## n nn S0 S1 S2
## W 303 91809 303 27.45 1233.795rswm_knn20$weights[1]## [[1]]
## [1] 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05
## [16] 0.05 0.05 0.05 0.05 0.05summary(unlist(rswm_knn20$weights))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.05 0.05 0.05 0.05 0.05 0.05Hypothesis Results
moran.test(sp_q2_output$residuals_OUT_WeekendNP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_OUT_WeekendNP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 1.4067, p-value = 0.07976
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0197727950 -0.0033112583 0.0002692908Result: residuals_OUT_WeekendP
moran.test(sp_q2_output$residuals_OUT_WeekendP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_OUT_WeekendP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 0.92061, p-value = 0.1786
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0117598396 -0.0033112583 0.0002680005Result: residuals_IN_WeekendNP
moran.test(sp_q2_output$residuals_IN_WeekendNP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_IN_WeekendNP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 1.508, p-value = 0.06578
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0212519273 -0.0033112583 0.0002653155Result: residuals_IN_WeekendP
moran.test(sp_q2_output$residuals_IN_WeekendP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_IN_WeekendP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 0.61473, p-value = 0.2694
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0067533882 -0.0033112583 0.0002680592Result: residuals_OUT_WeekdayP
moran.test(sp_q2_output$residuals_OUT_WeekdayP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_OUT_WeekdayP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 1.4376, p-value = 0.07527
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0203139067 -0.0033112583 0.0002700655Result: residuals_OUT_WeekdayNP
moran.test(sp_q2_output$residuals_OUT_WeekdayNP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_OUT_WeekdayNP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 1.3113, p-value = 0.09488
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.018206251 -0.003311258 0.000269267Result: residuals_IN_WeekdayP
moran.test(sp_q2_output$residuals_IN_WeekdayP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_IN_WeekdayP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 1.0891, p-value = 0.1381
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0144567760 -0.0033112583 0.0002661669Result: residuals_IN_WeekdayNP
moran.test(sp_q2_output$residuals_IN_WeekdayNP, listw=rswm_knn20, zero.policy = TRUE, na.action=na.omit)##
## Moran I test under randomisation
##
## data: sp_q2_output$residuals_IN_WeekdayNP
## weights: rswm_knn20
##
## Moran I statistic standard deviate = 0.98322, p-value = 0.1628
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.0127948604 -0.0033112583 0.0002683379Hypothesis Conclusion
The above 8 results draws to the same conclusion that we have to reject the alternative hypothesis as all the P-value are greater than 0.05. Therefore, the residual of the regression model for all 8 models are arranged randomly.
Task 3: Performing localized geospatial statistics analysis by using commuters’ tap-in and tap-out data to identify geographical clustering.
Computing local Moran’s I for TOTAL_TAP_OUT_VOLUME_WeekendNP
fips <- order(sp_q2_output$SUBZONE_N)
localMI <- localmoran(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP, rswm_knn20)
head(localMI)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.388523032 -0.003311258 0.04485216 1.85016631 0.03214479
## 2 0.198175629 -0.003311258 0.04485216 0.95138241 0.17070514
## 3 0.325024949 -0.003311258 0.04485216 1.55034055 0.06052990
## 4 0.015901573 -0.003311258 0.04485216 0.09071930 0.46385782
## 5 0.008021842 -0.003311258 0.04485216 0.05351273 0.47866170
## 6 -0.064448761 -0.003311258 0.04485216 -0.28867955 0.61358669printCoefmat(data.frame(localMI[fips,],row.names = sp_q2_output$SUBZONE_N[fips]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI <- cbind(sp_q2_output, localMI)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_OUT_VOLUME_WeekendNP
Plotting Maran scatterplot
nci <- moran.plot(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_OUT_VOLUME_WeekendNP", ylab="Spatially Lag TOTAL_TAP_OUT_VOLUME_WeekendNP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekendNP <- scale(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP) %>% as.vectornci2 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekendNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_OUT_VOLUME_WeekendNP", ylab="Spatially Lag z-TOTAL_TAP_OUT_VOLUME_WeekendNP")
Steps to prepare a LISA cluster map
quadrant <- vector(mode="numeric",length=nrow(localMI))Centers the variable of interest around its mean
DV <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP) Centering the local Moran’s around the mean
C_mI <- localMI[,1] - mean(localMI[,1]) Set a statistical significance level for the local Moran
signif <- 0.05High-high, low-low, low-high and high-low categories
quadrant[DV >0 & C_mI>0] <- 4
quadrant[DV <0 & C_mI<0] <- 1
quadrant[DV <0 & C_mI>0] <- 2
quadrant[DV >0 & C_mI<0] <- 3Places non-significant Moran in the category 0
quadrant[localMI[,5]>signif] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI))
DV <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP)
C_mI <- localMI[,1] - mean(localMI[,1])
signif <- 0.05
quadrant[DV >0 & C_mI>0] <- 4
quadrant[DV <0 & C_mI<0] <- 1
quadrant[DV <0 & C_mI>0] <- 2
quadrant[DV >0 & C_mI<0] <- 3
quadrant[localMI[,5]>signif] <- 0LISA map for TOTAL_TAP_OUT_VOLUME_WeekendNP
sp_q2_output.localMI$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_OUT_VOLUME_WeekendP
fips1 <- order(sp_q2_output$SUBZONE_N)
localMI1 <- localmoran(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP, rswm_knn20)
head(localMI1)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.27408078 -0.003311258 0.0446064 1.3133952 0.09452491
## 2 0.14204735 -0.003311258 0.0446064 0.6882436 0.24564969
## 3 0.21467212 -0.003311258 0.0446064 1.0321072 0.15101095
## 4 0.02149870 -0.003311258 0.0446064 0.1174701 0.45324375
## 5 0.03044189 -0.003311258 0.0446064 0.1598143 0.43651366
## 6 -0.10067443 -0.003311258 0.0446064 -0.4609949 0.67759888printCoefmat(data.frame(localMI1[fips1,],row.names = sp_q2_output$SUBZONE_N[fips1]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI1 <- cbind(sp_q2_output, localMI1)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI1) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI1) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_OUT_VOLUME_WeekendNP
Plotting Maran scatterplot
nci1 <- moran.plot(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_OUT_VOLUME_WeekendP", ylab="Spatially Lag TOTAL_TAP_OUT_VOLUME_WeekendP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekendP <- scale(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP) %>% as.vectornci2.1 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekendP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_OUT_VOLUME_WeekendP", ylab="Spatially Lag z-TOTAL_TAP_OUT_VOLUME_WeekendP")
quadrant <- vector(mode="numeric",length=nrow(localMI1))DV1 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP) C_mI1 <- localMI1[,1] - mean(localMI1[,1]) signif1 <- 0.05quadrant[DV1 >0 & C_mI1>0] <- 4
quadrant[DV1 <0 & C_mI1<0] <- 1
quadrant[DV1 <0 & C_mI1>0] <- 2
quadrant[DV1 >0 & C_mI1<0] <- 3quadrant[localMI1[,5]>signif1] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI1))
DV1 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP)
C_mI1 <- localMI1[,1] - mean(localMI1[,1])
signif1 <- 0.05
quadrant[DV1 >0 & C_mI1>0] <- 4
quadrant[DV1 <0 & C_mI1<0] <- 1
quadrant[DV1 <0 & C_mI1>0] <- 2
quadrant[DV1 >0 & C_mI1<0] <- 3
quadrant[localMI1[,5]>signif1] <- 0LISA map for TOTAL_TAP_OUT_VOLUME_WeekendP
sp_q2_output.localMI1$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI1) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_IN_VOLUME_WeekendNP
fips2 <- order(sp_q2_output$SUBZONE_N)
localMI2 <- localmoran(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP, rswm_knn20)
head(localMI2)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.40572805 -0.003311258 0.04480731 1.93237137 0.02665684
## 2 0.18827603 -0.003311258 0.04480731 0.90509100 0.18270859
## 3 0.37062732 -0.003311258 0.04480731 1.76654954 0.03865185
## 4 -0.05249170 -0.003311258 0.04480731 -0.23233677 0.59186177
## 5 0.01667925 -0.003311258 0.04480731 0.09443855 0.46238040
## 6 -0.01068996 -0.003311258 0.04480731 -0.03485824 0.51390361printCoefmat(data.frame(localMI2[fips2,],row.names = sp_q2_output$SUBZONE_N[fips2]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI2 <- cbind(sp_q2_output, localMI2)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI2) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI2) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_IN_VOLUME_WeekendNP
Plotting Maran scatterplot
nci3 <- moran.plot(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_IN_VOLUME_WeekendNP", ylab="Spatially Lag TOTAL_TAP_IN_VOLUME_WeekendNP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekendNP <- scale(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP) %>% as.vectornci2.2 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekendNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_IN_VOLUME_WeekendNP", ylab="Spatially Lag z-TOTAL_TAP_IN_VOLUME_WeekendNP")
quadrant <- vector(mode="numeric",length=nrow(localMI2))DV2 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP) C_mI2 <- localMI2[,1] - mean(localMI2[,1]) signif2 <- 0.05quadrant[DV2 >0 & C_mI2>0] <- 4
quadrant[DV2 <0 & C_mI2<0] <- 1
quadrant[DV2 <0 & C_mI2>0] <- 2
quadrant[DV2 >0 & C_mI2<0] <- 3quadrant[localMI2[,5]>signif2] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI2))
DV2 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP)
C_mI2 <- localMI2[,1] - mean(localMI2[,1])
signif2 <- 0.05
quadrant[DV2 >0 & C_mI2>0] <- 4
quadrant[DV2 <0 & C_mI2<0] <- 1
quadrant[DV2 <0 & C_mI2>0] <- 2
quadrant[DV2 >0 & C_mI2<0] <- 3
quadrant[localMI2[,5]>signif2] <- 0LISA map for TOTAL_TAP_IN_VOLUME_WeekendNP
sp_q2_output.localMI2$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI2) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_IN_VOLUME_WeekendP
fips3 <- order(sp_q2_output$SUBZONE_N)
localMI3 <- localmoran(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP, rswm_knn20)
head(localMI3)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.262276674 -0.003311258 0.04460078 1.25758427 0.1042711
## 2 0.039061513 -0.003311258 0.04460078 0.20063912 0.4204904
## 3 0.264980287 -0.003311258 0.04460078 1.27038613 0.1019736
## 4 0.005030816 -0.003311258 0.04460078 0.03950052 0.4842457
## 5 0.029675052 -0.003311258 0.04460078 0.15619334 0.4379403
## 6 -0.030936656 -0.003311258 0.04460078 -0.13080890 0.5520368printCoefmat(data.frame(localMI3[fips3,],row.names = sp_q2_output$SUBZONE_N[fips3]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI3 <- cbind(sp_q2_output, localMI3)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI3) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI3) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_IN_VOLUME_WeekendP
Plotting Maran scatterplot
nci4 <- moran.plot(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_IN_VOLUME_WeekendP", ylab="Spatially Lag TOTAL_TAP_IN_VOLUME_WeekendP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekendP <- scale(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP) %>% as.vectornci2.3 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekendP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_IN_VOLUME_WeekendP", ylab="Spatially Lag z-TOTAL_TAP_IN_VOLUME_WeekendP")
quadrant <- vector(mode="numeric",length=nrow(localMI3))DV3 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP) C_mI3 <- localMI3[,1] - mean(localMI3[,1]) signif3 <- 0.05quadrant[DV3 >0 & C_mI3>0] <- 4
quadrant[DV3 <0 & C_mI3<0] <- 1
quadrant[DV3 <0 & C_mI3>0] <- 2
quadrant[DV3 >0 & C_mI3<0] <- 3quadrant[localMI3[,5]>signif3] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI3))
DV3 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP)
C_mI3 <- localMI3[,1] - mean(localMI3[,1])
signif3 <- 0.05
quadrant[DV3 >0 & C_mI3>0] <- 4
quadrant[DV3 <0 & C_mI3<0] <- 1
quadrant[DV3 <0 & C_mI3>0] <- 2
quadrant[DV3 >0 & C_mI3<0] <- 3
quadrant[localMI3[,5]>signif3] <- 0LISA map for TOTAL_TAP_IN_VOLUME_WeekendP
sp_q2_output.localMI3$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI3) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_OUT_VOLUME_WeekdayP
fips4 <- order(sp_q2_output$SUBZONE_N)
localMI4 <- localmoran(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP, rswm_knn20)
head(localMI4)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.43152514 -0.003311258 0.04470233 2.0566521 0.01985985
## 2 0.22306381 -0.003311258 0.04470233 1.0706895 0.14215454
## 3 0.31631567 -0.003311258 0.04470233 1.5117441 0.06529948
## 4 0.04567413 -0.003311258 0.04470233 0.2316869 0.40839061
## 5 0.02746659 -0.003311258 0.04470233 0.1455704 0.44213026
## 6 -0.12381627 -0.003311258 0.04470233 -0.5699543 0.71564566printCoefmat(data.frame(localMI4[fips4,],row.names = sp_q2_output$SUBZONE_N[fips4]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI4 <- cbind(sp_q2_output, localMI4)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI4) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI4) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_OUT_VOLUME_WeekdayP
Plotting Maran scatterplot
nci5 <- moran.plot(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_OUT_VOLUME_WeekdayP", ylab="Spatially Lag TOTAL_TAP_OUT_VOLUME_WeekdayP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekdayP <- scale(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP) %>% as.vectornci2.4 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekdayP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_OUT_VOLUME_WeekdayP", ylab="Spatially Lag z-TOTAL_TAP_OUT_VOLUME_WeekdayP")
quadrant <- vector(mode="numeric",length=nrow(localMI4))DV4 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP) C_mI4 <- localMI4[,1] - mean(localMI4[,1]) signif4 <- 0.05quadrant[DV4 >0 & C_mI4>0] <- 4
quadrant[DV4 <0 & C_mI4<0] <- 1
quadrant[DV4 <0 & C_mI4>0] <- 2
quadrant[DV4 >0 & C_mI4<0] <- 3quadrant[localMI4[,5]>signif4] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI4))
DV4 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP)
C_mI4 <- localMI4[,1] - mean(localMI4[,1])
signif4 <- 0.05
quadrant[DV4 >0 & C_mI4>0] <- 4
quadrant[DV4 <0 & C_mI4<0] <- 1
quadrant[DV4 <0 & C_mI4>0] <- 2
quadrant[DV4 >0 & C_mI4<0] <- 3
quadrant[localMI4[,5]>signif4] <- 0LISA map for TOTAL_TAP_OUT_VOLUME_WeekdayP
sp_q2_output.localMI4$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI4) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_OUT_VOLUME_WeekdayNP
fips5 <- order(sp_q2_output$SUBZONE_N)
localMI5 <- localmoran(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP, rswm_knn20)
head(localMI5)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.33271573 -0.003311258 0.04457577 1.59156632 0.05574109
## 2 0.12939944 -0.003311258 0.04457577 0.62857415 0.26481394
## 3 0.25096471 -0.003311258 0.04457577 1.20435884 0.11422546
## 4 0.01095202 -0.003311258 0.04457577 0.06755693 0.47306917
## 5 0.02022604 -0.003311258 0.04457577 0.11148265 0.45561681
## 6 -0.09576990 -0.003311258 0.04457577 -0.43792337 0.66927908Mapping the local Maran’s I
printCoefmat(data.frame(localMI5[fips5,],row.names = sp_q2_output$SUBZONE_N[fips5]), check.names = FALSE)Mapping local Moran’s I values
sp_q2_output.localMI5 <- cbind(sp_q2_output, localMI5)Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI5) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_OUT_VOLUME_WeekdayNP
Plotting Maran scatterplot
tm_shape(sp_q2_output.localMI5) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Plotting Moran scatterplot with standardised variable
nci6 <- moran.plot(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_OUT_VOLUME_WeekdayNP", ylab="Spatially Lag TOTAL_TAP_OUT_VOLUME_WeekdayNP")
sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekdayNP <- scale(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP) %>% as.vectornci2.5 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_OUT_VOLUME_WeekdayNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_OUT_VOLUME_WeekdayNP", ylab="Spatially Lag z-TOTAL_TAP_OUT_VOLUME_WeekdayNP")
quadrant <- vector(mode="numeric",length=nrow(localMI5))DV5 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP) C_mI5 <- localMI5[,1] - mean(localMI5[,1]) signif5 <- 0.05quadrant[DV5 >0 & C_mI5>0] <- 4
quadrant[DV5 <0 & C_mI5<0] <- 1
quadrant[DV5 <0 & C_mI5>0] <- 2
quadrant[DV5 >0 & C_mI5<0] <- 3quadrant[localMI5[,5]>signif5] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI5))
DV5 <- sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP - mean(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP)
C_mI5 <- localMI5[,1] - mean(localMI5[,1])
signif5 <- 0.05
quadrant[DV5 >0 & C_mI5>0] <- 4
quadrant[DV5 <0 & C_mI5<0] <- 1
quadrant[DV5 <0 & C_mI5>0] <- 2
quadrant[DV5 >0 & C_mI5<0] <- 3
quadrant[localMI5[,5]>signif5] <- 0LISA map for TOTAL_TAP_OUT_VOLUME_WeekdayNP
sp_q2_output.localMI5$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI5) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_IN_VOLUME_WeekdayP
fips6 <- order(sp_q2_output$SUBZONE_N)
localMI6 <- localmoran(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP, rswm_knn20)
head(localMI6)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.437024400 -0.003311258 0.04462493 2.08446727 0.01855884
## 2 0.186913376 -0.003311258 0.04462493 0.90048811 0.18393028
## 3 0.400795165 -0.003311258 0.04462493 1.91296479 0.02787628
## 4 -0.006191976 -0.003311258 0.04462493 -0.01363678 0.50544012
## 5 0.014899607 -0.003311258 0.04462493 0.08620686 0.46565099
## 6 -0.065182964 -0.003311258 0.04462493 -0.29288917 0.61519657printCoefmat(data.frame(localMI6[fips6,],row.names = sp_q2_output$SUBZONE_N[fips6]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI6 <- cbind(sp_q2_output, localMI6)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI6) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI6) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_IN_VOLUME_WeekdayP
Plotting Maran scatterplot
nci7 <- moran.plot(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_IN_VOLUME_WeekdayP", ylab="Spatially Lag TOTAL_TAP_IN_VOLUME_WeekdayP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekdayP <- scale(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP) %>% as.vectornci2.6 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekdayP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_IN_VOLUME_WeekdayP", ylab="Spatially Lag z-TOTAL_TAP_IN_VOLUME_WeekdayP")
quadrant <- vector(mode="numeric",length=nrow(localMI6))DV6 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP) C_mI6 <- localMI6[,1] - mean(localMI6[,1]) signif6 <- 0.05quadrant[DV6 >0 & C_mI6>0] <- 4
quadrant[DV6 <0 & C_mI6<0] <- 1
quadrant[DV6 <0 & C_mI6>0] <- 2
quadrant[DV6 >0 & C_mI6<0] <- 3quadrant[localMI6[,5]>signif6] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI6))
DV6 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP)
C_mI6 <- localMI6[,1] - mean(localMI6[,1])
signif6 <- 0.05
quadrant[DV6 >0 & C_mI6>0] <- 4
quadrant[DV6 <0 & C_mI6<0] <- 1
quadrant[DV6 <0 & C_mI6>0] <- 2
quadrant[DV6 >0 & C_mI6<0] <- 3
quadrant[localMI6[,5]>signif6] <- 0LISA map for TOTAL_TAP_IN_VOLUME_WeekdayP
sp_q2_output.localMI6$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI6) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Computing local Moran’s I for TOTAL_TAP_IN_VOLUME_WeekdayNP
fips7 <- order(sp_q2_output$SUBZONE_N)
localMI7 <- localmoran(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP, rswm_knn20)
head(localMI7)## Ii E.Ii Var.Ii Z.Ii Pr(z > 0)
## 1 0.306116035 -0.003311258 0.0445031 1.46677490 0.07121865
## 2 0.044762480 -0.003311258 0.0445031 0.22788343 0.40986843
## 3 0.269753531 -0.003311258 0.0445031 1.29440611 0.09776259
## 4 0.006501971 -0.003311258 0.0445031 0.04651754 0.48144888
## 5 0.022628451 -0.003311258 0.0445031 0.12296173 0.45106870
## 6 -0.054946679 -0.003311258 0.0445031 -0.24476684 0.59668151printCoefmat(data.frame(localMI7[fips7,],row.names = sp_q2_output$SUBZONE_N[fips7]), check.names = FALSE)Mapping the local Maran’s I
sp_q2_output.localMI7 <- cbind(sp_q2_output, localMI7)Mapping local Moran’s I values
tm_shape(sp_q2_output.localMI7) +
tm_fill(col = "Ii",
style = "pretty",
title = "local moran statistics") +
tm_borders(alpha = 0.5)
Mapping local Moran’s I p-values
tm_shape(sp_q2_output.localMI7) +
tm_fill(col = "Pr.z...0.",
breaks=c(-Inf, 0.001, 0.01, 0.05, 0.1, Inf),
palette="-Blues",
title = "local Moran's I p-values") +
tm_borders(alpha = 0.5)
Creating a LISA Cluster Map for TOTAL_TAP_IN_VOLUME_WeekdayNP
Plotting Maran scatterplot
nci8 <- moran.plot(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="TOTAL_TAP_IN_VOLUME_WeekdayNP", ylab="Spatially Lag TOTAL_TAP_IN_VOLUME_WeekdayNP")
Plotting Moran scatterplot with standardised variable
sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekdayNP <- scale(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP) %>% as.vectornci2.7 <- moran.plot(sp_q2_output$Z.TOTAL_TAP_IN_VOLUME_WeekdayNP, rswm_knn20, labels=as.character(sp_q2_output$SUBZONE_N), xlab="z-TOTAL_TAP_IN_VOLUME_WeekdayNP", ylab="Spatially Lag z-TOTAL_TAP_IN_VOLUME_WeekdayNP")
quadrant <- vector(mode="numeric",length=nrow(localMI7))DV7 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP) C_mI7 <- localMI7[,1] - mean(localMI7[,1]) signif7 <- 0.05quadrant[DV7 >0 & C_mI7>0] <- 4
quadrant[DV7 <0 & C_mI7<0] <- 1
quadrant[DV7 <0 & C_mI7>0] <- 2
quadrant[DV7 >0 & C_mI7<0] <- 3quadrant[localMI7[,5]>signif7] <- 0quadrant <- vector(mode="numeric",length=nrow(localMI7))
DV7 <- sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP - mean(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP)
C_mI7 <- localMI7[,1] - mean(localMI7[,1])
signif7 <- 0.05
quadrant[DV7 >0 & C_mI7>0] <- 4
quadrant[DV7 <0 & C_mI7<0] <- 1
quadrant[DV7 <0 & C_mI7>0] <- 2
quadrant[DV7 >0 & C_mI7<0] <- 3
quadrant[localMI7[,5]>signif7] <- 0LISA map for TOTAL_TAP_IN_VOLUME_WeekdayNP
sp_q2_output.localMI7$quadrant <- quadrant
colors <- c("#ffffff", "#2c7bb6", "#abd9e9", "#fdae61", "#d7191c")
clusters <- c("insignificant", "low-low", "low-high", "high-low", "high-high")
tm_shape(sp_q2_output.localMI7) +
tm_fill(col = "quadrant", style = "cat", palette = colors[c(sort(unique(quadrant)))+1], labels = clusters[c(sort(unique(quadrant)))+1], popup.vars = c("Postal.Code")) +
tm_view(set.zoom.limits = c(11,17)) +
tm_borders(alpha=0.5)
Hot Spot and Cold Spot Area Analysis
Creating adaptive proximity matrix
knb_lw <- nb2listw(wm_knn20, style = "B")
summary(knb_lw)## Characteristics of weights list object:
## Neighbour list object:
## Number of regions: 303
## Number of nonzero links: 6060
## Percentage nonzero weights: 6.60066
## Average number of links: 20
## Non-symmetric neighbours list
## Link number distribution:
##
## 20
## 303
## 303 least connected regions:
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 with 20 links
## 303 most connected regions:
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 with 20 links
##
## Weights style: B
## Weights constants summary:
## n nn S0 S1 S2
## B 303 91809 6060 10980 493518Gi statistics using adaptive distance for TOTAL_TAP_OUT_VOLUME_WeekendNP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendNP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_OUT_VOLUME_WeekendP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekendP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_IN_VOLUME_WeekendNP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendNP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_IN_VOLUME_WeekendP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekendP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_OUT_VOLUME_WeekdayP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_OUT_VOLUME_WeekdayNP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_OUT_VOLUME_WeekdayNP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_IN_VOLUME_WeekdayP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Gi statistics using adaptive distance for TOTAL_TAP_IN_VOLUME_WeekdayNP
gi.adaptive <- localG(sp_q2_output$TOTAL_TAP_IN_VOLUME_WeekdayNP, knb_lw)
sp_q2_output.gi <- cbind(sp_q2_output, as.matrix(gi.adaptive))
names(sp_q2_output.gi)[42] <- "gstat_adaptive"Mapping Gi values with adaptive distance weights
tm_shape(sp_q2_output.gi) +
tm_fill(col = "gstat_adaptive",
style = "pretty",
palette = "-RdBu",
title = "local Gi") +
tm_borders(alpha = 0.5)
Conclusion for Hot Spot and Cold Spot Area Analysis
Based on the 8 choropleth maps above, subzone areas shaded in red are the hot spot areas and subzone areas shaded in blue are the cold spot areas. The darkness of the colours representing the intensity of the Gi values. In conlcusion, the choropleth maps above shows a clear sign of hot spot and cold spot areas. The hot spot areas tend to loacted at the east side of Singapore around Tempinis area. The cold spot areas, on the other hand, tend to located at the center of Singapore.