Ez egy munkaanyag, kérem, hogy jelen formájában ne hivatkozzanak rá és ne is közöljék újra. Minden javító szándékú javaslatot nagyon szépen köszönök!

Teljes adatfájlok: github.com/antaldaniel/valasztas18/

require(tidyverse)
tstat <- readxl::read_excel("data-raw/Telepulesadatok_tidy.xls", 
                   sheet = 1 )
names ( tstat)[2]= "telepuleskod"
names ( tstat)[1] = "telep"

tstat_2 <- readxl::read_excel("data-raw/kiegeszito_telepules_adat.xls", 
                   sheet = 1 )
adofizetok <- readxl::read_excel("data-raw/adofizetok_szama.xls", 
                   sheet = 1 )

tstat <- left_join (tstat, tstat_2, by = c("telep", "nepesseg")) %>%
  left_join( ., adofizetok) %>%
  mutate ( adofizeto_rate = adofizetok / nepesseg )
## Joining, by = c("telep", "telepid")
## Warning: package 'bindrcpp' was built under R version 3.4.4
szavazatok_raw <- readxl::read_excel(path = "data-raw/2018-04-08--egyéni és listás voksok szavazókör szerint_stata_fv.xlsx")

szavazatok <- szavazatok_raw %>%
  select ( megyeid, megye, telepid, telep, oevk, 
           szavazokor, ervenyes, ervenytelen, orsz_fidesz, 
           orsz_jobbik, 
           orsz_lmp, orsz_mszp, orsz_dk,
           orsz_egyutt, orsz_momentum, orsz_mkkp ) %>%
  mutate ( fidesz_rate = orsz_fidesz / (ervenyes + ervenytelen), 
           jobbik_rate = orsz_jobbik   / (ervenyes + ervenytelen),
           mszp_rate  =  orsz_mszp  /  (ervenyes + ervenytelen),
           lmp_rate    = orsz_lmp   / (ervenyes + ervenytelen), 
           dk_rate  =    orsz_dk  / (ervenyes + ervenytelen), 
           momentum_rate = orsz_momentum / (ervenyes + ervenytelen), 
           mkkp_rate = orsz_mkkp /  (ervenyes + ervenytelen), 
           egyutt_rate = orsz_egyutt /  (ervenyes + ervenytelen), 
           ervenyelen_rate = ervenytelen / (ervenyes + ervenytelen)) %>%
  mutate ( id = paste0(tolower(telep), "-", 
                       tolower(as.character(szavazokor))))

szavstat <- left_join ( szavazatok, tstat, by = "telep") %>%
   add_count(telep)
szavazatok_raw <- readxl::read_excel(path = "data-raw/2018-04-08--egyéni és listás voksok szavazókör szerint_stata_fv.xlsx")

szavazatok <- szavazatok_raw %>%
  select ( megyeid, megye, telepid, telep, oevk, 
           szavazokor, ervenyes, ervenytelen, orsz_fidesz, 
           orsz_jobbik, 
           orsz_lmp, orsz_mszp, orsz_dk,
           orsz_egyutt, orsz_momentum, orsz_mkkp ) %>%
  mutate ( fidesz_rate = orsz_fidesz / (ervenyes + ervenytelen), 
           jobbik_rate = orsz_jobbik   / (ervenyes + ervenytelen),
           mszp_rate  =  orsz_mszp  /  (ervenyes + ervenytelen),
           lmp_rate    = orsz_lmp   / (ervenyes + ervenytelen), 
           dk_rate  =    orsz_dk  / (ervenyes + ervenytelen), 
           momentum_rate = orsz_momentum / (ervenyes + ervenytelen), 
           mkkp_rate = orsz_mkkp /  (ervenyes + ervenytelen), 
           egyutt_rate = orsz_egyutt /  (ervenyes + ervenytelen), 
           ervenytelen_rate = ervenytelen / (ervenyes + ervenytelen)) %>%
  mutate ( id = paste0(tolower(telep), "-", 
                       tolower(as.character(szavazokor))))

szavstat <- left_join ( szavazatok, tstat, by = "telep") %>%
   add_count(telep)

Kistelepülések

A legfontosabb változók az általános iskolai végzettségűek aránya, a Buapesttől való utazás percben kifejezve, a népesség nagysága, és a megyeszékhelytől való távolság.

A Fideszre a legnagyobb arányban ott szavaztak, ahol a lakosság több mint 40 százalékának csak általános iskolai végzettsége van (65%), vagy legalább három órányira van Budapest (62%), vagy a népesség kisebb mint 651 fő és megyeszékhely is legalább 47 percre van (61.5)

A kistelepüléseken a legrosszabb arányt a Fidesz ott érte el, ahol a középfokú vagy magasabb végzettségűek aránya meghaladta a 85%-ot és ahol Budapest legfeljebb 3 órára van.

kistelepulesek <- szavstat %>%
  filter ( n == 1 ) %>%
  mutate ( adofizeto_rate = ifelse ( adofizeto_rate > 0.6, 
                                     NA, adofizeto_rate)) %>%
  mutate ( adofizet_min = ifelse ( adofizeto_rate < 0.4, 1, 0))

require(rpart)
## Loading required package: rpart
require(rpart.plot)
## Loading required package: rpart.plot
set.seed(2018)  ##bármilyen szám rögzítheti a random útvonalgenerálás kezdetét
                ##2018-ról indítva biztosan azonos lesz az ábra.

kistelep.tree <- rpart(fidesz_rate ~ nepesseg + kabeltv_arany +
                megyeszekhely_min + budapest_min + 
                ujszulott_rate + jovedelem_fo +
                vandorlas_rate + 
                altisk, data = kistelepulesek,
                control = rpart.control(cp = 0.0001, minsplit = 500))
bestcp <- kistelep.tree$cptable[which.min(kistelep.tree$cptable[,"xerror"]),"CP"]
kistelep.tree.pruned <- prune(kistelep.tree, cp = bestcp)
plot(kistelep.tree.pruned)
text(kistelep.tree.pruned, cex = 0.8, use.n = TRUE, xpd = TRUE)

Ezeken a településeken a szavazóköri szintű adatok egyértelműen megfeleltethetők a települési statisztikáknak, hiszen csak egy szavazókör volt a településen.

Az érvénytelen szavazatok is többnyire hasonló mintázatot vesznek fel, és a Fidesz támogatottsága (vagy az ellenzéki pártoké) nem nagyon számít.

kistelepulesek <- szavstat %>%
  filter ( n == 1 ) %>%
  mutate ( adofizeto_rate = ifelse ( adofizeto_rate > 0.6, 
                                     NA, adofizeto_rate)) %>%
  mutate ( adofizet_min = ifelse ( adofizeto_rate < 0.4, 1, 0))

require(rpart)
require(rpart.plot)
set.seed(2018)  ##bármilyen szám rögzítheti a random útvonalgenerálás kezdetét
##2018-ról indítva biztosan azonos lesz az ábra.

kistelep.tree2 <- rpart(ervenytelen_rate ~ fidesz_rate + jobbik_rate +
                          mszp_rate + nepesseg + kabeltv_arany +
                         megyeszekhely_min + budapest_min + 
                         ujszulott_rate + jovedelem_fo +
                         vandorlas_rate + 
                         altisk  +
                          adofizeto_rate + as.factor(adofizet_min), data = kistelepulesek,                   control = rpart.control(cp = 0.0001, minsplit = 500))
bestcp2 <- kistelep.tree2$cptable[which.min(kistelep.tree2$cptable[,"xerror"]),"CP"]
kistelep.tree.pruned2 <- prune(kistelep.tree2, cp = bestcp2)
plot(kistelep.tree.pruned2)
text(kistelep.tree.pruned2, cex = 0.8, use.n = TRUE, xpd = TRUE)

Végül egy érdekes vizualizáció a szavazatok megoszlásáról. A Fidesz ott ért el nagyon jó eredményt, értelemszerűen, ahol a Jobbik, az MSZP és az LMP gyengén szerepelt. Vagyis az ábra leginkább azt mutatja, hogy melyik pártoknak volt esélye valamennyire megszorongatni a Fideszt.

kistelepulesek <- szavstat %>%
  filter ( n == 1 ) %>%
  mutate ( adofizeto_rate = ifelse ( adofizeto_rate > 0.6, 
                                     NA, adofizeto_rate)) %>%
  mutate ( adofizet_min = ifelse ( adofizeto_rate < 0.4, 1, 0))

require(rpart)
require(rpart.plot)
set.seed(2018)  ##bármilyen szám rögzítheti a random útvonalgenerálás kezdetét
##2018-ról indítva biztosan azonos lesz az ábra.

kistelep.tree3 <- rpart(fidesz_rate ~ jobbik_rate +
                          mszp_rate + lmp_rate + momentum_rate + mkkp_rate +
                          egyutt_rate + ervenytelen_rate , data = kistelepulesek,
                        control = rpart.control(cp = 0.0001, minsplit = 500))
bestcp3 <- kistelep.tree3$cptable[which.min(kistelep.tree3$cptable[,"xerror"]),"CP"]
kistelep.tree.pruned3 <- prune(kistelep.tree3, cp = bestcp3)
plot(kistelep.tree.pruned3)
text(kistelep.tree.pruned3, cex = 0.8, use.n = TRUE, xpd = TRUE)

A következő lépés az lesz, hogy a nagyob településekre kiterjesztjük a modellt.

Nagyobb települések

A nagyobb településeket is betéve a mintába csak a népességszám és az iskolázottság marad “fontos” változó a CART modellben.

telepulesek <- szavstat %>%
  group_by (telep) %>%
  summarize_if (is.numeric, sum, na.rm=TRUE ) %>%
  filter ( telep != 'Budapest') %>%
  mutate ( fidesz_rate = orsz_fidesz / (ervenyes + ervenytelen), 
  jobbik_rate = orsz_jobbik   / (ervenyes + ervenytelen),
  mszp_rate  =  orsz_mszp  /  (ervenyes + ervenytelen),
  lmp_rate    = orsz_lmp   / (ervenyes + ervenytelen), 
  dk_rate  =    orsz_dk  / (ervenyes + ervenytelen), 
  momentum_rate = orsz_momentum / (ervenyes + ervenytelen), 
  mkkp_rate = orsz_mkkp /  (ervenyes + ervenytelen), 
  egyutt_rate = orsz_egyutt /  (ervenyes + ervenytelen), 
  ervenyelen_rate = ervenytelen / (ervenyes + ervenytelen))  %>%
  mutate  ( kabeltv_arany = kabeltv / nepesseg ) %>%
  mutate  ( jovedelem_fo = jovedelem / nepesseg ) %>%
  mutate ( ujszulott_rate = ujszulottek / nepesseg) %>%
  mutate ( idosek_rate = idosek / nepesseg ) %>%
  mutate ( budapest_min_avg = mean ( budapest_min, na.rm=TRUE)) %>%
  mutate ( adofizeto_rate = ifelse ( adofizeto_rate > 0.6, 
                                     NA, adofizeto_rate)) %>%
  mutate ( adofizet_min = ifelse ( adofizeto_rate < 0.4, 1, 0))


telep.tree <- rpart(fidesz_rate ~ nepesseg + kabeltv_arany + budapest_min_avg + 
                         ujszulott_rate + idosek_rate + jovedelem_fo +
                          adofizeto_rate + as.factor(adofizet_min) +
                         altisk, data = telepulesek, control = rpart.control(cp = 0.0001, 
                                                                                minsplit = 500))
bestcp.telep <- telep.tree$cptable[which.min(telep.tree$cptable[,"xerror"]),"CP"]
telep_tree_pruned <- prune(telep.tree, cp = bestcp)
plot(telep_tree_pruned)
text(telep_tree_pruned, cex = 0.8, use.n = TRUE, xpd = TRUE)