Pasted

add_loca_name <- function(dt, geo, coords = FALSE){
    yn <- names(dt)
    cols <- c('type', 'location_id', 'name')
    if(coords) cols <- c(cols, 'x_lon', 'y_lat')
    y <- read_fst(file.path(geouk_path, 'locations'), columns = cols, as.data.table = TRUE)
    y <- y[type == geo][, type := NULL]
    cols <- c('id', geo)
    if(coords) cols <- c(cols,  paste0(geo, c('x', 'y')))
    setnames(y, cols)
    dt <- y[dt, on = c(id = geo)][, id := NULL]
    setcolorder(dt, yn)
    dt
}
 
 
# List of palettes to be used with ColourBrewer package:  
palette.lst <- list(
    'SEQUENTIAL' = c( # ordinal data where (usually) low is less important and high is more important
        'Blues' = 'Blues', 'Blue-Green' = 'BuGn', 'Blue-Purple' = 'BuPu', 'Green-Blue' = 'GnBu', 'Greens' = 'Greens', 'Greys' = 'Greys',
        'Oranges' = 'Oranges', 'Orange-Red' = 'OrRd', 'Purple-Blue' = 'PuBu', 'Purple-Blue-Green' = 'PuBuGn', 'Purple-Red' = 'PuRd', 'Purples' = 'Purples',
        'Red-Purple' = 'RdPu', 'Reds' = 'Reds', 'Yellow-Green' = 'YlGn', 'Yellow-Green-Blue' = 'YlGnBu', 'Yellow-Orange-Brown' = 'YlOrBr',
        'Yellow-Orange-Red' = 'YlOrRd'
    ), 
    'DIVERGING' = c(  # ordinal data where both low and high are important (i.e. deviation from some reference "average" point)
        'Brown-Blue-Green' = 'BrBG', 'Pink-Blue-Green' = 'PiYG', 'Purple-Red-Green' = 'PRGn', 'Orange-Purple' = 'PuOr', 'Red-Blue' = 'RdBu', 'Red-Grey' = 'RdGy',
        'Red-Yellow-Blue' = 'RdYlBu', 'Red-Yellow-Green' = 'RdYlGn', 'Spectral' = 'Spectral'
    ),  
    'QUALITATIVE' = c(  # categorical/nominal data where there is no logical order
        'Accent' = 'Accent', 'Dark2' = 'Dark2', 'Paired' = 'Paired', 'Pastel1' = 'Pastel1', 'Pastel2' = 'Pastel2',
        'Set1' = 'Set1', 'Set2' = 'Set2', 'Set3' = 'Set3'
    )
)
 
tiles.lst <- c(
    'OSM Mapnik' = 'OpenStreetMap.Mapnik', 
    'OSM B&W' = 'OpenStreetMap.BlackAndWhite', 
    'Stamen Toner' = 'Stamen.Toner', 
    'Stamen Toner Lite' = 'Stamen.TonerLite', 
    'Wikimedia' = 'Wikimedia', 
    'Hydda Full' = 'Hydda.Full', 
    'Hydda Base' = 'Hydda.Base'
)
marker_colours <- c(
    'red', 'darkred', 'orange', 'pink', 'beige', 'green', 'darkgreen', 'lightgreen', 
    'blue', 'lightblue', 'purple', 'cadetblue', 'white', 'lightgray', 'gray', 'black'
)
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)
)
 
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()
for(idx in 1:length(tiles.lst)) 
    mp <- mp %>% addProviderTiles(providers[[tiles.lst[idx]]], group = names(tiles.lst)[idx])
 
 
# list of options for charts
point.shapes <- c('circle' = 21, 'square' = 22, 'diamond' = 23, 'triangle up' = 24, 'triangle down' = 25)
line.types <- c('dashed', 'dotted', 'solid', 'dotdash', 'longdash', 'twodash')
face.types <- c('plain', 'bold', 'italic', 'bold.italic')
val.lbl.pos <- list(
    'Inside'  = list('Vertical' = c(0.5,  1.5), 'Horizontal' = c( 1.2, 0.2) ),
    'Outside' = list('Vertical' = c(0.4, -0.3), 'Horizontal' = c(-0.2, 0.2) )
)
 
lbl.format <- function(y, type, is.pct = FALSE){
    if(type == 1){ 
        format(y, big.mark = ',', nsmall = 0)
    } else if(type == 2){ 
        if(is.pct){ 
            paste0(format(round(100 * y, 2), nsmall = 2), '%')
        } else { 
            format(y, big.mark = ',', nsmall = 0)
        }    
    } else {
        format(y, nsmall = 2)
    }
}
 
class.methods <- c(
#    'Fixed' = 'fixed',                  # need an additional argument fixedBreaks that lists the n+1 values to be used
    'Equal Intervals' = 'equal',        # the range of the variable is divided into n part of equal space
    'Quantiles' = 'quantile',           # each class contains (more or less) the same amount of values
    'Pretty Integers' = 'pretty',       # sequence of about ‘n+1’ equally spaced ‘round’ values which cover the range of the values in ‘x’. The values are chosen so that they are 1, 2 or 5 times a power of 10.
#    'Natural Breaks' = 'jenks',         # seeks to reduce the variance within classes and maximize the variance between classes
    'Hierarchical Cluster' = 'hclust',  # Cluster with short distance
    'K-means Cluster' = 'kmeans'        # Cluster with low variance and similar size
)
 
# list of maptiles as background for maps
tiles.lst <- as.list(mpt[, provider])
names(tiles.lst) <- mpt[, name]
 
 
 
 
# return correct spacing for axis labels rotation
lbl.plt.rotation = function(angle, position = 'x'){
    positions = list(x = 0, y = 90, top = 180, right = 270)
    rads  = (angle - positions[[ position ]]) * pi / 180
    hjust = 0.5 * (1 - sin(rads))
    vjust = 0.5 * (1 + cos(rads))
    element_text(angle = angle, vjust = vjust, hjust = hjust)
}
 
# global style for ggplot charts
my.ggtheme <- function(g, 
                       xaxis.draw = FALSE, yaxis.draw = FALSE, axis.draw = FALSE, ticks.draw = FALSE, axis.colour = 'black', axis.size = 0.1,
                       hgrid.draw = FALSE, vgrid.draw = FALSE, grids.colour = 'black', grids.size = 0.1, grids.type = 'dotted',
                       labels.rotation = c(45, 0), labels.rotate = FALSE, 
                       bkg.colour = 'white', font.size = 6, ttl.font.size.mult = 1.2, ttl.face = 'bold',
                       legend.pos = 'bottom', plot.border = FALSE, font.family = 'Arial'
){
    g <- g + theme(
        text             = element_text(family = font.family),
        plot.title       = element_text(hjust = 0, size = rel(1.2) ),  # hjust: 0-left, 0.5-center, 1-right
        plot.background  = element_blank(),
        plot.margin      = unit(c(1, 0.5, 0, 0.5), 'lines'),  # space around the plot as in: TOP, RIGHT, BOTTOM, RIGHT
        plot.caption     = element_text(size = 8, face = 'italic'),
        axis.line        = element_blank(),
        axis.ticks       = element_blank(),
        axis.text        = element_text(size = font.size, color = axis.colour),
        axis.text.x      = element_text(angle = labels.rotation[1], hjust = 1), # vjust = 0.5),
        axis.text.y      = element_text(angle = labels.rotation[2]), # , hjust = , vjust = ),
        axis.title       = element_text(size = font.size * (1 + ttl.font.size.mult), face = ttl.face),
        axis.title.x     = element_text(vjust = -0.3), 
        axis.title.y     = element_text(vjust = 0.8, margin = margin(0, 10, 0, 0) ),
        legend.text      = element_text(size = 6),
        legend.title     = element_text(size = 8), 
        legend.title.align = 1,
        legend.position  = legend.pos,
        legend.background = element_blank(), 
        legend.spacing   = unit(0, 'cm'),
        #                legend.key = element_blank(), 
        legend.key.size  = unit(0.2, 'cm'),
        legend.key.height = unit(0.4, 'cm'),      
        legend.key.width = unit(1, 'cm'),
        panel.background = element_rect(fill = bkg.colour, colour = bkg.colour), 
        panel.border     = element_blank(),
        panel.grid       = element_blank(),
        panel.spacing.x  = unit(3, 'lines'),
        panel.spacing.y  = unit(2, 'lines'),
        strip.text       = element_text(hjust = 0.5, size = font.size * (1 + ttl.font.size.mult), face = ttl.face),
        strip.background = element_blank()
    )
    if(plot.border) g <- g + theme( panel.border = element_rect(colour = axis.colour, size = axis.size, fill = NA) )
    if(axis.draw){
        g <- g + theme( axis.line = element_line(color = axis.colour, size = axis.size ) )
    } else {
        if(xaxis.draw) g <- g + theme( axis.line.x = element_line(color = axis.colour, size = axis.size ) )
        if(yaxis.draw) g <- g + theme( axis.line.y = element_line(color = axis.colour, size = axis.size ) )
    }
    if(ticks.draw)  g <- g + theme( axis.ticks = element_line(color = axis.colour, size = axis.size ) )
    if(hgrid.draw & vgrid.draw){
        g <- g + theme( panel.grid.major = element_line(colour = grids.colour, size = grids.size, linetype = grids.type ) )
    } else{
        if(vgrid.draw) g <- g + theme( panel.grid.major.x = element_line(colour = grids.colour, size = grids.size, linetype = grids.type ) ) 
        if(hgrid.draw) g <- g + theme( panel.grid.major.y = element_line(colour = grids.colour, size = grids.size, linetype = grids.type ) )
    }
    if(labels.rotate){
        g <- g + theme( axis.text.x = element_text(hjust = 1, angle = 45 ) )
    }
    return(g)
}
 
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
}
 
 
 
lcn.tpe <- c('Postcode [Bounding Box]' = 'PCU', 'Postcode Sector ' = 'PCS', 'Postcode District' = 'PCD', 'Post Town' = 'PCT', 'Ward' = 'WARD', 'Parish' = 'PAR')
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' 
)
 
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
}
 
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, ...))
}
 
get_postcodes_map <- function(id
                              
    ){
        lcn <- read_fst(file.path(geouk_path, 'locations'), as.data.table = TRUE)
        tpe <- lcn[location_id == id, as.character(type)]
        if(!tpe %in% c('PCS', 'PCD', 'PCT', 'WARD', 'PAR')) stop('Sorry, location type not implemented.')
        tiles.lst <- c(
            'OSM Mapnik' = 'OpenStreetMap.Mapnik', 
            'OSM B&W' = 'OpenStreetMap.BlackAndWhite', 
            'Stamen Toner' = 'Stamen.Toner', 
            'Stamen Toner Lite' = 'Stamen.TonerLite'
        )
        mp <- leaflet(options = leafletOptions(minZoom = 6)) %>% 
            enableTileCaching() %>%
            addSearchOSM() %>%
            addResetMapButton() %>%
            addFullscreenControl()
        for(idx in 1:length(tiles.lst)) 
            mp <- mp %>% addProviderTiles(providers[[tiles.lst[idx]]], group = names(tiles.lst)[idx])
        
        y <- readRDS(file.path(bnduk_path, 'postcodes', 'ch', id))
        grps <- c('Concave Hull', 'Output Areas', 'Postcodes (active)', 'Postcodes (terminated)')
        mp <- mp %>% 
            addPolygons(
                data = y,
                group = grps[1]
            )
        
        y <- readRDS(file.path(bnduk_path, 'postcodes', 'oa', id))
        mp <- mp %>% 
            addPolygons(
                data = y, 
                group = grps[2],
                color = 'green'
            )
        
        cid <- c(NA, id)
        switch(tpe,
            'PCS' = { fname <- 'pcds' },        
            'PCD' = { 
                fname <- 'pcds'
                cid <- id
            },        
            'PCT' = { fname <- 'pcat' },        
            'WARD' = { fname <- 'ladw' },        
            'PAR' = { fname <- 'ladp' }      
        )
        y <- read_fst_idx2(
                file.path(geouk_path, paste0('postcodes_', fname)), 
                cid, 
                c('postcode', 'is_active', 'x_lon', 'y_lat')
        )
        mp <- mp %>% 
            addCircles(
                data = y[is_active == 1],
                lng = ~x_lon, lat = ~y_lat,
                group = grps[3],
                radius = 5,
                weight = 1,
                color = 'darkgreen',
                opacity = 1,
                fillColor = 'green',
                fillOpacity = 0.5,
                label = ~postcode
            )
        if(nrow(y[is_active == 0]) > 0){
            mp <- mp %>% 
                addCircles(
                    data = y[is_active == 0],
                    lng = ~x_lon, lat = ~y_lat,
                    group = grps[4],
                    radius = 5,
                    weight = 1,
                    color = 'darkred',
                    opacity = 1,
                    fillColor = 'red',
                    fillOpacity = 0.5,
                    label = ~postcode
                )
        } else { grps <- grps[1:3] }
        
        mp <- mp %>% 
            addLayersControl( 
                baseGroups = names(tiles.lst), 
                overlayGroups = grps,
                options = layersControlOptions(collapsed = FALSE) 
            )
        
        # mp <- mp %>% 
            
 
        # mp <- mp %>% 
        #   addLegendFixedCustom(
        #         colors = c('orange', 'lightblue'),
        #         labels = c('Big Chains', 'Other Shops'),
        #       opacity = 1,
        #         title = '',
        #         position = 'bottomright',
        #   )
        
        mp
}