HeatMap Profession des candidats aux législatives et Parti

heatmap_candidats_profession.R

library(gdata)
library(reshape)
library(classInt)

###############
# INTEGRATING #
###############

f <- read.xls("IN/Leg 2012 Candidatures T1 31 05 2012.xls", sheet=1)
nuances <- read.xls("IN/Leg 2012 Candidatures T1 31 05 2012.xls", sheet=2, skip=2, header=FALSE)

# NUANCE LIBS
mtch <- match(f$Nuance, str_trim(nuances[,1]))
f$NuanceLib <- nuances[mtch, 2]

unique(f$Profession)


#############
# RESHAPING #
#############

f$value <- 1
r <- cast(f[, c("Profession", "NuanceLib", "value")], Profession~NuanceLib, sum)

rownames(r) <- r$Profession
r <- r[, 2:ncol(r)]

# MATRIX
r.m <- as.matrix(r)
rownames(r.m) <- rownames(r); colnames(r.m) <- colnames(r)


###################################
# CALCUL DE LA MATRICE DE CONTRIB #
###################################

khideux <- function(mat){
  m.cont <- mat

  sumR <- apply(mat, 1, sum)
  sumC <- apply(mat, 2, sum)
  sumT <- sum(mat)

  for (i in 1:nrow(mat)) {
    for (j in 1:ncol(mat)) {  
      w <- (sumR[i]*sumC[j])/sumT
      khikhi <- (mat[i, j] - w)^2/w
      m.cont[i, j] <- khikhi
    }  
  }
  return (m.cont)
}

m.cont <- khideux(r.m)


########
# PLOT #
########

# XY COORDS for LABELS
xs <- seq(0, 1, length.out=ncol(r.m))
ys <- seq(1, 0, length.out=nrow(r.m))

xss <- rep(xs, nrow(r.m))
yss <- rep(ys, each = ncol(r.m))

# COLORS
cls <- classIntervals(as.numeric(m.cont), 20, style="jenks")

# HEAT MAP
png(file="IMG/khikhi.png", width=1200, height=2250)
fsz <- 1.2
par(xpd=T, mar=c(30,30,30,30), bg="black")
pal <- colorRampPalette(c("black", "red"))
m.cont2 <- m.cont[nrow(m.cont):1, ]

# IMAGE
image(t(m.cont2), breaks=cls$brk, axes=F, col=pal(20))

# AXES
axis(1, tick=FALSE, las=2, at=seq(0, 1, length.out=ncol(r.m)), labels=rownames(t(m.cont2)), col.axis=gray(.5), cex.axis=fsz)
axis(3, tick=FALSE, las=2, at=seq(0, 1, length.out=ncol(r.m)), labels=rownames(t(m.cont2)), col.axis=gray(.5), cex.axis=fsz)
axis(2, tick=FALSE, las=2, at=seq(0, 1, length.out=nrow(r.m)), labels=colnames(t(m.cont2)), col.axis=gray(.5), cex.axis=fsz)
axis(4, tick=FALSE, las=2, at=seq(0, 1, length.out=nrow(r.m)), labels=colnames(t(m.cont2)), col.axis=gray(.5), cex.axis=fsz)

# LIBELLES DE CELLULES
text(xss, yss, labels=ifelse(v>0, v, NA), col=gray(.5), cex=fsz*.6, font=2)
legend(1.4,-0.04, title="Valeur du Khi-deux", rev(as.character(cls$brk)), bty="n", fill=rev(pal(21)), cex=fsz*.8, text.col=gray(.5));

dev.off()