-
Notifications
You must be signed in to change notification settings - Fork 0
/
global.R
116 lines (101 loc) · 4.34 KB
/
global.R
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
#####################################
# Shiny App * UK Eat Out - global.R #
#####################################
pkgs <- c('popiFun', 'Cairo', 'data.table', 'DT', 'fst', 'htmltools', 'leaflet', 'leaflet.extras', 'shiny', 'shinycssloaders', 'shinyWidgets')
lapply(pkgs, require, char = TRUE)
options(spinner.color = '#e5001a', spinner.size = 1, spinner.type = 4)
options(bitmapType = 'cairo', shiny.usecairo = TRUE)
source('functions.R')
dts <- read_fst(file.path(app_path, 'uk_eatout', 'dataset'), as.data.table = TRUE)
pc <- read_fst(file.path(geouk_path, 'postcodes'), columns = c('postcode', 'x_lon', 'y_lat'), as.data.table = TRUE)
pco <- read_fst(file.path(geouk_path, 'PCD_PCS_ord'), as.data.table = TRUE)
lcn.tpe <- c('Postcode [Bounding Box]' = 'PCU', 'Postcode Sector ' = 'PCS', 'Postcode District' = 'PCD', 'Post Town' = 'PCT', 'Ward' = 'WARD')
rgns.lst <- list(
'England' = c(
'East Midlands', 'East of England', 'London',
'North East', 'North West', 'South East', 'South West', 'West Midlands', 'Yorkshire and The Humber'
),
'Northern Ireland', 'Scotland', 'Wales'
)
lbl.options <- labelOptions(
nohide = TRUE,
textsize = '12px',
direction = 'right',
sticky = FALSE,
opacity = 0.8,
offset = c(10, -10),
style = list(
'color' = 'black',
'border-color' = 'rgba(0,0,0,0.5)',
'font-family' = 'verdana',
'font-style' = 'normal',
'font-size' = '14px',
'font-weight' = 'normal',
'padding' = '2px 6px',
'box-shadow' = '3px 3px rgba(0,0,0,0.25)'
)
)
addLegendFixedCustom <- function(map, colors, labels, sizes = 20, opacity = 0.5, radius = 50, ...){
colorAdditions <- paste0(colors, ';margin-top:4px;margin-bottom:4px;border-radius:', radius, '%;width:', sizes, 'px;height:', sizes, 'px')
labelAdditions <- paste0(
'<div style=display:inline-block;height:', sizes, 'px;margin-top:4px;margin-bottom:4px;line-height:', sizes, 'px;>',
labels,
'</div>'
)
return(addLegend(map, colors = colorAdditions, labels = labelAdditions, opacity = opacity, ...))
}
mp <- leaflet(options = leafletOptions(minZoom = 6)) %>%
setView(lat = 54.003419, lng = -2.547973, zoom = 6) %>%
enableTileCaching() %>%
# addTiles(options = tileOptions(useCache = TRUE, crossOrigin = TRUE)) %>%
addSearchOSM() %>%
addResetMapButton() %>%
addFullscreenControl()
tiles.lst <- c(
'OSM Mapnik' = 'OpenStreetMap.Mapnik',
'OSM B&W' = 'OpenStreetMap.BlackAndWhite',
'Stamen Toner' = 'Stamen.Toner',
'Stamen Toner Lite' = 'Stamen.TonerLite'
)
for(idx in 1:length(tiles.lst))
mp <- mp %>% addProviderTiles(providers[[tiles.lst[idx]]], group = names(tiles.lst)[idx])
mp <- mp %>%
addLayersControl( baseGroups = names(tiles.lst), options = layersControlOptions(collapsed = FALSE) ) %>%
addLegendFixedCustom(
colors = c('orange', 'lightblue'),
labels = c('Big Chains', 'Other Shops'),
opacity = 1,
title = '',
position = 'bottomright',
)
markers <- iconList(
red = makeIcon(file.path(pub_path, 'images', 'icons', 'leaflet', 'markers', 'sm-orange.png'), iconWidth = 24, iconHeight =32),
blue = makeIcon(file.path(pub_path, 'images', 'icons', 'leaflet', 'markers', 'sm-lightblue.png'), iconWidth = 24, iconHeight =32)
)
bounding_box <- function(lat, lon, dist, in.miles = TRUE) {
if (in.miles) {
ang_rad <- function(miles) miles/3958.756
} else {
ang_rad <- function(miles) miles/1000
}
`%+/-%` <- function(x, margin){x + c(-1, +1)*margin}
deg2rad <- function(x) x/(180/pi)
rad2deg <- function(x) x*(180/pi)
lat_range <- function(latr, r) rad2deg(latr %+/-% r)
lon_range <- function(lonr, dlon) rad2deg(lonr %+/-% dlon)
r <- ang_rad(dist)
latr <- deg2rad(lat)
lonr <- deg2rad(lon)
dlon <- asin(sin(r)/cos(latr))
m <- matrix(c(lon_range(lonr = lonr, dlon = dlon), lat_range(latr=latr, r=r)), nrow=2, byrow = TRUE)
dimnames(m) <- list(c("lng", "lat"), c("min", "max"))
m
}
build_list_loca <- function(x, tpe, cname = NA){
yl <- read_fst_idx(file.path(geouk_path, 'locations'), tpe)
if(is.na(cname)) cname <- tpe
yl <- yl[x, on = c(location_id = cname)][, .(id = location_id, name)][order(name)]
y <- as.list(yl$id)
names(y) <- yl$name
y
}