### APES Atlas Web Scraper
# The following R code extracts data from the standardized APES Atlas tables across all, or a selection of, ape range regions.
# The functions below need to first be loaded into R.
install.packages("rvest")
install.packages("dplyr")
install.packages("httr")
library(rvest)
library(dplyr)
library(httr)
root_url <- "https://wiki.iucnapesportal.org"
main_page <- read_html(root_url)
# 1. Functions to get urls
get_all_site_urls <- function(root_url,region_sel){
all_urls <- vector()
regions <- get_region_urls(main_page)
regionss=matrix(unlist(strsplit(regions,split="/")),ncol=3,byrow=T)[,3]
if(sum(region_sel%in%"all")>0){
regions=regions
print("All regions are selected.")
}else{
regions=regions[regionss%in%region_sel]
print(paste(region_sel, " is selected.", sep=""))
}
for(region in regions){
country_urls <- get_country_urls(root_url, region)
for(country in country_urls){
site_urls <- get_site_urls(root_url, country)
all_urls <- c(all_urls, site_urls)
}
}
closeAllConnections()
all_urls
}
get_region_urls <- function(main_page){
region_links <- main_page %>%
html_nodes('.body')
region_links[7] %>%
html_nodes('a') %>%
html_attr('href')
}
get_country_urls <- function(root_url, region_url){
region_page <- tryCatch(content(GET(paste(root_url, region_url, sep = ""))), error=function(e) FALSE)
if(length(region_page) > 1){
region_page %>%
html_nodes('.mw-parser-output li a') %>%
html_attr('href')
}
}
get_site_urls <- function(root_url, country_url){
country_page <- tryCatch(content(GET(paste(root_url, country_url, sep = ""))), error=function(e) FALSE)
if(length(country_page) > 1){
country_page %>%
html_nodes('.mw-parser-output li a') %>%
html_attr('href')
}
}
# 2. Get location data
get_region_country_and_site <- function(site_page){
location_data <- site_page %>%
html_nodes('.mw-parser-output') %>%
html_text()
xx=gsub("\n"," > ",location_data,fixed=T)
unlist(strsplit(xx,split=" > "))[1:3]
}
# 3. Basic site information
get_site_characteristics <- function(site_page){
basic_information_table <- site_page %>%
html_nodes(".Site_characteristics-table") %>%
html_table(fill = FALSE)
if(length(basic_information_table) > 0){
as.data.frame(basic_information_table[[1]])[0:6, 2]
}
}
# 4. Switch columns
switch_columns <- function(data_table){
data_table[c((ncol(data_table)-2):ncol(data_table), 1:(ncol(data_table)-3))]
}
get_table <- function(site_page, selector, main_table, location_data, ncolx=0){
table_data <- site_page %>%
html_nodes(selector) %>%
html_table(fill = FALSE) %>%
as.data.frame()
if(length(table_data) > 0){
table_data <- table_data %>%
mutate_all(as.character)
colnames(table_data) <- colnames(main_table)[1:(ncol(main_table)-3)]
table_data$Region <- location_data[1]
table_data$Country <- location_data[2]
table_data$Site <- location_data[3]
table_data
} else {
print(paste(location_data[3], selector, "table not added"), sep = "")
NA
}
}
# 5. Main function to get data (uses the functions above)
get_all_site_tables <- function(root_url, region_sel, tables_sel){
all_site_urls <- sort(get_all_site_urls(root_url,region_sel))
xx=grepl("index.php/",all_site_urls)
all_site_urls=all_site_urls[xx]
xx=grepl("(Fran%C3%A7ais)",all_site_urls)
all_site_urls=all_site_urls[!xx]
logtable <- data.frame(
link=paste(root_url, all_site_urls, sep = ""),
sitetype=rep("",length(all_site_urls))
)
if(sum(tables_sel%in%"site_characteristics_table")>0){
site_characteristics_table <- data.frame(
Region=character(),
Country=character(),
Site=character(),
Species=character(),
Area=character(),
Coordinates=character(),
'Type of site'=character(),
'Habitat types'=character(),
'Type of governance'=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"ape_status_table")>0){
ape_status_table_apes <- data.frame(
Species=character(),
Year=character(),
Occurrence=character(),
'Encounter or vistation rate (nests/km; ind/day)'=character(),
'Density estimate [ind./ km²] (95% CI)'=character(),
'Abundance estimate (95% CI)'=character(),
'Survey area'=character(),
'Sampling method'=character(),
'Analytical framework'=character(),
Source=character(),
Comments=character(),
'A.P.E.S. database ID'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
ape_status_table_gibbon <- data.frame(
Species=character(),
Year=character(),
'Total number groups (95% CI)'=character(),
'Density [groups/km²] (95% CI)'=character(),
'Total number indiv. (95% CI)'=character(),
Area=character(),
Method=character(),
Source=character(),
Comments=character(),
'A.P.E.S. database ID'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"threats_table")>0){
threats_table <- data.frame(
Category=character(),
'Specific threats'=character(),
'Threat level'=character(),
Description=character(),
'Year of threat'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"conservation_activities_table")>0){
conservation_activities_table <- data.frame(
Category=character(),
'Specific activity'=character(),
Description=character(),
'Implementing organization(s)'=character(),
'Year of activity'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"challenges_table")>0){
challenges_table <- data.frame(
Challenges=character(),
'Specific challenges'=character(),
Source=character(),
'Year(s)'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"enablers_table")>0){
enablers_table <- data.frame(
Enablers=character(),
'Specific enablers'=character(),
Source=character(),
'Year(s)'=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
if(sum(tables_sel%in%"behaviours_table")>0){
behaviours_table <- data.frame(
Category=character(),
Behavior=character(),
'Observation type'=character(),
Prevalece=character(),
'Observation date'=character(),
Source=character(),
Habituation=character(),
Species=character(),
Comment=character(),
Region=character(),
Country=character(),
Site=character(),
check.names=FALSE,
stringsAsFactors=FALSE)
}
for(i in 1:length(all_site_urls)){
site_page <- tryCatch(content(GET(paste(root_url, all_site_urls[i], sep = ""))), error=function(e) FALSE)
if(length(site_page) < 2){
logtable$sitetype[i]="no page"
print(paste(i, "of", length(all_site_urls), " ", "no page", all_site_urls[i], sep = " "))
}else{
location_data <- get_region_country_and_site(site_page)
if(is.na(location_data[1])){
logtable$sitetype[i]="link to construction page"
print(paste(i, "of", length(all_site_urls), " ", "link to construction page", all_site_urls[i], sep = " "))
}else{
if(location_data[1]=="Region"){
logtable$sitetype[i]="link to empty content page"
print(paste(i, "of", length(all_site_urls), " ", "link to empty content page", all_site_urls[i], sep = " "))
}else{
logtable$sitetype[i]="link to filled content page"
print(paste(i, "of", length(all_site_urls), " ", "link to filled content page", all_site_urls[i], sep = " "))
site_characteristics <- unlist(get_site_characteristics(site_page))
site_species=site_characteristics[1]
gibbonsite=ifelse(sum(unlist(lapply(c("Gorilla","Pan paniscus","Pan troglodytes","Pongo"),function(x){grepl(x,site_species)})))==0,TRUE,FALSE)
if(length(site_characteristics) > 1){
if(sum(tables_sel%in%"site_characteristics_table")>0){
site_characteristics_table[nrow(site_characteristics_table) + 1, ] <- c(location_data, site_characteristics)
}
} else {
print(paste(location_data[3], "site_characteristics table not added"))
}
if(sum(tables_sel%in%"ape_status_table")>0){
if(gibbonsite){
xx=get_table(site_page, '.Ape_status-table', ape_status_table_gibbon, location_data, ncol=10)
if(is.data.frame(xx)){ape_status_table_gibbon <- rbind(ape_status_table_gibbon, xx)}
switch_columns(ape_status_table_gibbon)
}else{
xx=get_table(site_page, '.Ape_status-table', ape_status_table_apes, location_data, ncol=10)
if(is.data.frame(xx)){ape_status_table_apes <- rbind(ape_status_table_apes, xx)}
switch_columns(ape_status_table_apes)
}
}
if(sum(tables_sel%in%"threats_table")>0){
xx=get_table(site_page, '.Threats-table', threats_table, location_data, ncol=5)
if(is.data.frame(xx)){threats_table <- rbind(threats_table, xx)}
switch_columns(threats_table)
}
if(sum(tables_sel%in%"conservation_activities_table")>0){
xx=get_table(site_page, '.Conservation_activities-table', conservation_activities_table, location_data, ncol=0)
if(is.data.frame(xx)){conservation_activities_table <- rbind(conservation_activities_table, xx)}
switch_columns(conservation_activities_table)
}
if(sum(tables_sel%in%"behaviours_table")>0){
xx=get_table(site_page, '.behaviours-table', behaviours_table, location_data, ncol=0)
if(is.data.frame(xx)){behaviours_table <- rbind(behaviours_table, xx)}
switch_columns(behaviours_table)
}
if(sum(tables_sel%in%"challenges_table")>0){
xx=get_table(site_page, '.Challenges-table', challenges_table, location_data, ncol=0)
if(is.data.frame(xx)){challenges_table <- rbind(challenges_table, xx)}
switch_columns(challenges_table)
}
if(sum(tables_sel%in%"enablers_table")>0){
xx=get_table(site_page, '.enabler-table', enablers_table, location_data, ncol=0)
if(is.data.frame(xx)){enablers_table <- rbind(enablers_table, xx)}
switch_columns(enablers_table)
}
}
}
}
closeAllConnections()
}
# IF YOU WANT TWO TABLES UNCOMMENT THE NEXT LINE AND COMMENT THE AFTER NEXT LINE
# if(sum(tables_sel%in%"ape_status_table")>0){tables_sel=c(tables_sel[!tables_sel%in%"ape_status_table"],c("ape_status_table_apes","ape_status_table_gibbon"))}
if(sum(tables_sel%in%"ape_status_table")>0){ape_status_table=bind_rows(ape_status_table_apes,ape_status_table_gibbon)}
tablesreturn=c("logtable",tables_sel)
xx=lapply(tablesreturn,function(x){get(x)})
names(xx)=tablesreturn
return(xx)
}
# After loading the functions, select the regions and tables that you need to extract data from.
# 1. REGIONS
# Please define 'region_sel'; it could have the following values:
# "all" = all regions would be read
# or one or a combination of: "West_Africa","Central_Africa","East_Africa","Asia"
# E.g., region_sel=c("East_Africa", "Asia")
# 2. TABLES
# Please define 'tables_sel' from the following options:
# a combination of: "site_characteristics_table","threats_table","conservation_activities_table","behaviours_table"
# e.g.
region_sel="all"
tables_sel=c("site_characteristics_table","ape_status_table","threats_table","conservation_activities_table","behaviours_table","challenges_table","enablers_table")#
# region_sel="West_Africa"
# tables_sel=c("site_characteristics_table")
# Creates "all_tables", which is a list with one entry for each table
all_tables <- get_all_site_tables(root_url, region_sel, tables_sel)
# The output is a list of dataframes, corresponding to the tables
str(all_tables)
