1. Get list of urban areas

res <- GET(
  "https://api.teleport.org/api/urban_areas"
)

urban_areas <- res$content %>%
    rawToChar() %>%
    fromJSON()
urban_areas <- urban_areas[['_links']][['ua:item']]

head(urban_areas)
##                                                         href        name
## 1      https://api.teleport.org/api/urban_areas/slug:aarhus/      Aarhus
## 2    https://api.teleport.org/api/urban_areas/slug:adelaide/    Adelaide
## 3 https://api.teleport.org/api/urban_areas/slug:albuquerque/ Albuquerque
## 4      https://api.teleport.org/api/urban_areas/slug:almaty/      Almaty
## 5   https://api.teleport.org/api/urban_areas/slug:amsterdam/   Amsterdam
## 6   https://api.teleport.org/api/urban_areas/slug:anchorage/   Anchorage

Get quality of life and cost of living scores for each area

get_ua_scores <- function(href, name) {
  res <- GET(paste(href, 'scores/', sep = ''))
  
  scores <- res$content %>%
    rawToChar() %>%
    fromJSON()
  scores = scores[['categories']]
  
  scores = scores %>%
    select(name, score_out_of_10) %>%
    pivot_wider(names_from = name, values_from = score_out_of_10)
  scores['name'] = name
  scores
}

for (i in 1:nrow(urban_areas)) {
  href = urban_areas$href[i]
  name = urban_areas$name[i]
  if (i == 1) {
    out <- get_ua_scores(href, name)
  } else {
    out <- rbind(out, get_ua_scores(href, name))
  }
}

head(out)
## # A tibble: 6 x 18
##   Housing `Cost of Living` Startups `Venture Capita… `Travel Connect… Commute
##     <dbl>            <dbl>    <dbl>            <dbl>            <dbl>   <dbl>
## 1    6.13             4.02     2.83             2.51             3.54    6.31
## 2    6.31             4.69     3.14             2.64             1.78    5.34
## 3    7.26             6.06     3.77             1.49             1.46    5.06
## 4    9.28             9.33     2.46             0                4.59    5.87
## 5    3.05             3.82     7.97             6.11             8.32    6.12
## 6    5.43             3.14     2.79             0                1.74    4.72
## # … with 12 more variables: `Business Freedom` <dbl>, Safety <dbl>,
## #   Healthcare <dbl>, Education <dbl>, `Environmental Quality` <dbl>,
## #   Economy <dbl>, Taxation <dbl>, `Internet Access` <dbl>, `Leisure &
## #   Culture` <dbl>, Tolerance <dbl>, Outdoors <dbl>, name <chr>

Get latitude and longitude of each urban area

get_ua_location <- function(ua) {
  ua = ua %>%
    tolower %>%
    str_replace(',','') %>%
    str_split(' ')
  ua = paste(ua[[1]], collapse = '-')
    
  href = paste(
    "https://api.teleport.org/api/urban_areas/slug:",
    ua,
    "/", sep = ''
  )
  res <- GET(href)
  dat <- res$content %>%
      rawToChar() %>%
      fromJSON()
  
  if (
      !('http_status_code' %in% names(dat))
    ) {
    res2 <- GET(
      dat[['_links']][['ua:primary-cities']]$href[1],    
      query=list('location'='nearest-urban-areas')
    )
    dat2 <- res2$content %>%
        rawToChar() %>%
        fromJSON()
    
    return(dat2$location$latlon)
  } else {
    return(list('latitude' = NA, 'longitude' = NA))
  }
}

latitude <- c()
longitude <- c()
for (i in 1:nrow(out)){
  ua = out$name[i]
  latlon <- get_ua_location(ua)
  latitude <- c(latitude, latlon$latitude)
  longitude <- c(longitude, latlon$longitude)
}

out$latitude = latitude
out$longitude = longitude

head(out)
## # A tibble: 6 x 20
##   Housing `Cost of Living` Startups `Venture Capita… `Travel Connect… Commute
##     <dbl>            <dbl>    <dbl>            <dbl>            <dbl>   <dbl>
## 1    6.13             4.02     2.83             2.51             3.54    6.31
## 2    6.31             4.69     3.14             2.64             1.78    5.34
## 3    7.26             6.06     3.77             1.49             1.46    5.06
## 4    9.28             9.33     2.46             0                4.59    5.87
## 5    3.05             3.82     7.97             6.11             8.32    6.12
## 6    5.43             3.14     2.79             0                1.74    4.72
## # … with 14 more variables: `Business Freedom` <dbl>, Safety <dbl>,
## #   Healthcare <dbl>, Education <dbl>, `Environmental Quality` <dbl>,
## #   Economy <dbl>, Taxation <dbl>, `Internet Access` <dbl>, `Leisure &
## #   Culture` <dbl>, Tolerance <dbl>, Outdoors <dbl>, name <chr>,
## #   latitude <dbl>, longitude <dbl>

Map

COL_summary <- out$`Cost of Living` %>% summary()
out2 <- out %>% 
  mutate(
    COL = `Cost of Living`,
    COL_binned = case_when(
      COL < COL_summary['1st Qu.'] ~ 'bad',
      (COL > COL_summary['1st Qu.']) & (COL < COL_summary['3rd Qu.'])  ~ 'med',
      COL > COL_summary['3rd Qu.'] ~ 'good'
    ),
    summary = paste(
      "<p style='font-weight: bold;'>", name, "</p>",
      "<p>Commute Score:", Commute, "</p>",
      "<p>Safety Score:", Safety, "</p>",
      "<p>Education Score:", Education, "</p>",
      "<p>Healthcare Score:", Healthcare, "</p>",
      "<p>Environmental Quality Score:", `Environmental Quality`, "</p>",
      "<p>Leisure & Culture Score:", `Leisure & Culture`, "</p>",
      "<p>Tolerance Score:", Tolerance, "</p>"
    )
  )

table(out2$COL_binned)
## 
##  bad good  med 
##   66   67  131
icons_list <- iconList(
  good = makeIcon(
    "https://lh3.googleusercontent.com/proxy/5yK1xJ5uM9Ixk-7VgmSUGjMsgR5BZXUNF3vhxGOsg7O-_qWyaF0I-DiN01s-VCZpkKozCIo78SBlC5_wdS6GDnQ7xocPKCorqvJQhF4ua1fPs-lmKgcm",
    iconWidth = 10, 
    iconHeight = 10
  ), # green
                       
  bad = makeIcon(
    "https://upload.wikimedia.org/wikipedia/commons/thumb/9/92/Location_dot_red.svg/1024px-Location_dot_red.svg.png",
    iconWidth = 10, 
    iconHeight = 10
  ), # red
                       
  med = makeIcon(
    "https://upload.wikimedia.org/wikipedia/commons/thumb/5/59/Location_dot_yellow.svg/1024px-Location_dot_yellow.svg.png",
    iconWidth = 10, 
    iconHeight = 10
  ) # yellow
)

out2  <- out2 %>%
  filter(
    !is.na(latitude),
    !is.na(longitude)
  ) %>%
  data.frame()
rr <- tags$div(
   HTML('<h4>Cost of Living in Urban Areas</h4>')
 )

pal <- colorFactor(c("red","yellow","green"), c('Bad','Okay','Good'))

leaflet(out2) %>%
  addTiles() %>%
  addMarkers(
    lat = ~latitude,
    lng = ~longitude,
    label = ~name,
    icon = ~icons_list[COL_binned],
    popup = ~summary
  ) %>%
  addLegend(
    "bottomright",
    pal = pal,
    values = c('Bad','Okay','Good'),
    opacity = 0.7,
    position = "bottomright",
    title = ''
  ) %>%
  addControl(rr, position = "topright")