knitr::opts_chunk$set(echo = TRUE)
library(shiny)
library(leaflet)
library(htmlwidgets)
library(tidyverse)
library(htmltools)
library(rsconnect)
library(leaflet.extras)
library(stringr)

Load the Spatial Dataframe

hlink <- 'http://www.econworks.co/uploads/9/6/1/6/96165748/02_countries_spdf.rds' 
spatial_data <- read_rds(gzcon(url(hlink)))

Trim down the initial Spatial Dataframe

The initial file contains the country coordinates in the form of polygon objects. However, there is also economic data such as GDP, population, etc which is not relevant to this particular case. Hence, I will trim it. Afterwards, we will filter it to leave only the countries of interest and insert our own data (studen count per country).

## Load the PDF file with the OR students
pdf <- pdftools::pdf_text(choose.files())
country_names <- spatial_data@data[["name"]]
country_names <- gsub(pattern = "United States", replacement = "USA", 
                      x = country_names)

country_index <- str_count(pdf, pattern = country_names)

spatial_data@data[['number']] <- c(0)  
## Loading required package: sp
spatial_data@data[["number"]] <- country_index

## Extract only the countries with more than 0 students
#student_countries <- country_names[country_index > 0 ]
student_data <- spatial_data[spatial_data$number > 0, ]
  
## Find the total number of students in the program
num_students <- sum(country_index)

## Create a bin for each unique number of students ;
### The labels need to be located after the '% share' computation has been performed
country_vector <- country_index[country_index > 0]
bins = sort(unique(country_vector))
  
  
pal <- colorFactor("YlOrRd", domain = student_data$number, reverse = FALSE)
  
  
country_shares <- paste0(round(100*(student_data$number/num_students), digits = 0), "%")
  
## Use C formatting for the data display
labels <- sprintf(
    "<strong>%s</strong><br/># Students: %g <br/> Share: %s",
    student_data$name, student_data$number, country_shares) %>% lapply(HTML)
  
#############################################################
## Get the share of students from each category
#############################################################
table(country_vector)
## country_vector
##  1  2  3  5 22 
## 13  2  1  1  1
## Manual way () just for reference)
group1_frequency <- table(country_vector == 1)[2][[1]]
group2_frequency <- table(country_vector == 2)[2][[1]]
  
freqs <- list()
groups_frequency <- for(i in c(1, 2, 3, 5, 22)){ 
                        freqs[i] <- table(country_vector == i)[2][[1]]}
  
## The freqs variable contains the frequency of each group. Now we need to unlist it
freqs <- unlist(freqs)
(group_shares <- round(100*(bins * freqs)/num_students, digits = 0))
## [1] 28  9  6 11 47
### Create labels for the group share via a loop
groups_num <- length(group_shares) ## there are 5 groups

## Initialize an empty vector of length equal to the number of elements in vector groups_num (5)
groups <- vector(length = groups_num)
  
   for (i  in seq_along(1:groups_num)) {
      
   groups[i] <- c(paste0(" : (Group Share: ", group_shares[i], "%)"))
    
  }

Set up the Map

This is actually the fun part. We start by setting a sizingPolicy to define the dimensions of our map. However, in this case the map will be rendered in a R MarkDown via knitr, so we need to set knitr.figure=TRUE to adopt the sizing of the MarkDown. Outside of MarkDown you won’t need it, but in this case there would be a sizing conflict between knitr and leaflet and the script will print an error.

### Create a custom framework for the leaflet map
  newPolicy <- sizingPolicy(defaultWidth = '100%', defaultHeight = 600, 
                            padding = 5, knitr.figure = TRUE)
  
  
  student_data %>%
    leaflet(sizingPolicy = newPolicy)  %>% 
    addProviderTiles("CartoDB.DarkMatter", 
                     options = providerTileOptions(minZoom = 1, maxZoom = 10 
                     ))  %>% 
    
    ## Position the market at the geolocation of Edinburgh, UK
    addMarkers(lng = -3.1883, lat = 55.9533, label = ~"Edinburgh",
               labelOptions = labelOptions(textsize = "14px") ) %>%
    setView(lng = -3.1883, lat = 40, zoom = 2) %>%
    addPolygons(
      fillColor = ~pal(number),
      weight = 2,
      opacity = 1,
      color = "white",
      dashArray = "3",
      fillOpacity = 0.7,
      highlight = highlightOptions(
        weight = 5,
        color = "#666",
        dashArray = "",
        fillOpacity = 0.7,
        bringToFront = TRUE),
      label = labels,
      labelOptions = labelOptions(
        style = list("font-weight" = "normal", padding = "2px 6px"),
        textsize = "15px",
        direction = "auto")) %>%
    addLegend(pal = pal, values = ~number, opacity = 0.99, 
              title = paste0("# OR Students: ", num_students), 
              labFormat = labelFormat(suffix = groups),
              position = "bottomright")