1### translate ISO 3166-1 alpha-2 codes to country names 2### default result is a character vector of same length, which may contain regular expressions 3iso.expand <- function(a,regex=TRUE){ 4 if (!exists("iso3166")) iso3166 <- maps::iso3166 5 AA <- toupper(a) 6 if (all(nchar(a)==2)) codes <- iso3166$a2 7 else if (all(nchar(a)==3)) codes <- iso3166$a3 8 else stop("All codes must be equal length, 2 or 3 characters.") 9 nn <- lapply(AA,function(x) iso3166$mapname[which(codes == x)]) 10 if (regex) { 11 nn2 <- lapply(nn,function(x) if (length(x)>1) paste("(^",x,")",sep="",collapse="|") else x) 12 unlist(nn2) 13 } else unlist(nn) 14} 15 16### list all countries that fall under sovereignty of 'sov' 17sov.expand <- function(sov,regex=TRUE){ 18 if (!exists("iso3166")) iso3166 <- maps::iso3166 19 sov <- tolower(sov) 20 sel <- tolower(iso3166$sovereignty) 21 nn <- lapply(sov,function(x) iso3166$mapname[which(sel == x)]) 22 if (regex) { 23 nn2 <- lapply(nn,function(x) if (length(x)>1) paste("(^",x,")",sep="",collapse="|") else x) 24 unlist(nn2) 25 } else unlist(nn) 26} 27 28### the inverse: 29### The subtlety lies in dealing with special cases like "China:Hong Kong" which has "HK", not "CN" 30### But I think it's OK if "China" returns "CN", not "CN"+"HK"+"MC". 31### Similar for Norway/Svalbard, Finland/Aland 32### But of course, "China:Hong Kong" must return "HK" etc. 33 34### we does this with a reverse grep 35### downsides: the names in x must be complete 36iso.alpha <- function(x,n=2){ 37 if (!exists("iso3166")) iso3166 <- maps::iso3166 38 39## part 1: reverse fit will find all special cases, but names in vector x must be complete 40 nam1 <- lapply(seq_along(iso3166$mapname), 41 function(nn) {regex <- paste("(^",iso3166$mapname[nn],")",sep="") 42 ttt <- grep(regex, x, perl=TRUE, ignore.case=TRUE); 43 if (length(ttt)>0) cbind(nn,ttt) else NULL}) 44 fli <- do.call(rbind,nam1) 45 sel <- fli[match(seq_along(x),fli[,2]),1] 46 47## part 2: 48## try for partial fit. if it gives a single result, use it. 49 if (any(is.na(sel))) { 50 sel2 <- which(is.na(sel)) 51 nam2 <- unlist(lapply(x[sel2], 52 function(nn) {regx <- paste("(^",nn,")",sep="") ; 53 ttt <- grep(regx, iso3166$mapname, perl=TRUE, ignore.case=TRUE); 54 if (length(ttt)==1) ttt else NA})) 55 sel[sel2] <- nam2 56 } 57 58 if (n==2) iso3166$a2[sel] 59 else if (n==3) iso3166$a3[sel] 60 else stop("n must be 2 or 3.") 61} 62 63