|
|
| (31 intermediate revisions by the same user not shown) |
| Line 1: |
Line 1: |
| <pre> | | <pre> |
|
| |
|
| ### APES Atlas Web Scraper | | ################# 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 following R code extracts data from the standardized APES Atlas tables. |
| # The functions below need to first be loaded into R. | | # To execute the code, you need to have R installed and an editor (e.g. R Studio or Notepad++). |
|
| |
|
| install.packages("rvest")
| | # INSTRUCTIONS |
| install.packages("dplyr")
| | # 1. Copy the lines below from # SCRIPT START to # SCRIPT END and paste them into your editor. |
| install.packages("httr")
| | # 2. In the last line, replace "path_to_save" with the folder path name where you want to store the scraped data (use only '/' or '\\' as folder separator). For example, replace path_to_save with "D:/users/my_docs/APESATLAS/" |
| library(rvest)
| |
| library(dplyr)
| |
| library(httr)
| |
|
| |
|
| root_url <- "https://wiki.iucnapesportal.org"
| | # 3. Run the lines in R. |
| main_page <- read_html(root_url)
| | # Note: Windows may open during the installation of the packages. Confirm all with ‘OK’. |
| | # It will take about 30 seconds for the tables to be scraped and saved into the folder specified in path_to_save . |
|
| |
|
| # 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){
| | # SCRIPT START |
| region_links <- main_page %>%
| | #---------------------------------------------------------------------------------- |
| html_nodes('.body')
| | # Install & load packages |
| region_links[7] %>%
| | #---------------------------------------------------------------------------------- |
| html_nodes('a') %>%
| | install.packages("plyr") |
| html_attr('href')
| | install.packages("writexl") |
| }
| | install.packages("data.table") |
| | | install.packages("httr2") |
| get_country_urls <- function(root_url, region_url){
| | library(httr2) |
| region_page <- tryCatch(content(GET(paste(root_url, region_url, sep = ""))), error=function(e) FALSE)
| | library(data.table) |
| if(length(region_page) > 1){
| | library(writexl) |
| region_page %>%
| | library(plyr) |
| html_nodes('.mw-parser-output li a') %>%
| | #---------------------------------------------------------------------------------- |
| html_attr('href')
| | # Load functions from Github |
| }
| | #---------------------------------------------------------------------------------- |
| }
| | source("https://github.com/lakik/apesatlas_scraping/raw/refs/heads/main/script") |
| | | #---------------------------------------------------------------------------------- |
| get_site_urls <- function(root_url, country_url){
| | # Run scraper function |
| country_page <- tryCatch(content(GET(paste(root_url, country_url, sep = ""))), error=function(e) FALSE)
| | #---------------------------------------------------------------------------------- |
| if(length(country_page) > 1){
| | scrape_apesatlas(path_to_save) |
| country_page %>%
| | #---------------------------------------------------------------------------------- |
| html_nodes('.mw-parser-output li a') %>%
| | # SCRIPT END |
| 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)
| |
| | |
| </pre>
| |
