couleurs polygones

[camille garcin]

Bonjour
Avec spplot, je ne parviens pas à représenter sur le fond de carte la couleur définie pour chaque département dans le data-frame (fréquence de survenue d’un événement dans chacun d’entre eux). Et cela, bien que la colonne fr1@data$cols correspond bien avec le couleur que je souhaite affecter au département !!! Les couleurs sur la carte sont bien celles définies mais réparties d'une façon qui me rend perplexe.
Merci de votre aide.

Code : Tout sélectionner

#-------------------------------------------------------
#carto.r : Nombre de transactions par département
#--------------------------------------------------------

rm(list=ls())
load('../data/total.rdata')

#carto
library(maps)
library(mapdata)
library(maptools)
library(rgdal)
library(cartography)

graphics.off()
png('../figs/lieu_transac.jpg',width=1500,height=1000)


#donnees INSEE
depts<-read.table('../data/insee/depts2010.txt',sep="\t",header=T,quote=NULL,stringsAsFactor=F)


#chargement du fond de carte

#par dept
fr1<-readOGR('../data/departements-20180101-shp/departements-20180101.shp')#fr2=readShapePoly("C:/Users/Robert et Chantal/Documents/boulot/wyeth/cartes/FRA_adm/FRA_adm2.shp",proj4string=CRS("+proj=longlat +datum=WGS84"))
fr1@data$wikipedia=NULL
fr1<-subset(fr1,!{fr1@data$code_insee %in% c(971:976,'69D','69M','2A','2B')})
# & fr1@data$code_insee %in% c('06',83,13)




levels(total$lieu_transac2)[which(levels(total$lieu_transac2)=='Nice')]='06'
levels(total$lieu_transac2)[which(! levels(total$lieu_transac2) %in% c(as.character(fr1@data$code_insee),'69','20'))]='99'


fr1@data<-merge(fr1@data,data.frame(table(as.character(droplevels(total$lieu_transac2)))),by.x='code_insee',by.y='Var1',all.x=T
)

fr1@data$Freq[which(is.na(fr1@data$Freq))]=0

#fr1@data<-lapply(fr1@data,droplevels)

fr1@data$freq2<-cut(fr1@data$Freq,breaks=c(-0.1,1,10,20,50,100,100000000),right=F,
   #labels=c(paste('[',paste(c(1,10,20),1:3*10,sep='-'),'[',sep=''),'[31 et+]'))
   labels=c('0','1 à 9','10 à 19','20 à 49','50 à 99','100 et +'))


#
#fr1@data[,c('code_insee','Freq','freq2','cols')]

#graphiques
palette=rev(heat.colors(100))

fr1@data$cols<-ifelse(fr1@data$freq2=='0',palette[1],ifelse(fr1@data$freq2=='1 à 9',palette[5],ifelse(fr1@data$freq2=='10 à 19',palette[15],
ifelse(fr1@data$freq2=='20 à 49',palette[35],ifelse(fr1@data$freq2=='50 à 99',palette[75],'blue')))#palette[100]
))

par(xpd=T,mar=rep(0.5,4))
plot.new()
print(spplot(obj=fr1,zcol='freq2',col.regions=rev(fr1@data$cols),main='',colorkey = FALSE))

title('Nombre de transactions')

#legend(x=0.86,y=1,cex=2.5,box.lwd=2,fill=palette[c(5,8,11,14,16)],legend=c('1 à 9','10 à 19','20 à 49','50 à 99','100 et +'),bty="n")



dev.off()
stop('lola')


[Mickael Canouil]

Bonjour,

dans le doute, j'ajouterai un options(stringsAsFactors = FALSE) en début de scripts (si vous n'utilisez pas R 4.0.*).

Code : Tout sélectionner

rm(list=ls())
load('../data/total.rdata')
#> Warning in readChar(con, 5L, useBytes = TRUE): cannot open compressed file '../
#> data/total.rdata', probable reason 'No such file or directory'
#> Error in readChar(con, 5L, useBytes = TRUE): cannot open the connection  

Sinon un peu de lecture :

• Qu'est-ce qu'un code reproductible ?
• Comment insérer des données dans un message ?
• FAQ: What's a reproducible example (`reprex`) and how do I do one?

Cordialement,

[camille garcin]

ReBonjour
Voici donc quelques éléments qui vous permettront de mieux cerner mon souci. Ont été extraits de l'objet fr1 de type SpatialPolygonsDataFrame les données et les polygones correspondant aux départements 06, 83 et 13 dont la couleur souhaitée pour chacun est définie dans la colonne cols (bleu, rouge et jaune respectivement) du data-frame.

Code : Tout sélectionner

> fr1@data
  code_insee               nom nuts3             wikipedia surf_km2  Freq    freq2   cols
1         06   Alpes-Maritimes FR823    fr:Alpes-Maritimes     4294 50935 100 et + salmon
2         13 Bouches-du-Rhône FR823  fr:Bouches-du-Rhône     5247   616 100 et +    red
3         83               Var FR825 fr:Var (département)     6030   766 100 et + yellow


Code : Tout sélectionner

> dput(fr1@data)
structure(list(code_insee = c("06", "13", "83"), nom = c("Alpes-Maritimes",
"Bouches-du-Rhône", "Var"), nuts3 = c("FR823", "FR823", "FR825"
), wikipedia = c("fr:Alpes-Maritimes", "fr:Bouches-du-Rhône",
"fr:Var (département)"), surf_km2 = c(4294, 5247, 6030), Freq = c(50935,
616, 766), freq2 = structure(c(6L, 6L, 6L), .Label = c("0", "1 à 9",
"10 à 19", "20 à 49", "50 à 99", "100 et +"), class = "factor"),
    cols = c("salmon", "red", "yellow")), row.names = c(NA, -3L
), class = "data.frame")


J’ai tenté d’épurer le code (qui fonctionne) ici (certains packages sont peut-être superflus)

Code : Tout sélectionner

#-------------------------------------------------------
#carto.r : Nombre de transactions par département
#--------------------------------------------------------


#setwd('C:/Utilisateurs/CGARCIN/Documents/cartes-auto/2018/code')
#options(stringsAsFactors = FALSE)
rm(list=ls())
load('../data/total.rdata')
png('../figs/lieu_transac.png',width=1500,height=1000)
#carto
library(maps)
library(mapdata)
library(maptools)
library(rgdal)
library(cartography)


fr1<-readOGR('../data/departements-20180101-shp/departements-20180101.shp')
fr1<-subset(fr1,code_insee %in% c('06',83,13))




fr1@data<-merge(fr1@data,data.frame(table(as.character(droplevels(total$lieu_transac2)))),by.x='code_insee',by.y='Var1',all.x=T
)
#recodage data-frame
#levels(total$lieu_transac2)[which(levels(total$lieu_transac2)=='Nice')]='06'
levels(total$lieu_transac2)[which(! levels(total$lieu_transac2) %in% c(as.character(fr1@data$code_insee),'69','20'))]='99'



fr1@data$Freq[which(is.na(fr1@data$Freq))]=0

#fr1@data<-lapply(fr1@data,droplevels)

fr1@data$freq2<-cut(fr1@data$Freq,breaks=c(-0.1,1,10,20,50,100,100000000),right=F,
   #labels=c(paste('[',paste(c(1,10,20),1:3*10,sep='-'),'[',sep=''),'[31 et+]'))
   labels=c('0','1 à 9','10 à 19','20 à 49','50 à 99','100 et +'))





#graphiques
palette=rev(heat.colors(100))

fr1@data$cols<-c('salmon','red','yellow')
#fr1@data$cols[which(fr1@data$code_insee=='06')]='blue'

par(mai=c(5,5,7,6))
par(xpd=T,mar=rep(0.5,4))
plot.new()
print(spplot(obj=fr1,zcol='code_insee',col.regions=fr1@data$cols,main='',colorkey = FALSE))


dev.off()


Pourtant, après tracé, le département 06 apparait en jaune et les départements 83 et 13 en saumon !
Merci d'avance.
PS : L’option options(stringsAsFactors = FALSE) ne donne rien. ☹

[Mickael Canouil]

La documentation de la fonction spplot

col.regions
vector with fill colours; in case the variable to be plotted is a factor, this vector should have length equal to the number of factor levels

Il n'est mentionné nul part que spplot exploite une colonne "cols" du champ "data".
col.regions donne les couleurs dans l'ordre des niveau de facteurs de "zcol".


Voici un code/exemple reproductible :

Code : Tout sélectionner

library(lattice)
library(sp)
trellis.par.set(sp.theme()) # sets bpy.colors() ramp
demo(meuse, ask = FALSE, echo = FALSE)
l2 <- list("SpatialPolygonsRescale", layout.north.arrow(), offset = c(181300, 329800), scale = 400)
l3 <- list("SpatialPolygonsRescale", layout.scale.bar(), offset = c(180500, 329800), scale = 500, fill = c("transparent", "black"))
l4 <- list("sp.text", c(180500, 329900), "0")
l5 <- list("sp.text", c(181000, 329900), "500 m")
spplot(obj = meuse, zcol = c("ffreq"), sp.layout = list(l2, l3, l4, l5), col.regions = c("black", "red", "blue")) 

Cordialement,

[camille garcin]

Je suis vraiment désolé mais je ne parviens toujours pas à obtenir, malgré la modification que vous me suggérez (et dont je vous remercie) : les couleurs ne sont toujours pas affectées au bon département. Auriez-vous une autre idée ?

Code : Tout sélectionner

> levels(fr1@data$freq2)
[1] "0"        "1 à 9"    "10 à 19"  "20 à 49"  "50 à 99"  "100 et +"
> fr1@data
  code_insee                     nom nuts3 surf_km2  Freq    freq2
1         04 Alpes-de-Haute-Provence FR821     6993    22  20 à 49
2         05            Hautes-Alpes FR822     5697    20  20 à 49
3         06         Alpes-Maritimes FR823     4294 82413 100 et +
4         13       Bouches-du-Rhône FR823     5247   616 100 et +
5         83                     Var FR825     6030   766 100 et +
6         84                Vaucluse FR826     3577    36  20 à 49


Code : Tout sélectionner

 
cols<-c('red','green','blue','yellow','pink','black')
print(spplot(obj=fr1,zcol='freq2',col.regions=cols,main='',colorkey = FALSE))


Plus précisément, les couleurs obtenues sont correctes (jaune et noir) mais ne colore pas les départements souhaités (jaune->'04','05','84' et noir->'06','13','84'). J'obtiens en fait : jaune->06,04,13 et noir->05,83,84.

[Mickael Canouil]

Je ne comprends rien à votre message ...
Vous voulez une coloration des régions, mais vous utilisez des fréquences pour vos couleurs.

Que donne ?

Code : Tout sélectionner

unique(fr1@data$freq2)

Comme je l'ai dit, les couleurs sont définies selon les modalités (existantes) du facteur de zcol.

Code : Tout sélectionner

library(lattice)
library(sp)
trellis.par.set(sp.theme()) # sets bpy.colors() ramp
demo(meuse, ask = FALSE, echo = FALSE)
l2 <- list("SpatialPolygonsRescale", layout.north.arrow(), offset = c(181300, 329800), scale = 400)
l3 <- list("SpatialPolygonsRescale", layout.scale.bar(), offset = c(180500, 329800), scale = 500, fill = c("transparent", "black"))
l4 <- list("sp.text", c(180500, 329900), "0")
l5 <- list("sp.text", c(181000, 329900), "500 m")

Code : Tout sélectionner

levels(meuse@data$ffreq)
#> [1] "1" "2" "3"
spplot(obj = meuse, zcol = c("ffreq"), sp.layout = list(l2, l3, l4, l5), col.regions = c("black", "red", "blue")) 

EDIT : même en supprimant des modalités, j'obtiens le bon résultat

Code : Tout sélectionner

library(lattice)
library(sp)
trellis.par.set(sp.theme()) # sets bpy.colors() ramp
demo(meuse, ask = FALSE, echo = FALSE)
l2 <- list("SpatialPolygonsRescale", layout.north.arrow(), offset = c(181300, 329800), scale = 400)
l3 <- list("SpatialPolygonsRescale", layout.scale.bar(), offset = c(180500, 329800), scale = 500, fill = c("transparent", "black"))
l4 <- list("sp.text", c(180500, 329900), "0")
l5 <- list("sp.text", c(181000, 329900), "500 m") 

meuse@data$ffreq[meuse@data$ffreq==2] <- 3
levels(meuse@data$ffreq)
#> [1] "1" "2" "3"
unique(meuse@data$ffreq)
#> [1] 1 3
#> Levels: 1 2 3
spplot(obj = meuse, zcol = c("ffreq"), sp.layout = list(l2, l3, l4, l5), col.regions = c("black", "red", "blue")) 

Il s'agit plus d'une spécificité de votre jeu de donnée, ainsi je vous invite à fournir un exemple reproductible et minimal de votre problème.

• Qu'est-ce qu'un code reproductible ?
• Comment insérer des données dans un message ?
• FAQ: What's a reproducible example (`reprex`) and how do I do one?

[camille garcin]

Je souhaiterais colorier chaque région en fonction de la classe de la variable freq2 (qui est un facteur à 6 niveaux)

Code : Tout sélectionner

> levels(fr1@data$freq2)
[1] "0"        "1 à 9"    "10 à 19"  "20 à 49"  "50 à 99"  "100 et +"


pour celle-ci :

Code : Tout sélectionner

> fr1@data
  code_insee                     nom nuts3 surf_km2  Freq    freq2
1         04 Alpes-de-Haute-Provence FR821     6993    22  20 à 49
2         05            Hautes-Alpes FR822     5697    20  20 à 49
3         06         Alpes-Maritimes FR823     4294 82413 100 et +
4         13       Bouches-du-Rhône FR823     5247   616 100 et +
5         83                     Var FR825     6030   766 100 et +
6         84                Vaucluse FR826     3577    36  20 à 49


J’ai défini une liste de 6 couleurs

Code : Tout sélectionner

cols<-c('red','green','blue','yellow','pink','black')


L’instruction

Code : Tout sélectionner

print(spplot(obj=fr1,zcol='freq2',col.regions=cols,main='',colorkey = FALSE))


n’affecte pas la « bonne » couleur à chaque région.

Quelque chose m'échappe...
Merci de votre aide.

[camille garcin]

Le problème est résolu : il y avait un souci au niveau du merge pour intégrer aux données spatiales le facteur dont les niveaux sont associés aux couleurs à représenter sur la carte.
Dans merge(x, y, …..), x est l’objet de type SpatialPolygonsDataFrame (et non le sous-objet de type data-frame de ce dernier) et y le data-frame contenant le facteur.
Ci-dessous le code correspondant au cas où quelqu’un serait intéressé et en espérant avoir été clair.

Code : Tout sélectionner

rm(list=ls())

load('../data/total.rdata')
#1. Recodage
levels(total$lieu_transac2)[which(levels(total$lieu_transac2)=='Nice')]='06'
levels(total$lieu_transac2)[which(! levels(total$lieu_transac2) %in% c('01','02','03','04','05','06','07','08','09',10:100))]='99'


#carto
library(maptools)
library(rgdal)

png('../figs/lieu_transac.png',width=1500,height=1000)


#chargement du fond de carte

#par dept
fr1<-readOGR('../data/departements-20180101-shp/departements-20180101.shp')#fr2=readShapePoly("C:/Users/Robert et Chantal/Documents/boulot/wyeth/cartes/FRA_adm/FRA_adm2.shp",proj4string=CRS("+proj=longlat +datum=WGS84"))
fr1@data$wikipedia=NULL



levels(total$lieu_transac2)[which(levels(total$lieu_transac2)=='Nice')]='06'
levels(total$lieu_transac2)[which(! levels(total$lieu_transac2) %in% c('01','02','03','04','05','06','07','08','09',10:100))]='99'

fr1<-subset(fr1,!fr1@data$code_insee %in% c(971:976,'69M')) #exclusion dom et metropole de Lyon (redondant avec le département)
#recodage depratement du Rhone
levels(fr1@data$code_insee)[which(levels(fr1@data$code_insee) == '69D')]='69'


lieu<-data.frame(table(total$lieu_transac2))
names(lieu)<-c('dep','effectif')
lieu$dep<-as.character(lieu$dep)


fr1<-merge(fr1,lieu,by.x='code_insee',by.y='dep',all.x=T)
fr1@data$effectif[is.na(fr1@data$effectif)]=0


fr1@data$freq2<-cut(fr1@data$effectif,breaks=c(-0.1,1,10,20,50,100,100000000),right=F,
   labels=c('0','1 à 9','10 à 19','20 à 49','50 à 99','100 et +'))

#------------------------
#      Carte
#------------------------

palette=rev(heat.colors(100))


#couleurs associées aux niveaux du facteur dans 'zcol'
cols<-palette[c(1,5,15,35,75,100)]

par(xpd=T,mar=rep(0.5,4))
plot.new()
print(spplot(obj=fr1,zcol='freq2',col.regions=cols,main='',colorkey = FALSE))

title('Nombre de transactions')

legend(x=0.86,y=1,cex=2.5,box.lwd=2,fill=cols,legend=c('0','1 à 9','10 à 19','20 à 49','50 à 99','100 et +'),bty='n')

dev.off()