Datos

Los datos son de El Mundo.

Metodología

La metodología y el código es de Carlos Gil Bellosta, lo cuenta en este post

Básicamente se trata de ver el sesgo de las encuestas electorales de los diferentes medios con respecto a lo promediado en total.

Lo que hace es ver todas las encuestas electorales en un período de tiempo, considerar como valor verdadero la intención de voto suavizada, usando loess y estimar el sesgo como diferencia entre lo estimado por cada medio y la intención de voto suavizada. La diferencia la estima con un modelo de efectos mixtos. El uso del modelo de efectos mixtos es pertinente pues supone hay correlación entre las encuestas realizadas por un mismo medio.

Lectura de datos

library(rjson)
library(plyr)
 
raw <- fromJSON(readLines("https://spreadsheets.google.com/feeds/list/1vyVTJPr7ZpuQI4m17cekWl485cQ-Zh6O9Yb6zXkPpYI/od6/public/values?alt=json"))
 
dat <- raw$feed$entry
 
res <- ldply(dat, unlist)
 
res[, "id.$t"] <- res[, "updated.$t"] <- NULL
res$category.scheme <- res$category.term <- res$title.type <- NULL
res$`content.$t` <- res$link.href <- res$link.rel <- res$content.type <- NULL
res[, "title.$t"] <- res$link.type <- NULL
 
colnames(res) <- make.names(colnames(res))
 
res$gsx.casa..t <- NULL
 
res$fecha <- as.Date(res$gsx.fechaok..t, format = "%d/%m/%Y")
res$medio <- res$gsx.empresaymedio..t
res$margen.error <- as.numeric(gsub(",", ".", res$gsx.margendeerror..t))
res$tamano <- as.numeric(gsub("\\.", "", res$gsx.tamañomuestra..t))
 
res <- res[res$tamano < 1e6,]
 
hist(res$tamano)

res$int.pp <- as.numeric(gsub(",", ".", res$gsx.pp..t))
res$int.psoe <- as.numeric(gsub(",", ".", res$gsx.psoe..t))
res$int.cs <- as.numeric(gsub(",", ".", res$gsx.cs..t))
res$int.podemos <- as.numeric(gsub(",", ".", res$gsx.podemos..t))
res$int.iu <- as.numeric(gsub(",", ".", res$gsx.iu..t))
 
res <- res[, -grep("^gsx", colnames(res))]

Estimamos la intención de voto suavizada con loess y lo dibujamos. Mola ggplot2, verdad?

library(ggplot2)
library(reshape2)
 
# melt es para poner los datos en long format
tmp <- melt(res, id.vars = c("fecha", "medio", "margen.error", "tamano"))
head(tmp)
##        fecha                       medio margen.error tamano variable
## 1 2015-01-06                SER (MyWord)         3.10   1001   int.pp
## 2 2015-01-08       El País (Metroscopia)         3.20   1000   int.pp
## 3 2015-01-09   eldiario.es (Celeste-Tel)         3.10   1100   int.pp
## 4 2015-01-12                         CIS         2.00   2481   int.pp
## 5 2015-01-14 Mediaset España (Sigma Dos)           NA   1800   int.pp
## 6 2015-01-14               Simple Lógica         3.12   1025   int.pp
##   value
## 1  24.6
## 2  19.2
## 3  31.1
## 4  27.3
## 5  29.4
## 6  24.5
ggplot(tmp, aes(x = fecha, y = value)) + geom_smooth() + geom_point(size=0.7) + facet_wrap(~ variable)

Ahora calcula la diferencia entre lo estimado por loess (no es más que una forma de promediar los datos de las diferentes encuestas) y lo publicado por cada medio. Como lo estimado por cada medio a lo largo del tiempo suponemos que no es independiente se utiliza un modelo mixto.

PP

library(lme4)
library(lattice)

tmp <- res

# predicción por loess (es lo mismo que antes en el gráfico, pero ahora se guarda)
tmp$pred.pp <- predict(loess(int.pp ~ as.numeric(fecha), data = res))

# diferencia entre lo publicado y la estimación por loess
tmp$delta.pp <- tmp$int.pp - tmp$pred.pp

# modela la diferencia
mod.pp <- lmer(delta.pp ~  (1 | medio), data = tmp)

# Gráfico de los efecots aleatorio: Son la diferencia de cada medio
# respecto a la estimación global.

dotplot(ranef(mod.pp, condVar = TRUE))
## $medio

psoe

tmp <- res
tmp$pred.psoe <- predict(loess(int.psoe ~ as.numeric(fecha), data = res))
tmp$delta.psoe <- tmp$int.psoe - tmp$pred.psoe 
mod.psoe <- lmer(delta.psoe ~ 1 + (1 | medio), data = tmp)

dotplot(ranef(mod.psoe, condVar = TRUE))
## $medio

podemos

tmp <- res
tmp$pred.podemos <- predict(loess(int.podemos ~ as.numeric(fecha), data = res))
tmp$delta.podemos <- tmp$int.podemos - tmp$pred.podemos 
mod.podemos <- lmer(delta.podemos ~ 1 + (1 | medio), data = tmp)

dotplot(ranef(mod.podemos, condVar = TRUE))
## $medio

ciudadanos

tmp <- res
tmp$pred.cs <- predict(loess(int.cs ~ as.numeric(fecha), data = res))
tmp$delta.cs <- tmp$int.cs - tmp$pred.cs
mod.cs <- lmer(delta.cs ~ 1 + (1 | medio), data = tmp)

dotplot(ranef(mod.cs, condVar = TRUE))
## $medio

iu

tmp <- res
tmp$pred.iu <- predict(loess(int.iu ~ as.numeric(fecha), data = res))
tmp$delta.iu <- tmp$int.iu - tmp$pred.iu
mod.iu <- lmer(delta.iu ~ 1 + (1 | medio), data = tmp)

dotplot(ranef(mod.iu, condVar = TRUE))
## $medio

Y ahora que cada cual saque sus propias conclusiones sobre las encuestas electorales y los sesgos de cada medio.