Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
code and link to data for mapping spatial patterns in conservation research
# mapping conservation research
#load libraries
library(geosphere)
library(dplyr)
library(StandardizeText)
library(ggmap)
library(maps)
library(rvest)
library(rworldmap)
library(RColorBrewer)
library(geoR)
#read raw data
abstractsRaw <- read.csv("https://raw.githubusercontent.com/luisDVA/codeluis/master/abstracts.csv",stringsAsFactors = FALSE)
# manual fix for some country names, and standardize to Penn World Tables names
abstracts <- abstractsRaw %>%
filter(mappable=="Yes") %>% select(authorCountry,studyCountry) %>%
mutate_each(funs(gsub("USA","United States",.))) %>%
mutate_each(funs(gsub("UK","United Kingdom",.))) %>%
mutate_each(funs(standardize.countrynames(standard = "pwt", suggest="prompt",.)))
# create table for plotting connections
connections <- abstracts %>% filter(authorCountry!=studyCountry)
# expanding multiple connections
absMult <- abstractsRaw %>%
filter(multipleConns=="Yes") %>%
select(authorCountry,studyCountry)
# make new DF with additional connections from multi-study area papers
y<-strsplit(as.character(absMult$studyCountry) , ", ", fixed=TRUE)
moreConnections <- data.frame(authorCountry = rep(absMult$authorCountry, sapply(y, length)),studyCountry= unlist(y)) %>%
mutate_each(funs(gsub("USA","United States",.))) %>%
mutate_each(funs(gsub("UK","United Kingdom",.))) %>%
mutate_each(funs(standardize.countrynames(standard = "pwt", suggest="prompt",.)))
# merge both DFs
connections <- bind_rows(connections,moreConnections)
# tally in-country research
localRes <- abstracts %>% filter(authorCountry==studyCountry) %>%
count(authorCountry)
#Scrape capital cities table from web
countriesTab <- html("http://geographyfieldwork.com/WorldCapitalCities.htm")
#get names and capitals
cap_table <- countriesTab %>%
html_node(".sortable") %>%
html_table(., fill = T) %>%
rename(Capital=`Capital City`)
# capital cities to geocode
capAC <- merge(connections,cap_table,by.x="authorCountry",by.y="Country",all.x=T)
capSC <- merge(capAC,cap_table,by.x="studyCountry",by.y="Country",all.x=T)
capitalsC <- select(capSC,authLoc=Capital.x,studLoc=Capital.y)
# geocode and jitter author locations
coordsAuthLoc <- mutate_geocode(capitalsC,authLoc,output="latlon",source="google")%>%
select(authLoc,studLoc,latAut=lat,lonAut=lon)
coordsAuthLoc[,3:4] <- jitterDupCoords(coordsAuthLoc[,3:4],max=0.7)
# geocode and jitter study locations
coordsAuthStudLoc <- mutate_geocode(coordsAuthLoc,studLoc,output="latlon",source="google") %>%
select(authLoc,studLoc,latAut,lonAut,latStud=lat,lonStud=lon)
coordsAuthStudLoc[,5:6] <- jitterDupCoords(coordsAuthStudLoc[,5:6],max=0.7)
#join "local research" table to a coarse resolution map
localresearch <- joinCountryData2Map(localRes, joinCode="NAME", nameJoinColumn="authorCountry")
#create a map-shaped window
mapDevice('x11')
#plot
par(bg="grey15")
mapParameters <- mapCountryData(localresearch, nameColumnToPlot="n", catMethod="fixedWidth",
borderCol="grey11", oceanCol="grey15",missingCountryCol = "grey8",addLegend = F,
mapTitle = "Conservation research",
colourPalette = c("#3182BD", "#00004d"))
do.call(addMapLegend,c(mapParameters,legendWidth = 0.5))
# Great circle lines to connect points
for (i in 1:length(coordsAuthStudLoc$lonAut)) {
inter <- gcIntermediate(c(coordsAuthStudLoc$lonAut[i], coordsAuthStudLoc$latAut[i]), c(coordsAuthStudLoc$lonStud[i], coordsAuthStudLoc$latStud[i]), n=500, addStartEnd=TRUE, breakAtDateLine=TRUE)
if (length(inter) > 2) {
lines(inter,col="white",lwd=0.5)
} else {
lines(inter[[1]],col="white",lwd=0.5)
lines(inter[[2]],col="white",lwd=0.5)
}
}
#overlay points
points(coordsAuthStudLoc$lonAut,coordsAuthStudLoc$latAut, pch=16, cex=0.8, col="orange")
points(coordsAuthStudLoc$lonStud,coordsAuthStudLoc$latStud, pch=16, cex=0.8, col="blue")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment