londontime

On this page

• Table
  • Map
• Crosstalk Data

References:

Dashboards: Using R to create actionable science - 2  Dynamic: Quarto docs (tbep-tech.github.io)

Geocoding via Python - pandas - Python generate lat/long points from address - Stack Overflow

library(crosstalk)
library(leaflet)

Warning: package 'leaflet' was built under R version 4.3.3

library(leaflet.extras) #for geoloc

Warning: package 'leaflet.extras' was built under R version 4.3.3

library(DT)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(readxl)
library(tidyr)
library(reticulate)

Warning: package 'reticulate' was built under R version 4.3.3

.chart-wrapper {
  overflow-x: scroll;
}

## import location data
dt_loc <- read_excel('data/locations.xlsx', col_names = TRUE, trim_ws=TRUE) %>%  drop_na(Address)
dt_loc$Address <- paste0(dt_loc$Address, ", London, England")

#The crosstalk package can incorporate additional dynamic functionality in a Quarto document. As the name implies, it allows linking between plots and tables by including embedded Javascript in the rendered HTML file. This allows functionality that looks interactive as in a Shiny application, but does not require Shiny Server.

#Because all data must be loaded into the browser, Crosstalk is not appropriate for large data sets. (There’s no hard limit, since HTML widgets require varying amounts of CPU cycles and memory for each data point.

Table

dt_loc%>% 
  DT::datatable(
    filter = "top",  # allows filtering on each column
    extensions = c(
      "Buttons",  # add download buttons, etc
      'FixedColumns'
      #"Scroller"  # for scrolling down the rows rather than pagination
    ),
    rownames = FALSE,  # remove rownames
    style = "bootstrap",
    class = "compact",
    width = "100%",
    options = list(
      dom = "Blrtip",  # specify content (search box, etc)
      deferRender = TRUE,
      pageLength = 10,
      scrollX = TRUE, #locks header row
      scrollY = 500,
      fixedColumns = list(leftColumns = 1), #lock column
      fixedHeader = TRUE, #lock header
      buttons = list(
        I("colvis"),  # turn columns on and off
        "csv",  # download as .csv
        "excel"  # download as .xlsx
      )
    )
  )

Before using python

You have to discover the path to your the .exe python file and then specify it in the .Renviron file. - Sys.setenv(RETICULATE_PYTHON = “C:\ProgramData\Anaconda3”)

• Sys.setenv(RETICULATE_PYTHON = "C:/Users/hoja/AppData/Local/anaconda3")

Sys.setenv(RETICULATE_PYTHON = "C:/Users/hoja/AppData/Local/anaconda3")

• library(reticulate)
• repl_python()

import pandas as pd
from geopy.geocoders import Nominatim #had to pip install this first

#Using Nominatim with the default user_agent is strongly discouraged, as it violates Nominatim’s Usage Policy https://operations.osmfoundation.org/policies/nominatim/ and may possibly cause 403 and 429 HTTP errors. Please make sure to specify a custom user_agent with Nominatim(user_agent="my-application")
geolocator = Nominatim(user_agent="myApp")

dt_loc_py = r.dt_loc #import df from R to Py https://nrennie.rbind.io/blog/combining-r-and-python-with-reticulate-and-quarto/

#claims to have no attribute latitude
# dt_loc_py[['location_lat', 'location_long']] = dt_loc_py['Address'].apply(geolocator.geocode).apply(lambda x: pd.Series([x.latitude, x.longitude], index=['location_lat', 'location_long']))

# dt_loc_py[['location']] = dt_loc_py['Address'].apply(geolocator.geocode) # this doesn't work unless all addresses can be found - number will mismatch

#this works
# geolocator.geocode(dt_loc_py['Address'][1])
# geolocator.geocode(dt_loc_py['Address'][1]).latitude

lat = []
longi = []
location = []

for places in dt_loc_py['Address']:
  location.append(geolocator.geocode(places, timeout=100)) #, timeout=100
  lat.append(location[len(location)-1].latitude)
  longi.append(location[len(location)-1].longitude)

#match back to df
dt_loc_py['lat'] = lat
dt_loc_py['longi'] = longi

Map

Current legend: colour by category, dark inner dot = open late Todo
1. add open-by-day layer control - completed 2. add hours by pop up
3. Crosstalk with table - completed
4. layer tube station

dt_loc_py<-py$dt_loc_py#[-1]#drop last column coz it's a mess
dt_loc_py<-dt_loc_py %>% 
  rename(lng = longi)
dt_loc_py$Category<-as.factor(dt_loc_py$Category)
# Create a palette that maps factor levels to colors
# pal <- colorFactor(c("pink", "turquoise", "blue",  "green","purple", "orange", "gray", "black"), domain = c("Food", "Sight","Sight, Food", "Shop, sight","Shop", "Activity", "Base", "NA"))
pal<-colorFactor("Dark2", dt_loc_py$Category) #use colourBrewer

map_geo<-dt_loc_py %>% 
  leaflet::leaflet() %>%
  leaflet::addProviderTiles(providers$OpenStreetMap.HOT)%>% #Thunderforest.Transport is better but not loadiing...api key needed?
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Saturday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Saturday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Sunday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Sunday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Monday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Monday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Tuesday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Tuesday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Wednesday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Wednesday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Thursday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Thursday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(dt_loc_py, !is.na(Friday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Friday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addLegend(pal = pal, values = ~Category, position = "bottomleft") %>%
  addLayersControl(overlayGroups = c("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday"),
                   options = layersControlOptions(collapsed = FALSE))

#add night
map_geo <- map_geo %>% 
  addMarkers(data = subset(dt_loc_py, !is.na(Late)),
                    lng = ~lng, lat = ~lat,
                    icon = ~icons('data/moon-outline.svg',iconWidth = 15, iconHeight = 15),
                    popup = ~Late)
#add geoloc
map_geo <- map_geo %>% 
  addControlGPS(
  options = gpsOptions(
    position = "topleft",
    activate = TRUE, 
    autoCenter = TRUE,
    setView = TRUE))

#activateGPS(map_geo)

#https://rpubs.com/mattdray/basic-leaflet-maps

  # leaflet::addLayersControl(
  #   overlayGroups = c("Outstanding", "Good", "Other"),  # add these layers
  #   options = layersControlOptions(collapsed = FALSE)  # expand on hover?
  # ) %>% 
  # hideGroup(c("Good", "Other"))  # turn these off by default
  #  
  #leaflet::addAwesomeMarkers

sd <- SharedData$new(dt_loc_py)
# use shared data with crosstalk widgets

tbl_loc <- sd %>% 
  DT::datatable(
    filter = "top",  # allows filtering on each column
    extensions = c(
      "Buttons",  # add download buttons, etc
      'FixedColumns'
      #"Scroller"  # for scrolling down the rows rather than pagination
    ),
    rownames = FALSE,  # remove rownames
    style = "bootstrap",
    class = "compact",
    width = "100%",
    options = list(
      dom = "Blrtip",  # specify content (search box, etc)
      deferRender = TRUE,
      pageLength = 10,
      scrollX = TRUE, #locks header row
      scrollY = 500,
      fixedColumns = list(leftColumns = 1), #lock column
      fixedHeader = TRUE, #lock header
      buttons = list(
        I("colvis"),  # turn columns on and off
        "csv",  # download as .csv
        "excel"  # download as .xlsx
      )
    )
  )

map <- leaflet(sd) %>% #, width = "100%", height = 350) %>% 
  addProviderTiles(providers$OpenStreetMap.HOT)%>%
  addMarkers(data = subset(sd$data(), !is.na(Late)),
                    lng = ~lng, lat = ~lat,
                    icon = ~icons('data/moon-outline.svg',iconWidth = 9, iconHeight = 9),
                    popup = ~Late) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Saturday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Saturday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category))  %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Sunday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Sunday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Monday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Monday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Tuesday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Tuesday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Wednesday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Wednesday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Thursday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Thursday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addCircleMarkers(data = subset(sd$data(), !is.na(Friday)),
                   lng = ~lng, lat = ~lat, 
                   group = "Friday",
                   popup = ~Place,
                   radius = 9,
                   color = ~pal(Category)) %>% 
  addLegend(pal = pal, values = ~Category, position = "bottomleft") %>%
  addLayersControl(overlayGroups = c("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday"),
                   options = layersControlOptions(collapsed = FALSE)) 

# 12 is the maximum number of columns in crosstalk::bscols(). This means that you can put every widget on next row just by specifying widths = 12 for the previous one. 

Crosstalk Data

bscols(widths = c(12, 12), map, tbl_loc)

Warning in bscols(widths = c(12, 12), map, tbl_loc): Sum of bscol width units
is greater than 12

library(plotly)

Loading required package: ggplot2

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

dt_loc_py <-dt_loc_py %>%
  select(Place, Category, Monday:Sunday) %>% 
  pivot_longer(!Place:Category, names_to = "Open", values_to = "Tally") %>% 
  drop_na(Tally)

# set the factor order however you want
dt_loc_py$Open <- factor(dt_loc_py$Open,
                   levels = c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"))
dt_loc_py %>% 
  plot_ly(x = ~Open, color = ~Category, colors = "Set1")

No trace type specified:
  Based on info supplied, a 'histogram' trace seems appropriate.
  Read more about this trace type -> https://plotly.com/r/reference/#histogram