World Heritage Sites in Danger

If any issues, questions or suggestions feel free to reach me out via e-mail wieczynskipawel@gmail.com or Linkedin. You can also visit my Github.

if(!require(pacman)) install.packages('pacman')
pacman::p_load(XML, httr, maps, stringr, dplyr, ggplot2)

This case study originates from the book “Automated Data Collection with R: A Practical Guide to Web Scraping and Text Mining”, written by Munzert, Rubba, Meißner, Nyhuis, published by Wiley in 2015.

As an excercise I try to recreate case study from that book, but with the tidyverse approach to data wrangling and ggplot2 data vizualization. Results may differ since I recreate the results in February 2022 with updated dataset.

Moreover, I explore few more things which in the book were left as an excercise to the reader, i.e. countries with most endangered sites and places which were endangered in the past but now aren’t endangered

Endangered sites (results presented in the book, but recreated with dplyr and ggplot2)

## Get data from the web ##
url <- GET('http://en.wikipedia.org/wiki/List_of_World_Heritage_in_Danger')
tables <- readHTMLTable(rawToChar(url$content)
                        ,stringsAsFactors = FALSE)

## Select 2nd table and get rid of headers from 1st row and select columns ##
dangerTable <- tables[[2]] %>%
  .[-1, c(1,3,4,6,7)]

## Add custom headers ##
colnames(dangerTable) <- c('name'
                           ,'location'
                           ,'criteria'
                           ,'yearInscribed'
                           ,'yearEndangered')

## Some features wrangling ##
dangerTable <- dangerTable %>%
  mutate(criteria = if_else(str_detect(criteria
                                       ,'Natural')
                            ,'Natural'
                            ,'Cultural')) %>%
  mutate(yearInscribed = as.numeric(yearInscribed)) %>%
  mutate(yearEndangered = str_extract_all(yearEndangered
                                          ,pattern = '[0-9]{4}–$') %>%
           unlist() %>%
           str_replace(pattern = '–'
                       ,replacement = '') %>%
           as.numeric()) %>%
## Extracting coordinates ##
  mutate(xCoords = str_extract(location
                               ,pattern = '[;][ -]*[0-9]*[.]*[0-9]*') %>%
           str_sub(start = 3
                   ,end = -1) %>%
           as.numeric() %>%
           round(2)) %>%
  mutate(yCoords = str_extract(location
                              ,pattern = '[/][ -]*[0-9]*[.]*[0-9]*[;]') %>%
           str_sub(start = 3
                   ,end = -2) %>%
           as.numeric() %>%
           round(2))

## World map of endangered places ##
world <- map_data('world')
ggplot() +
  geom_map(data = world
           ,map = world
           ,aes(long
                ,lat
                ,map_id = region)
           ,color = 'white'
           ,fill = 'lightgray') +
  geom_point(data = dangerTable
             ,aes(xCoords
                  ,yCoords
                  ,shape = criteria)
             ,color = 'red'
             ,size = 2.5) +
  scale_shape_manual(values = c(16,17)) +
  labs(title = 'Endangered places in February 2022') +
  theme_void()

## Distribution of years when places become endangered ##
ggplot(dangerTable) +
  geom_histogram(aes(x = yearEndangered)
                 ,binwidth = 5
                 ,color = 'black'
                 ,fill = 'white') +
  scale_x_continuous(breaks = seq(1980, 2025, by = 5)) +
  labs(x = ''
       ,y = ''
       ,title = 'Year when site was put on the list of endangered sites')

## Years it took to become an endangered site ##
dangerTable <- dangerTable %>%
  mutate(duration = yearEndangered - yearInscribed)

ggplot(dangerTable) +
  geom_histogram(aes(x = duration)
                 ,binwidth = 5
                 ,color = 'black'
                 ,fill = 'white') +
  scale_x_continuous(breaks = seq(0, 35, by = 5)) +
  labs(x = ''
       ,y = ''
       ,title = 'Years it took to become an endangered site')

Which countries has the most endangered sites?

Join with map_world from ggplot2 seems not working here, so I use map.where from maps package, but still we obtain few NA’s which probably should have been checked manually at google maps or other similar services.

dangerTable <- dangerTable %>%
  mutate(country = map.where(x = xCoords
                             ,y = yCoords))

countPerCountry <- dangerTable %>%
  group_by(country) %>%
  summarize(count = n())

ggplot(na.omit(countPerCountry)) +
  geom_col(aes(x = reorder(country, count)
               ,y = count)) +
  coord_flip() +
  labs(x = ''
      , y = '')

Sites endangered in the past and comparison with the currently endangered sites

## Select 4th table and get rid of headers from 1st row and select columns ##
prevDangerTable <- tables[[4]] %>%
  .[-1, c(1,3,4,6,7)]

## Add custom headers ##
colnames(prevDangerTable) <- colnames(dangerTable)[1:5]

## Some features wrangling ##
prevDangerTable <- prevDangerTable %>%
  mutate(criteria = if_else(str_detect(criteria
                                       ,'Natural')
                            ,'Natural'
                            ,'Cultural')) %>%
  mutate(yearInscribed = as.numeric(yearInscribed)) %>%
  mutate(endangerStarted = str_extract_all(yearEndangered
                                           ,pattern = '^[0-9]{4}') %>%
           unlist() %>%
           as.numeric()) %>%
  mutate(endangerEnded = str_extract_all(yearEndangered #tak naprawde endanger ended
                                          ,pattern = '[0-9]{4}$') %>%
           unlist() %>%
           as.numeric()) %>%
## Extracting coordinates and countries##
  mutate(xCoords = str_extract(location
                               ,pattern = '[;][ -]*[0-9]*[.]*[0-9]*') %>%
           str_sub(start = 3
                   ,end = -1) %>%
           as.numeric() %>%
           round(2)) %>%
  mutate(yCoords = str_extract(location
                               ,pattern = '[/][ -]*[0-9]*[.]*[0-9]*[;]') %>%
           str_sub(start = 3
                   ,end = -2) %>%
           as.numeric() %>%
           round(2)) %>%
  mutate(country = map.where(x = xCoords
                             ,y = yCoords))

## How much sites disappeared from the list ##
ggplot(prevDangerTable) +
  geom_histogram(aes(endangerEnded)
                 ,binwidth = 5
                 ,color = 'black'
                 ,fill = 'white') +
  scale_x_continuous(breaks = seq(1980, 2025, by = 5)) +
  labs(x = ''
       ,y = ''
       ,title = 'Effectivenes of World Heritage Committee')

## Average endagerment time ##
prevDangerTable <- prevDangerTable %>%
  mutate(endangerDuration = endangerEnded - endangerStarted)

ggplot(prevDangerTable) +
  geom_histogram(aes(endangerDuration)
                 ,binwidth = 5
                 ,color = 'black'
                 ,fill = 'white') +
  scale_x_continuous(breaks = seq(0, 25, by = 5)) +
  labs(x = ''
       ,y = ''
       ,title = 'Endanger duration') +
  annotate('text'
           ,x = 20
           ,y = 10
           ,label = paste0('Average duration \n'
             ,round(mean(prevDangerTable$endangerDuration), 2)
             ,' years')
           ,size = 6)

#### COMPARISON OF CURRENT AND PREVIOUS ENDANGERED PLACES ####
## Merge tables ##
allPlaces <- bind_rows(
  dangerTable %>%
    mutate(endangered = 'Yes')
  ,prevDangerTable %>%
    mutate(endangered = 'No') %>%
    select(-yearEndangered)
)

## World map #$
ggplot() +
  geom_map(data = world
           ,map = world
           ,aes(long
                ,lat
                ,map_id = region)
           ,color = 'white'
           ,fill = 'lightgray') +
  geom_point(data = allPlaces
             ,aes(xCoords
                  ,yCoords
                  ,shape = criteria
                  ,color = endangered)
             ,size = 2.5) +
  scale_shape_manual(values = c(17, 19)) +
  scale_color_manual(values = c('darkgreen', 'red')) +
  labs(title = 'Endangered and previously endangered places in February 2022') +
  theme_void()