suppressPackageStartupMessages({
library(sf)
library(tmap)
library(dplyr)
library(tidyverse)
library(spatstat)
library(aspace)
library(units)
})
## Warning: 套件 'sf' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'tmap' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'tidyverse' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'ggplot2' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'tibble' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'tidyr' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'readr' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'purrr' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'forcats' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'lubridate' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.data' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.univar' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.geom' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.random' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.explore' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.model' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'spatstat.linnet' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'aspace' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'splancs' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'sp' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'Hmisc' 是用 R 版本 4.3.3 來建造的
## Warning: 套件 'units' 是用 R 版本 4.3.3 來建造的
schools = st_read("C:/Users/USER/Desktop/Final exam/SCHOOL/SCHOOL.shp",options="ENCODING=BIG5")
## options: ENCODING=BIG5
## Reading layer `SCHOOL' from data source
## `C:\Users\USER\Desktop\Final exam\SCHOOL\SCHOOL.shp' using driver `ESRI Shapefile'
## Simple feature collection with 148 features and 4 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 297078.6 ymin: 2763290 xmax: 312516.7 ymax: 2784542
## Projected CRS: TWD97 / TM2 zone 121
taipei = st_read("C:/Users/USER/Desktop/Final exam/Taipei_Vill/Taipei_Vill.shp",options="ENCODING=BIG5")
## options: ENCODING=BIG5
## Reading layer `Taipei_Vill' from data source
## `C:\Users\USER\Desktop\Final exam\Taipei_Vill\Taipei_Vill.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 456 features and 8 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: 296094.4 ymin: 2761518 xmax: 317198.9 ymax: 2789180
## Projected CRS: TWD97 / TM2 zone 121
fastfood = st_read("C:/Users/USER/Desktop/Final exam/Tpe_Fastfood/Tpe_Fastfood.shp",options="ENCODING=BIG5")
## options: ENCODING=BIG5
## Reading layer `Tpe_Fastfood' from data source
## `C:\Users\USER\Desktop\Final exam\Tpe_Fastfood\Tpe_Fastfood.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 98 features and 8 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 297198.9 ymin: 2763885 xmax: 312205.7 ymax: 2781148
## Projected CRS: TWD97 / TM2 zone 121
students = read.csv("C:/Users/USER/Desktop/Final exam/113_basec.csv",stringsAsFactors = FALSE)
students = students %>% mutate(Name = str_remove_all(學校名稱, "^(私立|市立)")) %>% select(Name, TOTAL)
schools <- left_join(schools, students, by = "Name")
schools_lyr = tm_shape(schools) + tm_dots(col = "yellow", size = 0.05)
fastfood_lyr = tm_shape(fastfood) + tm_dots(col = "red", size = 0.03)
taipei_lyr = tm_shape(taipei) +tm_polygons()
school_ff_lyr =
taipei_lyr + schools_lyr + fastfood_lyr +
tm_layout(
title = "台北市速食店與學校分布",
title.position = c(0.1, 0.95),
title.size = 0.8,
legend.position = c("left", "bottom"),
legend.title.size = 0.8,
legend.text.size = 0.6,
frame = FALSE
) +
tm_scale_bar(position = c(0.7, 0.1), text.size = 0.5) +
tm_compass(position = c("right", "top"), size = 1.5)+
tm_add_legend(type = "symbol",
labels = c("學校", "速食店"),
col = c("yellow", "red"),
shape = c(16, 16),
size = 0.5,
title = "點位圖例")
school_ff_lyr
tmap_save(school_ff_lyr, filename = "school_ff_lyr.jpg", width = 2000, height = 1600, dpi = 300)
## Map saved to C:\Users\USER\Desktop\school_ff_lyr.jpg
## Resolution: 2000 by 1600 pixels
## Size: 6.666667 by 5.333333 inches (300 dpi)
衛福部推動「校園周邊健康飲食輔導示範計畫」,以示範校園周邊(距離學校500公尺以內)之餐飲業者為計畫對象,因此以500公尺作為buffer半徑。計算每間學校500公尺半徑內的速食店數量。(ff_count)
st_crs(schools) = st_crs(fastfood)
school_buffer = st_buffer(schools,dist=500)
school_ff.inter = st_intersects(school_buffer, fastfood)
schools$ff_count = lengths(school_ff.inter)
school_buffer_lyr = tm_shape(school_buffer) + tm_borders(col = "lightblue")
H0:學校總學生數與500公尺內的速食店數量有關。 H1:學校總學生數與500公尺內的速食店數量無關。
cor.test(schools$TOTAL, schools$ff_count)
##
## Pearson's product-moment correlation
##
## data: schools$TOTAL and schools$ff_count
## t = 3.0233, df = 127, p-value = 0.003025
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.0903044 0.4134505
## sample estimates:
## cor
## 0.2591141
根據 Pearson 相關分析結,學校總學生人數與其500公尺範圍內的速食店數量之間具有統計上顯著相關,這顯示學生人數多的學校附近,可能有較多的速食店。
步行十分鐘的距離約為600到800公尺,因此以速食店的800公尺內距離作為服務範圍,分析每間學校被速食店服務範圍覆蓋次數(ff_cover_count)
fastfood_buffer <- st_buffer(fastfood, dist = 800)
ff_school <- st_intersects(schools, fastfood_buffer)
schools$ff_cover_count <- lengths(ff_school)
每間學校 500m 半徑內的速食店數量除以學生總人數,得出「每位學生平均可分配到速食店數量」,該數值越大表示學生的速食店可及性高(ff_per_student)
schools$ff_per_student = schools$ff_count / schools$TOTAL
top5_schools <- schools %>%arrange(desc(ff_per_student)) %>%slice(1:5) %>%select(Name, ff_count, TOTAL, ff_per_student)
print(top5_schools)
## Simple feature collection with 5 features and 4 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 300815.7 ymin: 2770546 xmax: 304668.2 ymax: 2781199
## Projected CRS: TWD97 / TM2 zone 121
## Name ff_count TOTAL ff_per_student geometry
## 1 忠孝國小 3 328 0.009146341 POINT (302458.4 2770546)
## 2 西門國小 4 572 0.006993007 POINT (300815.7 2770654)
## 3 懷生國小 2 311 0.006430868 POINT (304668.2 2770898)
## 4 福星國小 3 619 0.004846527 POINT (301315.7 2771005)
## 5 逸仙國小 2 428 0.004672897 POINT (300934.3 2781199)
top5_schools_geo <- schools[schools$Name %in% top5_schools$Name, ]
top5_schools_lyr <- tm_shape(top5_schools_geo) +
tm_dots(col = "blue", size = 0.07, border.col = "black") + tm_text("Name", size = 0.5, ymod = 1)
school_access_lyr =
taipei_lyr + schools_lyr + top5_schools_lyr +
tm_layout(
title = "速食店可及性最高前五名學校分布",
title.position = c("center", "top"),
title.size = 1,
legend.outside = TRUE,
frame = FALSE
)
school_access_lyr
tmap_save(school_access_lyr, filename = "school_access_lyr.jpg", width = 2000, height = 1600, dpi = 300)
## Map saved to C:\Users\USER\Desktop\school_access_lyr.jpg
## Resolution: 2000 by 1600 pixels
## Size: 6.666667 by 5.333333 inches (300 dpi)
taipei_town = taipei %>% group_by(TOWN) %>% summarise(geometry = st_union(geometry))
st_crs(fastfood) = st_crs(taipei_town)
town_ff = st_intersection(fastfood,taipei_town)
## Warning: attribute variables are assumed to be spatially constant throughout
## all geometries
ff_count = town_ff %>%st_drop_geometry() %>% count(TOWN, name = "ff_count")
taipei_town = left_join(taipei_town, ff_count, by = "TOWN")
taipei_town_ff_lyr =
tm_shape(taipei_town) + tm_fill("ff_count", palette = "Reds", title = "速食店總數") + tm_borders() + tm_layout(outer.margins = c(0.05, 0.05, 0.05, 0.05),title="台北市各區速食店分布",title.position=c(0.05,"top"),title.size=0.8,legend.title.size = 0.8,legend.text.size = 0.5,frame=F)
taipei_town_ff_lyr
tmap_save(taipei_town_ff_lyr, filename = "taipei_town_ff_lyr.jpg", width = 2000, height = 1600, dpi = 300)
## Map saved to C:\Users\USER\Desktop\taipei_town_ff_lyr.jpg
## Resolution: 2000 by 1600 pixels
## Size: 6.666667 by 5.333333 inches (300 dpi)
「每位學生平均可分配到速食店數量」在台北市各行政區的分布
schools_town <- st_join(schools, taipei_town, join = st_within)
town_access <- schools_town %>%
st_drop_geometry() %>%
group_by(TOWN) %>%
summarise(avg_access = mean(ff_per_student, na.rm = TRUE))
taipei_town <- left_join(taipei_town, town_access, by = "TOWN")
town_ff_access_lyr =
tm_shape(taipei_town) +
tm_fill("avg_access", palette = "Greens", style = "quantile", title = "學生速食店可及性") +
tm_borders() +
tm_layout(
outer.margins = c(0.05, 0.05, 0.05, 0.05),
title = "台北市各行政區學生速食店可及性",
title.position = c(0.01, 0.95),
title.size = 0.8,
legend.title.size = 0.8,
legend.text.size = 0.5,
legend.position = c(0.01,0.01),
frame = FALSE
)
town_ff_access_lyr
tmap_save(town_ff_access_lyr, filename = "town_ff_access_lyr.jpg", width = 2000, height = 1600, dpi = 300)
## Map saved to C:\Users\USER\Desktop\town_ff_access_lyr.jpg
## Resolution: 2000 by 1600 pixels
## Size: 6.666667 by 5.333333 inches (300 dpi)
st_crs(schools) = st_crs(fastfood)
dist_matrix <- st_distance(schools, fastfood)
schools$nearest_ff_dist <- apply(dist_matrix, 1, min)
schools$nearest_ff_id <- apply(dist_matrix, 1, which.min)
schools$nearest_ff_name <- fastfood$ALIAS[schools$nearest_ff_id]
離速食店最近的五間學校
nearest_top5 = schools %>%
st_drop_geometry() %>%
select(Name,nearest_ff_dist) %>%
arrange(nearest_ff_dist) %>%
slice(1:5)
nearest_top5
離速食店最遠的五間學校
nearest_last5 = schools %>%
st_drop_geometry() %>%
arrange(desc(nearest_ff_dist)) %>%
select(Name, nearest_ff_dist) %>%
head(5)
nearest_last5
nearest_top5_geo = schools[schools$Name %in% nearest_top5$Name, ]
nearest_last5_geo = schools[schools$Name %in% nearest_last5$Name, ]
top5_lyr = tm_shape(nearest_top5_geo) + tm_dots(col = "blue", size = 0.1, title = "最近速食店的前五所學校")
last5_lyr = tm_shape(nearest_last5_geo) + tm_dots(col = "red", size = 0.1, title = "最近速食店的倒數五所學校")
nearest_lyr =
taipei_lyr + schools_lyr + top5_lyr + last5_lyr +
tm_layout(
title = "距離最近速食店最遠/最近的十所學校",
title.position = c("center", "top"),
title.size = 1,
legend.position = c(0.1,0.1),
frame = FALSE
) +
tm_scale_bar(position = c("left", "bottom"), text.size = 0.5) +
tm_compass(position = c("right", "top"), size = 1.5) +
tm_add_legend(type = "symbol",
labels = c("前五所", "倒數五所"),
col = c("blue", "red"),
shape = c(16, 16),
size = 0.5,)
nearest_lyr
tmap_save(nearest_lyr, filename = "nearest_lyr.jpg", width = 2000, height = 1600, dpi = 300)
## Map saved to C:\Users\USER\Desktop\nearest_lyr.jpg
## Resolution: 2000 by 1600 pixels
## Size: 6.666667 by 5.333333 inches (300 dpi)
ggplot(schools, aes(x = nearest_ff_dist)) +
geom_histogram(binwidth = 100, fill = "skyblue", color = "black") +
labs(title = "學校與最近速食店的距離分布",
x = "距離(m)",
y = "學校數量") +
theme_minimal()
ggsave("distance_histogram.jpg", width = 8, height = 6, dpi = 300)