Skip to content

Commit

Permalink
Merge pull request #13 from U-Shift/two-exports-#10
Browse files Browse the repository at this point in the history 
Two exports #10
  • Loading branch information
@temospena
temospena authored May 20, 2024
2 parents a53b75e + 63a02f0 commit 15197c6
Show file tree
Hide file tree
Showing 4 changed files with 172 additions and 112 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,3 +42,4 @@ traffic.log
SiteSelection.qgz
_targets/meta/meta*

_targets/meta/meta
238 changes: 138 additions & 100 deletions R/functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -248,43 +248,32 @@ get_centrality = function(road_network_clean, CITY) {

get_centrality_grid = function(centrality_nodes, grid) {

centrality_grid =
st_join(centrality_nodes,
grid,
# st_transform(grid, 3857),
join = st_intersects) %>%
st_drop_geometry() %>%
group_by(ID) %>%
summarise(degree = mean(degree),
betweenness = mean(betweenness),
closeness = mean(closeness)) %>%
mutate(degree = rescale(degree),
betweenness = rescale(betweenness),
closeness = rescale(closeness)
centrality_grid = grid |>
st_join(centrality_nodes, join = st_intersects) %>%
st_drop_geometry() %>%
group_by(ID) %>%
summarise(
degree = mean(degree),
betweenness = mean(betweenness),
closeness = mean(closeness)
) %>%
mutate(
degree = rescale(degree),
betweenness = rescale(betweenness),
closeness = rescale(closeness)
)

# saveRDS(grid_centrality, paste0("outputdata/", CITY, "/centrality_grid".Rds"))

}





# get_census --------------------------------------------------------------

get_census = function(CITY, CITYlimit) {
get_census = function(CITYlimit) {

CENSUSpoint = st_read("https://github.com/U-Shift/SiteSelection/releases/download/0.1/CENSUSpoint.gpkg", quiet = TRUE)
CITYcensus = CENSUSpoint |> filter(Concelho == toupper(CITY))

# TO-DO: st_intersects with the grid
# CITYcensus = CENSUSpoint |>
# st_intersection(CITYlimit)
# or
# CITYcensus = CENSUSpoint[CITYlimit,]
CITYcensus = CENSUSpoint[CITYlimit,]

# saveRDS(CITYcensus, paste0("outputdata/", CITY, "/CITYcensus.Rds"))
}


Expand Down Expand Up @@ -343,7 +332,11 @@ get_landuse = function(grid, CITYcensus) {
mutate(entropy = round(entropy, digits = 3)) |>
as.data.frame()

saveRDS(landuse_entropy,"outputdata/test_landuse_entropy.Rds")
landuse_grid = landuse_entropy

return(landuse_grid)

# saveRDS(landuse_entropy,"outputdata/test_landuse_entropy.Rds")

}

Expand All @@ -359,13 +352,13 @@ get_transit = function(CITYlimit) {

# get_transit_grid --------------------------------------------------------

get_transit_grid = function(points_transit, grid) {
get_transit_grid = function(grid, points_transit) {

if (nrow(points_transit) == 0){ # empty - no bus stops

transit_grid = grid |>
st_drop_geometry() |>
mutate(transit = 0)
mutate(frequency = 0)

} else {

Expand All @@ -387,100 +380,145 @@ get_transit_grid = function(points_transit, grid) {



# find_candidates ---------------------------------------------------------
# classify_candidates ---------------------------------------------------------

find_candidates = function(grid, CITY,
centrality_grid, density_grid, landuse_entropy, transit_grid,
population_min, degree_min, betweeness_range, closeness_range,
entropy_min, freq_bus) {
# centrality
find_centrality_candidates = function(centrality_grid, degree_min, betweeness_range, closeness_range) {

# centrality
candidates_centrality = grid |>
# st_transform(3857) |>
left_join(centrality_grid)
# Filter in thresholds #for Lisbon. Adjust for other places?
candidates_centrality = candidates_centrality %>%
filter(degree >= degree_min(centrality_grid$degree), #1088 média
betweenness >= quantile(centrality_grid$betweenness, betweeness_range, na.rm = TRUE) &
betweenness <= quantile(centrality_grid$betweenness, 1-betweeness_range, na.rm = TRUE),
closeness >= closeness_range & closeness <= 1-closeness_range
# closeness >= quantile(centrality_grid$closeness, 0.25, na.rm = TRUE) & closeness <= quantile(centrality_grid$closeness, 0.75, na.rm = TRUE) #2135 #too high
) |>
centrality_candidates = centrality_grid |>
mutate(degree_candidate = ifelse(degree >= degree_min(centrality_grid$degree, na.rm = TRUE), 1, 0),
betweenness_candidate = ifelse(betweenness >= quantile(betweenness, betweeness_range, na.rm = TRUE) &
betweenness <= quantile(betweenness, 1-betweeness_range, na.rm = TRUE),
1, 0),
closeness_candidate = ifelse(closeness >= closeness_range & closeness <= 1-closeness_range,
1, 0)) |>
mutate(degree = round(degree, digits = 3),
betweenness = round(betweenness, digits = 3),
closeness = round(closeness, digits = 3)
)

return(centrality_candidates)

}

# map_candidates = mapview::mapview(candidates_centrality)
st_write(candidates_centrality, paste0("outputdata/", CITY, "/candidates_centrality.gpkg"), delete_dsn = TRUE)

# density
find_density_candidates = function(density_grid, population_min) {

density_candidates = density_grid |>
mutate(population_candidate =
ifelse(population >= population_min(density_grid$population), 1, 0))

# density
candidates_density = grid |>
# st_transform(3857) |>
left_join(density_grid) |>
# filter(population >= mean(density_grid$population)) #above mean
filter(population >= population_min(density_grid$population)) #above mean
return(density_candidates)

st_write(candidates_density, paste0("outputdata/", CITY, "/candidates_density.gpkg"), delete_dsn = TRUE)
}


# landuse
find_landuse_candidates = function(landuse_grid, entropy_min) {

# transit
# landuse_entropy = readRDS("outputdata/test_landuse_entropy.Rds") # WHY does not work without this??
landuse_candidates = landuse_grid |>
mutate(entropy_candidate =
ifelse(entropy >= entropy_min, 1, 0))

# if the object is not null, process. Otherwise, skip
return(landuse_candidates)

candidates_transit = grid |>
left_join(transit_grid, by = "ID") |>
mutate(frequency = replace_na(frequency, 0)) |> # unecessary
mutate(transit = case_when(
}

# transit
find_transit_candidates = function(transit_grid, freq_bus) {

if (max(transit_grid$frequency, na.rm = TRUE) == 0){

transit_candidates = transit_grid |>
mutate(transit = 0,
transit_candidate = 0)

} else {

transit_candidates = transit_grid |>
mutate(transit = case_when(
frequency <= freq_bus[1] ~ 1,
frequency > freq_bus[1] & frequency <= freq_bus[2] ~ 2,
frequency > freq_bus[2] & frequency <= freq_bus[3] ~ 3,
frequency > freq_bus[3] ~ 4
)) |>
filter(transit %in% c(3,4))

st_write(candidates_transit, paste0("outputdata/", CITY, "/candidates_transit.gpkg"), delete_dsn = TRUE)



# landuse
landuse_entropy = readRDS("outputdata/test_landuse_entropy.Rds") # WHY does not work without this??
candidates_landuse =
landuse_entropy |>
dplyr::filter(entropy >= entropy_min)

st_write(candidates_landuse, paste0("outputdata/", CITY, "/candidates_landuse.gpkg"), delete_dsn = TRUE)

# all candidates
candidates_all = grid |>
left_join(candidates_centrality |> st_drop_geometry()) |>
left_join(candidates_density |> st_drop_geometry(), by = "ID") |>
left_join(candidates_transit |>
# select(-frequency) |> TO-DO tidy this
st_drop_geometry(), by = "ID") |>
left_join(candidates_landuse, by = "ID") |>
dplyr::filter(!is.na(degree)) |>
dplyr::filter(!is.na(population)) |>
dplyr::filter(!is.na(entropy))

if (nrow(candidates_transit) == 0){

frequency > freq_bus[1] & frequency <= freq_bus[2] ~ 2,
frequency > freq_bus[2] & frequency <= freq_bus[3] ~ 3,
frequency > freq_bus[3] ~ 4
)) |>
mutate(transit_candidate = ifelse(transit %in% c(3,4), 1, 0))
}

return(transit_candidates)

}


# grid_all ----------------------------------------------------------------

make_grid_all = function(grid, CITY, centrality_candidates, density_candidates, transit_candidates, landuse_candidates) {

grid_all = grid |>
left_join(centrality_candidates |> st_drop_geometry(), by = "ID") |>
left_join(density_candidates |> st_drop_geometry(), by = "ID") |>
left_join(transit_candidates |>
# select(-frequency) |> TO-DO tidy this
st_drop_geometry(), by = "ID") |>
left_join(landuse_candidates, by = "ID") |>

mutate(all_candidate = ifelse(degree_candidate == 1 & betweenness_candidate == 1 &
closeness_candidate == 1 & population_candidate == 1 &
entropy_candidate == 1, 1, 0)) |>
mutate(all_candidate = as.numeric(all_candidate)) |>
mutate(all_candidate = ifelse(is.na(all_candidate), 0, all_candidate))

## DEAL WITH TRANSIT AFTER ##


st_write(grid_all, dsn = paste0("outputdata/", CITY, "/grid_all.gpkg"), delete_dsn = TRUE)


return(grid_all)

}


# filter_candidates -------------------------------------------------------

get_site_selection = function(grid_all, CITY) {


grid_selection = grid_all |>
dplyr::filter(all_candidate == 1)



# transit

if (max(grid_all$transit_candidate, na.rm = TRUE) == 0){

print("No transit complexity !")

candidates_all = candidates_all |>
grid_selection = grid_selection |>
select(-transit, -frequency)

} else {

print("Including transit complexity")

candidates_all = candidates_all |>
grid_selection = grid_selection |>
dplyr::filter(!is.na(transit))

}


# tidy df

grid_selection = grid_selection |>
select(-transit_candidate, -degree_candidate, -betweenness_candidate,
-closeness_candidate, -population_candidate, -entropy_candidate, -all_candidate)

st_write(grid_selection, dsn = paste0("outputdata/", CITY, "/site_selection.gpkg"), delete_dsn = TRUE)

# mapview::mapview(candidates_all)
st_write(candidates_all, paste0("outputdata/", CITY, "/candidates_all.gpkg"), delete_dsn = TRUE)

return(grid_selection)

}
37 changes: 27 additions & 10 deletions _targets.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@


# Set defaults HERE ######################
CITY_input = "Entroncamento"
CITY_input = "Lisboa"
cellsize_input = c(400, 400)
square_input = TRUE #TRUE = squares, FALSE = hexagons
build_osm = FALSE #clean osm road network again?
Expand All @@ -29,7 +29,7 @@ library(targets)

# Set target options:
tar_option_set(
packages = c("tibble", "tidyverse", "sf", "sfheaders", "stplanr", "osmdata", "sfnetworks",
packages = c("tibble", "dplyr", "tidyr", "sf", "sfheaders", "stplanr", "osmdata", "sfnetworks",
"tidygraph", "scales", "qgisprocess"), # packages that your targets need to run
format = "rds", # default storage format
storage = "worker",
Expand Down Expand Up @@ -85,7 +85,7 @@ list(
command = get_centrality_grid(centrality_nodes, grid)),
tar_target(
name = CITYcensus,
command = get_census(CITY)),
command = get_census(CITYlimit)),
tar_target(
name = points_transit,
command = get_transit(CITYlimit)),
Expand All @@ -96,14 +96,31 @@ list(
name = density_grid,
command = get_density_grid(grid, CITYcensus)),
tar_target(
name = landuse_entropy,
name = landuse_grid,
command = get_landuse(grid, CITYcensus)),

tar_target(
name = classify_candidates_centrality,
command = find_centrality_candidates(centrality_grid, degree_min, betweeness_range, closeness_range)),

tar_target(
name = classify_candidates_density,
command = find_density_candidates(density_grid, population_min)),
tar_target(
name = classify_candidates_landuse,
command = find_landuse_candidates(landuse_grid, entropy_min)),
tar_target(
name = classify_candidates_transit,
command = find_transit_candidates(transit_grid, freq_bus)),

tar_target(
name = grid_all,
command = make_grid_all(grid, CITY = CITY_input,
classify_candidates_transit, classify_candidates_landuse,
classify_candidates_centrality, classify_candidates_density)),

tar_target(
name = candidates_all,
command = find_candidates(grid, CITY,
centrality_grid, density_grid, landuse_entropy, transit_grid,
population_min, degree_min, betweeness_range, closeness_range,
entropy_min, freq_bus)
)
name = site_selection,
command = get_site_selection(CITY = CITY_input, grid_all))
)

8 changes: 6 additions & 2 deletions run.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,10 @@ targets::tar_make()

# targets::tar_meta(fields = error, complete_only = TRUE) # debugging

targets::tar_load(candidates_all)
mapview::mapview(candidates_all, zcol="entropy")
targets::tar_load(grid_all)
mapview::mapview(grid_all, zcol="all_candidate")
mapview::mapview(grid_all, zcol="frequency")

targets::tar_load(site_selection)
mapview::mapview(site_selection, zcol="entropy")

0 comments on commit 15197c6

Please sign in to comment.