Croiser des identifiants - Couper des données - Afficher la légende

iso2 <- c("GB","US","RU","UA","AU","CA","CN","FR","BR","IQ", "SY","NZ","DE","ZA","JP","IL","ES","IN","EG","NG","MY","PS", "MX","IR","KR","IT","TR","TH","AF", "BE", "PK", "LY","HK","CF", "SD", "SA","YE","VA","AE", "PH","NL","AR","GR","KE", "ID","VE","CH", "LK","CU","LB","SO", "CO", "PL","AT","LR", "MM","GN","ML","TN", "BD", "SE","IE","JM","DZ","CL","PE","KP","QA", "SL","PR","BH","DK", "RS","ZW","RO","PT","UG","CY","MA","CZ","DO", "SG","UY","NO","CG","SN","SV","VN","JO", "HT","BA","ET","CR", "GT","PA","TW","KH","KW","LT","KV","MW","CI", "HR","MZ","RW","BF", "GH","NP","HU", "IS","MC","BI", "DJ","ER","KM", "MG","MU","RE", "SC","TZ","YT","ZM","AO","CD","CM","GA","GQ","ST","TD","EH","SS","BW","LS","NA","SZ", "BJ","CV", "GM","GW","MR", "NE","SH","TG", "AG","AI","AW", "BB","BL","BQ", "BS","CW","DM", "GD","GP","KN", "KY","LC","MF", "MQ","MS","SX", "TC","TT","VC", "VG","VI","BZ", "HN","NI","BO", "EC","FK","GF", "GY","PY","SR", "BM","GL","PM", "KG","KZ","TJ",  "TM","UZ","MN","MO","BT","MV","BN","LA","TL","AM","AZ","GE","OM","BG","BY","MD","SK","AX","EE","FI","FO","GG","IM","JE","LV","SJ","AD","AL","GI","ME","MK","MT","SI","SM","LI","LU","CK","NF","FJ","NC","PG","SB","VU","FM","GU","KI","MH","MP","NR","PW","AS","NU","PF","PN","TK","TO","TV", "WF","WS")

occ <- c(671,607,511,481,457,404,403,338,328,327,313,260,259,256,217,212,210,202,179,169,155,155,150,149,138,138,120,119,112,98, 95,81,78,68,67,66,58,58, 57,56,55,54,53, 50,49,48,45,43,41,39,37,35,32,32,28, 28,27,26,25,24,24,23,20,17,17,16,15,15,14,14,14,12, 12,11,11,11,10, 10,9,9,8,8,7,7,6,6, 6,6,6,5,5,3,3,3,3,3, 3,3,3,3,2,2,2,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0) 

mes_datas <- data.frame(iso2,occ)

library("raster")

WorldMap <- getData('countries')

names(WorldMap)

library(rworldmap)

WorldMap  <- getMap()

summary(WorldMap) # ou names

code_ISO2_fond_carte <- as.character(WorldMap$ISO_A2) # parfois une conversion avec as.character est nécessaire si une des liste est reconnue comme facteurs et pas l'autre

# Contrôle de sécurité que les codes ISO2 (2 lettres) sont dans le bon ordre par rapport au fond de carte

setequal(mes_datas[,1],code_ISO2_fond_carte) # Si FALSE, les deux listes sont différentes sinon elle peuvent être identiques mais d'ordres différents !

length(unique(mes_datas[,1]))==length(mes_datas[,1]) # Si FALSE, notre vecteur d'ID est mal conçu (des pays en double...). Ce problème arrive souvent si on travaille sur des espaces fragmentés : on peut se retrouver avec deux communes ayant le même ID.

# Mise en correspondance des valeurs associés à chaque pays au code ISO selon leur disposition dans le fond de carte

occurences_pays <- rep(NA,length(code_ISO2_fond_carte)) # On crée d'abord une liste vide.

indices <- which(!is.na(code_ISO2_fond_carte)) # On récupère les indices de chaque code pays (on se débarrasse des valeurs vides qui correspondent aux "pays" qui n'ont pas de code pays ISO2 (parfois NA ou parfois "-99")

for (i in indices) {

  sortie <- mes_datas[,2][mes_datas[,1]==code_ISO2_fond_carte[i]]

 if (length(sortie)>1) {cat("Problème : plusieurs valeurs pour un même pays : ",code_ISO2_fond_carte[i],"\n") 

 } else if (length(sortie)==0) {cat("Pas de valeurs pour le pays suivant : ",code_ISO2_fond_carte[i],"\n")

  } else {occurences_pays[i] <- sortie}

}

n= 10 # nombre de niveaux souhaités

## Niveaux de couleurs : j'utilise la fonction cut

niveaux <- cut(occurences_pays, n, label = FALSE)

## Couleurs - option 1.1. un dégradé avec heat.colors

colors <- rev(heat.colors(n))

## Couleurs - option 1.2. un dégradé où je choisis mes couleurs : je veux aller ici du rouge vers le vert en passant par l'orange !

colfunc<-colorRampPalette(c("red","orange","green"))

colors <- (colfunc(n))

couleurs <- rep("#FFFFFF",nrow(dat_country))

for (i in c(1:n)) {couleurs[niveaux==i] <- colors[i]}

summary(occurences_pays)

categories <- c(0,0,8,32,128,256,512,1000) # C'est là que je définis mon découpage

colfunc<-colorRampPalette(c("red","orange","green"))

colors <- (colfunc(length(categories)-1))

couleurs <- rep("#FFFFFF",nrow(mes_datas))

for (i in c(1:length(colors))) {

  couleurs[occurences_pays>categories[i]&occurences_pays<=categories[i+1]] <- colors[i] 

}

categories <- c(0,8,16,64,256,400,700)

niveaux <- cut(occurences_pays,categories)

# PREPARER LA LEGENDE en reprenant le cas où j'ai découpé manuellement

texte=c()

for (i in c(1:(length(categories )-1))) {

  if (i < (length(categories )-1)) {

  if (categories [i] == categories [i+1]) {temp <-categories [i]

  }else {temp <- paste(">",categories [i],"- <= ",categories [i+1],sep="")}

  }

 if (i == (length(categories )-1)){

  temp <- paste(">=",categories [i],sep="")

 }

  texte <- c(texte,temp)

 }

texte

legend(x="left", legend=texte, fill=colors,cex=1) # Et hop, ça s'ajoute (cf. ci-dessous)

# Je trace ma carte sur la partie gauche et je réserve la partie droite pour la légende (0 à 0,8 ==> Je me suis gardé 20% de la place de 0,8 à 1)

par(fig=c(0,0.8,0,1), mar = c(0,2,0,2), new=TRUE) ; dev.new()

plot(WorldMap,col=couleurs,border="grey")

# J'ajoute la légende constituée d'une image à coller

par(fig=c(0.8,1,0.1,0.9), mar = c(2,2,2,0),new=T) # je peux jouer sur sa place en changeant ces paramètres

legend_image <- as.raster(matrix(rev(colors), ncol=1))

# Tracer un graphique blanc à la place de la légende

plot(c(0,2),c(0,1),type = 'n', axes = F,xlab = '', ylab = '', main = 'legend title',cex.main=0.5)

# Tracer les graduations de la légende, ici le paramétrage en est strictement manuel 5 paliers entre 0 et 650

text(x=1.5, y = seq(0,1,l=5), labels = seq(0,650,l=5),cex=0.8) # 5 graduations de 0 à 600...

# Ajouter l'image de gradient

rasterImage(legend_image, 0, 0, 1,1)