
#  import packages
library(tidyverse)
library(sf)
library(mapview)
library(rvest)
library(httr)
library(ggplot2)
library(ggmap)
library(maps)
library(ggsn)
library(geosphere)
library(dplyr)
library(RColorBrewer)
library(readxl)
library(leaflet)
library(leaflet.extras)
library(plot3D)
library(av)
library(rayshader)
library(lattice)
library(latticeExtra)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.2     ✔ tibble    3.2.1
✔ lubridate 1.9.2     ✔ tidyr     1.3.0
✔ purrr     1.0.1     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE

The legacy packages maptools, rgdal, and rgeos, underpinning this package
will retire shortly. Please refer to R-spatial evolution reports on
https://r-spatial.org/r/2023/05/15/evolution4.html for details.
This package is now running under evolution status 0 


Attaching package: ‘rvest’


The following object is masked from ‘package:readr’:

    guess_encoding


ℹ Google's Terms of Service: <https://mapsplatform.google.com>
ℹ Please cite ggmap if you use it! Use `citation("ggmap")` for details.

Attaching package: ‘maps’


The following object is masked from ‘package:purrr’:

    map


Loading required package: grid

Warning message:
“multiple methods tables found for ‘elide’”

Attaching package: ‘latticeExtra’


The following object is masked from ‘package:ggplot2’:

    layer


# import the download data
Bluephone_location <- read_csv("data/Bluephone Locations My Map Downloaded with coordinates.csv")
head(Bluephone_location)

Rows: 89 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (2): Formal_Name_and_Room, Street_Address
dbl (2): Latitude, Longitude

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.


Bluephone_location <- Bluephone_location |>
    mutate(across(Longitude, as.double))


head(Bluephone_location)


# creat the base map
base_map <- leaflet() %>%
    addTiles() %>%
    fitBounds(-123.22,49.263,-123.28,49.27)

#base_map


# save the map view
#mapshot(base_map, file = "Map Image Save/base map.png")


# plot the bluephones on the base map
bluephone_map <- leaflet(data = Bluephone_location) %>%
    addTiles() %>%
    fitBounds(-123.22,49.263,-123.28,49.27) %>%
    addMarkers(lng = ~Longitude, 
               lat = ~Latitude, 
               popup = ~Street_Address, label = ~Formal_Name_and_Room)

#bluephone_map


# save the map view
#mapshot(bluephone_map, file = "Map Image Save/bluephone map.png")


# heatmap of bluephone density vs. area
bluephone_heatmap <- addHeatmap(base_map, lng = ~Longitude, lat = ~Latitude,  intensity = 0.1,
    layerId = NULL, group = NULL, minOpacity = 0.05, max = 0.05,
    radius = 20, blur = 25, gradient = NULL, cellSize = 10,
    data = Bluephone_location)

#bluephone_heatmap


# save the map view
#mapshot(bluephone_heatmap, file = "Map Image Save/bluephone heatmap.png")


head(Bluephone_location)


bluephone_lon_lat <- Bluephone_location |>
    select(Longitude, Latitude)


first_bluephone <- Bluephone_location[89, ]
first_bluephone
first_bluephone_lon_lat <- select(first_bluephone, Longitude, Latitude)
first_bluephone_lon_lat
rest_bluephone <- Bluephone_location |>
        filter(Latitude != pull(first_bluephone, Latitude))

Bluephone_distance <- rest_bluephone |>
        group_by(Formal_Name_and_Room, Latitude, Longitude) |>
        summarize(distance = distGeo(first_bluephone_lon_lat, c(Longitude, Latitude))) |>
        arrange(distance) |>
        head(1) |>
        mutate(Bluephone_origin = pull(first_bluephone, Formal_Name_and_Room), 
               origin_Lat = pull(first_bluephone, Latitude), 
               origin_Lon = pull(first_bluephone, Longitude)) |>
        select(Bluephone_origin, origin_Lat, origin_Lon, Formal_Name_and_Room, Latitude, Longitude, distance)

colnames(Bluephone_distance) <- c("Bluephone_origin", "origin_Lat", "origin_Lon", "closest_Bluephone", "closest_lat", "closest_lon", "distance")

Bluephone_distance

`summarise()` has grouped output by 'Formal_Name_and_Room', 'Latitude'. You can
override using the `.groups` argument.


bluephone_closest_distance <- as_tibble(filter(Bluephone_distance, Bluephone_origin == 1))
bluephone_closest_distance


#  iterate to calculate the distances with nearest neighbor
bluephone_closest_distance <- filter(Bluephone_distance, Bluephone_origin == 1)

options(dplyr.summarise.inform = FALSE) #disable dplyr messages in code

for (i in 1:89){
    first_bluephone <- Bluephone_location[i, ]
    first_bluephone_lon_lat <- select(first_bluephone, Longitude, Latitude)
    rest_bluephone <- Bluephone_location |>
        filter(Latitude != pull(first_bluephone, Latitude))
    
    Bluephone_distance <- rest_bluephone |>
        group_by(Formal_Name_and_Room, Latitude, Longitude) |>
        summarize(distance = distGeo(first_bluephone_lon_lat, c(Longitude, Latitude))) |>
        arrange(distance) |>
        head(1) |>
        mutate(Bluephone_origin = pull(first_bluephone, Formal_Name_and_Room), 
               origin_Lat = pull(first_bluephone, Latitude), 
               origin_Lon = pull(first_bluephone, Longitude)) |>
        select(Bluephone_origin, origin_Lat, origin_Lon, Formal_Name_and_Room, Latitude, Longitude, distance)
    
    colnames(Bluephone_distance) <- c("Bluephone_origin", "origin_Lat", "origin_Lon", 
                                      "closest_Bluephone", "closest_lat", "closest_lon", "distance")
    
    bluephone_closest_distance <- bind_rows(bluephone_closest_distance, Bluephone_distance)
}

head(bluephone_closest_distance)


write_csv(bluephone_closest_distance, file = "data/Each Bluephone Distance with Closet.csv")


#rename from the formal name to index
bluephone_closest_distance_renamed <- bluephone_closest_distance |>
    mutate(Bluephone_No = substr(Bluephone_origin, 11, 13)) |>
    mutate(across(Bluephone_No, as.integer)) |>
    select(Bluephone_No, origin_Lat, origin_Lon, closest_Bluephone, closest_lat, closest_lon, distance)

head(bluephone_closest_distance_renamed)


arranged_bluephone_closest_distance <- bluephone_closest_distance_renamed |>
    arrange(desc(distance))
head(arranged_bluephone_closest_distance, n = 15)


# calculate the mean of the distance
distance_mean <- bluephone_closest_distance_renamed |>
    pull(distance) |>
    mean()

cat("The distance between each bluephone and its closet bluephone is", distance_mean, "m.")

The distance between each bluephone and its closet bluephone is 88.23234 m.


# 3d bar pot in the exact coordinates locations
arranged_bluephone_closest_distance_9 <- head(arranged_bluephone_closest_distance, n = 9)

Barplot_3d <- arranged_bluephone_closest_distance_9 |>
    ggplot(aes(origin_Lat, origin_Lon, fill = distance)) +
    geom_tile() +
    scale_fill_fermenter(type = "div", palette = "RdYlBu") +
    xlab("Latitude") + 
    ylab("Longitude") +
    labs(fill = "Distance (m)")

#suppressWarnings(plot_gg(Barplot_3d))


#suppressWarnings(render_movie(filename = "plot.gif"))


#3d bar plot according to the relative location base on coordinates
df.distance <- data.frame(matrix(NA, nrow=9, ncol=4))
names(df.distance) <- c("x", "y", "z", "z.rank")

df.distance$x <- factor(rep(c("X1", "X2", "X3"), times=3), levels=c("X1", "X2", "X3"))
df.distance$y <- factor(rep( paste0("Y", 1:3), each=3), levels=c("Y1", "Y2", "Y3"))
df.distance$z <- pull(arrange(arranged_bluephone_closest_distance_9, Bluephone_No), distance)

df.distance$z.rank <- as.numeric(rank(df.distance$z))

p1. <- cloud(z~x+y, data=df.distance, panel.3d.cloud=panel.3dbars, 
            ylab="Y", xlab="X", zlab="Z",
            xbase=0.2, ybase=0.2, scales=list(arrows=FALSE, col="black", distance=1),
            par.settings = list(axis.line = list(col = "transparent")),
            #screen = list(z = 35, x = -35, y=0),
            alpha.facet = 1.00, border = "transparent",
            zoom=1.00);

print(p1.)


#plot the median distance
options(repr.plot.height = 8, repr.plot.width = 9)
median <- head(arranged_bluephone_closest_distance, n =15) |>
    ungroup(closest_Bluephone, closest_lat) |>
    select(distance) |>
    pull() |>
    median()

median

bluephone_closest_distance_plot <- head(arranged_bluephone_closest_distance, n = 15) |>
    mutate(median_distance = distance - median) |> 
    ggplot(aes(x = c(1:nrow(head(arranged_bluephone_closest_distance, n = 15))), 
               y = median_distance, 
               fill = as_factor(Bluephone_No))) +
    geom_bar(stat = "identity", position = "dodge") +
    labs(x = "Bluephone Number",
         y = "Distance with the nearest neighbor bluephone (m)", 
         fill = "Bluephone Number") +
    ggtitle("The Median distance between each bluephone and its closet one") +
    theme(text = element_text(size = 18))

#bluephone_closest_distance_plot


#find the location of the bluephone such that has the maximum distance with another one
bluephone_distance_max <- bluephone_closest_distance |>
    arrange(desc(distance)) |>
    head(1)

bluephone_distance_max


bluephone_distance_max_location_without_extra <- Bluephone_location |>
    filter(Formal_Name_and_Room %in% c("Blue Phone 26 Jack Bell @ West Mall & University Blvd", 
                                       "Blue Phone 10 Biological Sciences @ Main Mall & University Blvd", 
                                       "Blue Phone 76 West Parkade North Rooftop Level 11",
                                       "Blue Phone 27 West Parkade @ Lower Mall & Pedestrian Path at West Parkade",
                                       "Blue Phone 29 CIRS @ West Mall & Stores Road", 
                                       "Blue Phone 12 Earth & Ocean Sciences @ Stores Road at EOS", 
                                       "Blue Phone 11 Earth Sciences Building @ Main Mall & Stores Road")) 

bluephone_distance_max_location_without_extra


bluephone_distance_max_location_with_extra <- bluephone_distance_max_location_without_extra |>
    bind_rows(tibble(Formal_Name_and_Room = "Extra Blue Phone",
                     Street_Address = "Behind the Earth Science Building",
                     Latitude = 49.26331,
                     Longitude = -123.25323))

bluephone_distance_max_location_with_extra


#scale the heat map of potential area 

bluephone_map_max_distance_without_extra <- leaflet(data = bluephone_distance_max_location_without_extra) |>
    addTiles() |>
    fitBounds(-123.250,49.261,-123.256,49.265) |>
    addHeatmap(lng = ~Longitude, lat = ~Latitude,  intensity = 0.1,
    layerId = NULL, group = NULL, minOpacity = 0.05, max = 0.08,
    radius = 60, blur = 70, gradient = NULL, cellSize = 10,
    data = bluephone_distance_max_location_without_extra) |>
    addScaleBar()

#bluephone_map_max_distance_without_extra


# plot the bluephones' comparison between connection and isolation
bluephone_map_connection_without_extra <- leaflet(data = bluephone_distance_max_location_without_extra) |>
    addTiles() |>
    fitBounds(-123.250,49.261,-123.256,49.265) |>
    addMarkers(lng = ~Longitude, 
               lat = ~Latitude, 
               popup = ~Street_Address,
               label = ~Formal_Name_and_Room) |>
    addMarkers(data = bluephone_distance_max_location_without_extra,
               lng = ~Longitude, 
               lat = ~Latitude,
               popup = ~Formal_Name_and_Room,
               label = ~Formal_Name_and_Room) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[1,],
                               bluephone_distance_max_location_without_extra[2,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[2,],
                               bluephone_distance_max_location_without_extra[3,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[3,],
                               bluephone_distance_max_location_without_extra[6,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[6,],
                               bluephone_distance_max_location_without_extra[5,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[5,],
                               bluephone_distance_max_location_without_extra[7,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[7,],
                               bluephone_distance_max_location_without_extra[4,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_without_extra[4,],
                               bluephone_distance_max_location_without_extra[1,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addScaleBar()

#bluephone_map_connection_without_extra


# heat map with extra bluephone we put
bluephone_heatmap_area_with_extra <- addHeatmap(bluephone_map_max_distance_without_extra, 
                                                lng = ~Longitude, lat = ~Latitude,  intensity = 0.1,
                                                layerId = NULL, group = NULL, minOpacity = 0.05, max = 0.08,
                                                radius = 60, blur = 70, gradient = NULL, cellSize = 10,
                                                data = bluephone_distance_max_location_with_extra) |>
    addMarkers(data = bluephone_distance_max_location_with_extra,
               lng = ~Longitude, 
               lat = ~Latitude,
               popup = ~Formal_Name_and_Room,
               label = ~Formal_Name_and_Room)

#bluephone_heatmap_area_with_extra


# connections with extra bluephone we put

bluephone_map_connection_with_extra <- leaflet(data = bluephone_distance_max_location_with_extra) |>
    addTiles() |>
    fitBounds(-123.250,49.261,-123.256,49.265) |>
    addMarkers(lng = ~Longitude, 
               lat = ~Latitude, 
               popup = ~Street_Address,
               label = ~Formal_Name_and_Room) |>
    addMarkers(data = bluephone_distance_max_location_with_extra,
               lng = ~Longitude, 
               lat = ~Latitude,
               popup = ~Formal_Name_and_Room,
               label = ~Formal_Name_and_Room) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[1,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[2,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[3,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[4,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[5,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[6,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addPolylines(data = bind_rows(bluephone_distance_max_location_with_extra[8,],
                               bluephone_distance_max_location_with_extra[7,]), 
                 lng = ~Longitude, lat = ~Latitude) |>
    addScaleBar()

#bluephone_map_connection_with_extra

Formal_Name_and_Room	Street_Address	Latitude	Longitude
<chr>	<chr>	<dbl>	<dbl>
Blue Phone 01 ANSOC @ Northwest Marine Drive	6303 N W MARINE DR at ANSOC Building	49.26973	-123.2572
Blue Phone 03 Flagpole Plaza @ Main Mall & Crescent Road	Main Mall & Crescent Road	49.26894	-123.2566
Blue Phone 04 Wyman Plaza @ Main Mall & Memorial Road	Main Mall & Memorial Road	49.26777	-123.2550
Blue Phone 05 Ponderosa F @ Lower Mall & Pedestrian Path	2008 LOWER MALL Ponderosa Annex F	49.26497	-123.2575
Blue Phone 06 Ponderosa A @ West Mall & Agricultural Road	2011 WEST MALL Ponderosa Annex A	49.26534	-123.2562
Blue Phone 07 Hennings @ East Mall & Agricultural Road	6224 AGRICULTURAL RD/EAST MALL Hennings Bldg	49.26697	-123.2518

Formal_Name_and_Room	Street_Address	Latitude	Longitude
<chr>	<chr>	<dbl>	<dbl>
Blue Phone 01 ANSOC @ Northwest Marine Drive	6303 N W MARINE DR at ANSOC Building	49.26973	-123.2572
Blue Phone 03 Flagpole Plaza @ Main Mall & Crescent Road	Main Mall & Crescent Road	49.26894	-123.2566
Blue Phone 04 Wyman Plaza @ Main Mall & Memorial Road	Main Mall & Memorial Road	49.26777	-123.2550
Blue Phone 05 Ponderosa F @ Lower Mall & Pedestrian Path	2008 LOWER MALL Ponderosa Annex F	49.26497	-123.2575
Blue Phone 06 Ponderosa A @ West Mall & Agricultural Road	2011 WEST MALL Ponderosa Annex A	49.26534	-123.2562
Blue Phone 07 Hennings @ East Mall & Agricultural Road	6224 AGRICULTURAL RD/EAST MALL Hennings Bldg	49.26697	-123.2518

Formal_Name_and_Room	Street_Address	Latitude	Longitude
<chr>	<chr>	<dbl>	<dbl>
Blue Phone 01 ANSOC @ Northwest Marine Drive	6303 N W MARINE DR at ANSOC Building	49.26973	-123.2572
Blue Phone 03 Flagpole Plaza @ Main Mall & Crescent Road	Main Mall & Crescent Road	49.26894	-123.2566
Blue Phone 04 Wyman Plaza @ Main Mall & Memorial Road	Main Mall & Memorial Road	49.26777	-123.2550
Blue Phone 05 Ponderosa F @ Lower Mall & Pedestrian Path	2008 LOWER MALL Ponderosa Annex F	49.26497	-123.2575
Blue Phone 06 Ponderosa A @ West Mall & Agricultural Road	2011 WEST MALL Ponderosa Annex A	49.26534	-123.2562
Blue Phone 07 Hennings @ East Mall & Agricultural Road	6224 AGRICULTURAL RD/EAST MALL Hennings Bldg	49.26697	-123.2518

Formal_Name_and_Room	Street_Address	Latitude	Longitude
<chr>	<chr>	<dbl>	<dbl>
Blue Phone 89	Saltwater Octopus House	49.27075	-123.248

Longitude	Latitude
<dbl>	<dbl>
-123.248	49.27075

After we install a extra bluephone¶

After we install a extra bluephone¶

Bluephone_No	origin_Lat	origin_Lon	closest_Bluephone	closest_lat	closest_lon	distance
<int>	<dbl>	<dbl>	<chr>	<dbl>	<dbl>	<dbl>
1	49.26973	-123.2572	Blue Phone 62 Rose Garden Parkade Elevator Level 5	49.26945	-123.2566	55.42414
3	49.26894	-123.2566	Blue Phone 62 Rose Garden Parkade Elevator Level 5	49.26945	-123.2566	56.72429
4	49.26777	-123.2550	Blue Phone 03 Flagpole Plaza @ Main Mall & Crescent Road	49.26894	-123.2566	171.26136
5	49.26497	-123.2575	Blue Phone 48 Fraser River Parkade South West Level 1	49.26568	-123.2583	94.76914
6	49.26534	-123.2562	Blue Phone 05 Ponderosa F @ Lower Mall & Pedestrian Path	49.26497	-123.2575	103.17813
7	49.26697	-123.2518	Blue Phone 41 Thunderbird Park pedestrian pathway near Soccer Centre	49.26753	-123.2527	87.78280

A grouped_df: 15 × 7
Bluephone_No	origin_Lat	origin_Lon	closest_Bluephone	closest_lat	closest_lon	distance
<int>	<dbl>	<dbl>	<chr>	<dbl>	<dbl>	<dbl>
17	49.25758	-123.2467	Blue Phone 16 Old Barn Community Centre @ Main Mall & Thunderbird Blvd	49.25932	-123.2481	220.0795
30	49.25846	-123.2507	Blue Phone 16 Old Barn Community Centre @ Main Mall & Thunderbird Blvd	49.25932	-123.2481	206.8730
77	49.26246	-123.2388	Blue Phone 78 Osoyoos Crescent & Oyama Court	49.26072	-123.2382	198.3806
31	49.26008	-123.2456	Blue Phone 33 Pulp & Paper @ East Mall & Argonomy Road	49.26143	-123.2471	185.6423
4	49.26777	-123.2550	Blue Phone 03 Flagpole Plaza @ Main Mall & Crescent Road	49.26894	-123.2566	171.2614
16	49.25932	-123.2481	Blue Phone 14 MacMillan @ Main Mall & Agronomy Rd	49.26053	-123.2495	168.3631
21	49.26616	-123.2537	Blue Phone 07 Hennings @ East Mall & Agricultural Road	49.26697	-123.2518	164.4280
22	49.26948	-123.2544	Blue Phone 62 Rose Garden Parkade Elevator Level 5	49.26945	-123.2566	156.5045
10	49.26471	-123.2523	Blue Phone 20 Chemistry Physics @ East Mall & University Blvd.	49.26575	-123.2508	155.5971
80	49.25967	-123.2352	Blue Phone 79 Point Grey Apartments	49.25961	-123.2373	149.3701
2	49.26789	-123.2583	Blue Phone 23 Fraser River Parkade @ Memorial Rd at Fraser River Parkade	49.26658	-123.2578	149.3273
20	49.26575	-123.2508	Blue Phone 81 University Blvd Lot Stairs 1	49.26659	-123.2493	148.7244
26	49.26421	-123.2549	Blue Phone 25 St. John's @ Lower Mall & University Blvd.	49.26331	-123.2563	143.3557
78	49.26072	-123.2382	Blue Phone 79 Point Grey Apartments	49.25961	-123.2373	140.7909
79	49.25961	-123.2373	Blue Phone 78 Osoyoos Crescent & Oyama Court	49.26072	-123.2382	140.7909