여론조사 결과를 기반으로한 베이지안 선거 예측

작성일자 글쓴이

최근 베이지언을 이론적으로 심도있게 공부하며 활용에 대한 고민을 하다 재미있게도 6.4지방선거를 앞두로 여론조사들이 나오고 있어 이 데이터를 기반으로 간단한 작업을 해보았다.

여기저기 흩어져 있는 여론조사 결과를 정리해둔 웹 페이지를 근거로 사후분포를 계속 업데이트 하는 방법으로 예측값을 도출했으며 코드를 보면 알겠지만 이항분포의 conjugate prior인 베타분포를 기반으로 계산을 하였다. 예측은 모수의 최빈값으로 도출하였으며 분산도 함께 도출해 모수의 신뢰도도 함께 측정하였다.

여론조사의 화두인 박원순, 정몽준 후보의 결과이며 서울시장 여론조사 결과가 좀 더 정리된 페이지가 있다면 더 재미난 분석을 해볼 수 있을거 같다는 생각을 해본다.

library(ggplot2)
library(extrafont)

# 초기 균일 분포
prior.a <- 1
prior.b <- 1

# 데이터는 http://appida.tistory.com/1091 에서
ns.org <- c(488 + 596, 262 + 275, 367 + 337, 418 + 382, 307 + 395)
ns.per <- c(0.22, 0.122, 0.16, 0.307, 0.15)
ns <- trunc(ns.org * ns.per)

dt <- c("20140512", "20140513", "20140514-1", "20140514-2", "20140514-3")
n <- length(ns)
reply.jung <- c(0.305, 0.329, 0.325, 0.377, 0.349)
reply.park <- c(0.458, 0.533, 0.529, 0.474, 0.484)
njung <- trunc(ns * reply.jung)
npark <- trunc(ns * reply.park)


theta <- seq(0, 1, by = 0.005)

modes <- c()
va <- c()

posteriors <- data.frame(ab = "start", theta = theta, posterior = dbeta(theta, 
    prior.a, prior.b))
# sequential learning
for (i in 1:n) {
    prior.a <- prior.a + npark[i]
    prior.b <- prior.b + ns[i] - npark[i]
    modes <- c(modes, (prior.a - 1)/(prior.a + prior.b - 2))
    va <- c(va, (prior.a * prior.b)/((prior.a + prior.b)^2 * (prior.a + prior.b)))
    posteriors <- rbind(posteriors, data.frame(ab = dt[i], theta = theta, posterior = dbeta(theta, 
        prior.a, prior.b)))
}

ggplot(posteriors, aes(theta, posterior)) + geom_line(aes(colour = ab)) + facet_wrap(~ab, 
    nrow = 3) + ggtitle("박원순 후보 사후확률 분포") + scale_color_discrete("여론조사 날짜/차수")

plot of chunk unnamed-chunk-1 



dts <- c(dt)
# ggplot(data.frame(dt=dts, modes, va), aes(factor(dt, levels=dts), modes))
# + geom_line(aes(group=1)) + scale_y_continuous(limits=c(0,1)) +
# geom_text(aes(label=round(modes, 3)), size=3,vjust=-2) +
# geom_point(aes(colour=va),size=3) + scale_color_continuous('분산') +
# xlab('여론조사 날짜/차수') + ylab('박원순 후보 예측 지지율')


results <- data.frame(dt = dts, modes, va, cls = "park")

# 정몽준 후보

prior.a <- 1
prior.b <- 1

modes <- c()
va <- c()

posteriors <- data.frame(ab = "start", theta = theta, posterior = dbeta(theta, 
    prior.a, prior.b))
# sequential learning
for (i in 1:n) {
    prior.a <- prior.a + njung[i]
    prior.b <- prior.b + ns[i] - njung[i]
    modes <- c(modes, (prior.a - 1)/(prior.a + prior.b - 2))
    va <- c(va, (prior.a * prior.b)/((prior.a + prior.b)^2 * (prior.a + prior.b)))
    posteriors <- rbind(posteriors, data.frame(ab = dt[i], theta = theta, posterior = dbeta(theta, 
        prior.a, prior.b)))
}

ggplot(posteriors, aes(theta, posterior)) + geom_line(aes(colour = ab)) + facet_wrap(~ab, 
    nrow = 3) + ggtitle("정몽준 후보 사후확률 분포") + scale_color_discrete("여론조사 날짜/차수")

plot of chunk unnamed-chunk-1 



dts <- c(dt)
# ggplot(data.frame(dt=dts, modes, va), aes(factor(dt, levels=dts), modes))
# + geom_line(aes(group=1)) + scale_y_continuous(limits=c(0,1)) +
# geom_text(aes(label=round(modes, 3)), size=3,vjust=-2) +
# geom_point(aes(colour=va),size=3) + scale_color_continuous('분산') +
# xlab('여론조사 날짜/차수') + ylab('정몽준 후보 예측 지지율')

results <- rbind(results, data.frame(dt = dts, modes, va, cls = "jung"))


ggplot(results, aes(factor(dt, levels = dts), modes)) + geom_line(aes(group = cls)) + 
    scale_y_continuous(limits = c(0, 1)) + geom_text(aes(label = round(modes, 
    3)), size = 3, vjust = -2) + geom_point(aes(colour = va, group = cls), size = 3) + 
    scale_color_continuous("분산") + xlab("여론조사 날짜/차수") + 
    ylab(" 후보 예측 지지율")

plot of chunk unnamed-chunk-1

그래프에 표시를 하지 않았으나 예상 지지율의 상단에 위치하는건 박원순 후보이며 하단에 위치하는건 정몽준 후보이다.

여론조사 기관의 신뢰도나 방법론에 대한 고려를 전혀 하지 않은 모델이기 때문에 과도한 의미 부여는 힘들며 뭐 이런식으로 선거 예측이 가능하겠구나 정도의 toy example 정도이다.

이 글의 다음 버전은 여기에서 볼 수 있다.

CC BY-NC 4.0 여론조사 결과를 기반으로한 베이지안 선거 예측 by from __future__ import dream is licensed under a Creative Commons Attribution-NonCommercial 4.0 International License.