Synopsis

This report aims to explore Ukrainian EIT 2016 results grouped by regions, gender and age factors.

Preparations

library(ggplot2)
library(maptools)
library(rgeos)
library(rgdal)
library(ggmap)
library(gridExtra)
library(grid)
library(reshape2)
library(grImport)
# Backup system locale settings
l <- Sys.getlocale()

# Fix for Ukrainian characters
Sys.setlocale('LC_ALL', 'Ukrainian')

Loading data

Ukrainian EIT 2016 data can be downloaded from official EIT Ukrainian web page or from Github repo as a 7z archive file. To run following code you have to extract OpenData2016.csv file into working directory.

eit.data <- read.csv2("OpenData2016.csv", sep = ";", encoding = "Windows-1251", dec = ",",  na.strings="null")

Exploration by regions

Group EIT data by regions

# Substract needed data
eit.data.reg.sub <- data.frame(eit.data$Regname, eit.data$UkrBall100, eit.data$HistBall100, 
                      eit.data$MathBall100, eit.data$PhysBall100, eit.data$ChemBall100, 
                      eit.data$BioBall100, eit.data$GeoBall100, eit.data$EngBall100, 
                      eit.data$FrBall100, eit.data$DeuBall100, eit.data$SpBall100, 
                      eit.data$RusBall100)

# Group data by regions
eit.data.reg <- aggregate(eit.data.reg.sub[, 2:ncol(eit.data.reg.sub)], 
                      by = list(eit.data.reg.sub$eit.data.Regname), FUN = mean, na.rm=TRUE)
colnames(eit.data.reg) <- c("Region", "UkrLngLit", "UkrHist", "Math", "Phys", "Chem", 
                        "Bio", "Geo", "Eng", "Fr", "Deu", "Sp", "Rus")

# Add Crimea and Sevastopol regions
eit.data.reg$Region <- as.character(eit.data.reg$Region)
eit.data.reg <- rbind(eit.data.reg, c("АР Крим", NA, NA, NA, NA,NA, NA, NA))
eit.data.reg <- rbind(eit.data.reg, c("м. Севастополь", NA, NA, NA, NA, NA, NA, NA))
eit.data.reg <- eit.data.reg[order(eit.data.reg$Region) ,]

# Fix numeric columns type
for(i in 2:ncol(eit.data.reg)){eit.data.reg[[i]] <- as.numeric(as.character(eit.data.reg[[i]]))}

Spatial data processing

To draw map charts we need to prepare some spatial data. Download shape files archive for Ukraine administrative map from DIVA-GIS web page and extract it into working directory. Let’s read spatial data

states.shp <- readOGR(dsn="UKR_adm",layer="UKR_adm1")
## OGR data source with driver: ESRI Shapefile 
## Source: "UKR_adm", layer: "UKR_adm1"
## with 27 features
## It has 16 fields
states.shp.f <- fortify(states.shp, region = "ID_1")

Now we need to put together regions from EIT data and polygons from shape data. This will be done in several steps:

1.Extract region names from EIT data

reg.names.cyr <- eit.data.reg$Region

2.Since region names are in Cyrillic, we will transliterate them using any online transliteration service, on ex. this

reg.names.tsl <-  c("AR Krym", "Vinnytska oblast", "Volynska oblast", "Dnipropetrovska oblast",
    "Donetska oblast", "Zhytomyrska oblast", "Zakarpatska oblast", "Zaporizka oblast",
    "Ivano-Frankivska oblast", "Kyivska oblast", "Kirovohradska oblast", "Luhanska oblast",
    "Lvivska oblast", "m. Sevastopol", "m. Kyiv", "Mykolaivska oblast", "Odeska oblast",
    "Poltavska oblast", "Rivnenska oblast", "Sumska oblast", "Ternopilska oblast",
    "Kharkivska oblast", "Khersonska oblast", "Khmelnytska oblast", "Cherkaska oblast",
    "Chernivetska oblast", "Chernihivska oblast")

3.Get GPS coordinates for each region and store it as SpatialPoints

p4s <- proj4string(states.shp)
oblpts <- c()
for(obl in reg.names.tsl) {
    latlon <- geocode(obl)
    point <- SpatialPoints(latlon, proj4string = CRS(p4s))
    oblpts <- c(oblpts, point)
}

4.For each region SpatialPoint search appropriate shape polygon

states.shp.f <- fortify(states.shp, region = "ID_1")
reg_ids <- unique(states.shp.f$id)
obl_reg_ids <- c()

for(i in 1:length(oblpts)) {
    point <- oblpts[[i]]
    for(reg_id in reg_ids) {
        reg_indx <- match(c(as.numeric(reg_id)), states.shp@data$ID_1)[1]
        region <- states.shp[reg_indx, ]
        if(gContains(region, point)) {
            obl_reg_ids <- c(obl_reg_ids, reg_id)
            # print(paste(region$NAME_1, strtranslit[[i]],sep = " == "))
        }
    }
}

5.Merge all calculated data and prepare it for plotting

eit.data.reg.shp <- data.frame(eit.data.reg, obl_reg_ids)
colnames(eit.data.reg.shp)[ncol(eit.data.reg.shp)] <- "id"
merge.shp.coef <- merge(states.shp.f, eit.data.reg.shp, by="id", all.x = TRUE)
eit.data.reg.plot <- merge.shp.coef[order(merge.shp.coef$order), ]

Map plotting helper function

getMapPlot <- function(data, xColN, yColN, groupColN, fillColN, palette, title, margin){
    plot <- ggplot() + 
        geom_polygon(data = data, 
                     aes(x = data[[xColN]], y = data[[yColN]], group = data[[groupColN]], 
                         fill = data[[fillColN]]), color = "black", size = 0.25) + 
        coord_map()+
        scale_fill_distiller(name = "Оцінка за шкалою 100-200", palette = palette, direction = 1) +
        theme_nothing(legend = TRUE) +
        labs(title = title) + 
        theme(plot.title = element_text(hjust = 1, margin = margin, size = 36),
              legend.title = element_text(size = 20),
              legend.text = element_text(size = 16),
              legend.key.size = unit(2,"cm"),
              legend.position="bottom",
              legend.direction="horizontal") +
        guides(fill = guide_colorbar(title.position = "top", title.hjust = 0.5))
    return(plot)    
}

EIT results by regions - main disciplines

tlMar <- margin(t = 5, b = 0)
p1 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "UkrHist", "Blues", "Історія України", tlMar)
p2 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Geo", "BuGn", "Географія", tlMar)
p3 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Bio", "PuRd", "Біологія", tlMar)
p4 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Math", "YlGn", "Математика", tlMar)
p5 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Phys", "BuPu", "Фізика", tlMar)
p6 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Chem", "OrRd", "Хімія", tlMar)
p7 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "UkrLngLit", "Reds", "Українська мова та література", tlMar)

grid.arrange(p1,p2,p3,p4,p5,p6,p7, ncol=3, 
             top = textGrob("Результати тестів ЗНО 2016 - за регіонами - основні предмети", 
                            gp = gpar(fontsize = 50, font = "bold")), 
             layout_matrix = rbind(c(1,2,3), c(4,5,6), c(7,7,7)))

EIT results by regions - foreign languages

tlMar <- margin(t = 20, b = -30)

p1 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Eng", "Blues", "Англійська", tlMar)
p2 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Fr", "BuGn", "Французька", tlMar)
p3 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Deu", "PuRd", "Німецька", tlMar)
p4 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Sp", "OrRd", "Іспанська", tlMar)
p5 <- getMapPlot(eit.data.reg.plot, "long", "lat", "group", "Rus", "YlGn", "Російська", tlMar)

grid.arrange(p1,p2,p3,p4,p5, ncol=2, 
             top = textGrob("Результати тестів ЗНО 2016 - за регіонами - іноземні мови", 
                               gp = gpar(fontsize = 50, font = "bold")),
             layout_matrix = rbind(c(1,1), c(2,3), c(4,5)))

Exploration by gender

Group EIT results by gender

# Substract needed data
eit.data.gnd.sub <- data.frame(eit.data$SexTypeName, eit.data$UkrBall100, eit.data$HistBall100, 
                      eit.data$MathBall100, eit.data$PhysBall100, eit.data$ChemBall100, 
                      eit.data$BioBall100, eit.data$GeoBall100, eit.data$EngBall100, 
                      eit.data$FrBall100, eit.data$DeuBall100, eit.data$SpBall100, 
                      eit.data$RusBall100)

# Group data by gender
eit.data.gnd <- aggregate(eit.data.gnd.sub[, 2:ncol(eit.data.gnd.sub)], 
                      by = list(eit.data.gnd.sub$eit.data.SexTypeName), FUN = mean, na.rm = TRUE)
colnames(eit.data.gnd) <- c("Gender", "Українська мова та література", "Історія України", 
                            "Математика", "Фізика", "Хімія", "Біологія", "Географія", 
                            "Англійська", "Французька", "Німецька", "Іспанська", "Російська")
eit.data.gnd.melted <- melt(eit.data.gnd, id.vars=c("Gender"))

# Order factor properly
eit.data.gnd.melted$variable <- factor(eit.data.gnd.melted$variable, 
                                 levels = levels(eit.data.gnd.melted$variable)[12:1], ordered = TRUE)

eit.data.gnd.melted.m <- subset(eit.data.gnd.melted, Gender == "чоловіча")
eit.data.gnd.melted.f <- subset(eit.data.gnd.melted, Gender == "жіноча")

Prepare additional SVG decoration

To supply male/female silhouettes as a decoration for chart, we will download People SVG graphic (by Chris Dawson, GB), convert it into PostScript using this online service, place it in the working directory and by using installed GhostScript, recode it into RGML format:

# GhostScript installation directory
Sys.setenv(R_GSCMD='"C:/Program Files (x86)/gs/gs9.20/bin/gswin32c.exe"') 
PostScriptTrace("male.ps")
PostScriptTrace("female.ps")

EIT results by gender

img.male <- pictureGrob(readPicture("male.ps.xml"))
img.female <- pictureGrob(readPicture("female.ps.xml"))

p <- ggplot(data=eit.data.gnd.melted,aes(x=variable, y = value, fill=Gender)) +
    geom_bar(data=eit.data.gnd.melted.f, stat = "identity") + 
    geom_bar(data=eit.data.gnd.melted.m, stat = "identity", position = "identity", 
             mapping = aes(y = -value)) + 
    
    scale_y_continuous(breaks=seq(-200,200,50),labels=abs(seq(-200,200,50))) + 
    geom_text(data = eit.data.gnd.melted.f, 
              aes(variable, value, group=Gender, label=format(value, digits=2, nsmall=2)),
              hjust = 1.25, vjust = 0.5, size=15) +
    geom_text(data = eit.data.gnd.melted.m, 
              aes(variable, -value, group=Gender, label=format(value, digits=2, nsmall=2)),
              hjust = -0.25, vjust = 0.5, size=15) +
    geom_text(data = eit.data.gnd.melted, 
              aes(x = variable, y = 0, label=variable), hjust = 0.5, vjust = 0.5, size=16) +
    coord_cartesian(ylim = c(-1500, 1500)) +
    theme_nothing(legend = FALSE) +
    coord_flip()
grid.arrange(img.male, p, img.female, ncol=3, widths=c(10, 80, 10), 
             top = textGrob("Результати тестів ЗНО 2016 - за статтю (Оцінка за шкалою 100-200)", 
                            gp = gpar(fontsize = 50, font = "bold")))

Exploration by age

Substract EIT results age data

# Substract needed data applying age calculation based on EIT year and birth year from data
eit.data.age.sub <- data.frame(2016 - eit.data$Birth, eit.data$UkrBall100, eit.data$HistBall100, 
                      eit.data$MathBall100, eit.data$PhysBall100, eit.data$ChemBall100, 
                      eit.data$BioBall100, eit.data$GeoBall100, eit.data$EngBall100, 
                      eit.data$FrBall100, eit.data$DeuBall100, eit.data$SpBall100, 
                      eit.data$RusBall100)
colnames(eit.data.age.sub)[1] <- "Age"

Age distribution in EIT data

eit.data.age.cnt <- aggregate(eit.data.age.sub$Age, by = list(eit.data.age.sub$Age), FUN = length)
colnames(eit.data.age.cnt) <- c("Age", "Count")
ggplot(eit.data.age.cnt, aes(x = factor(Age), y = Count)) + 
    geom_bar(stat = "identity") + theme_gray() +
    labs(title = "Розподіл екзаменованих під час ЗНО 2016 за віком", x = "Вік", y = "Кількість") + 
        theme(plot.title = element_text(size = 36),
              axis.title = element_text(size = 20),
              axis.text = element_text(size = 16))

Age distribution cut off

To save chart space, let’s cut off 0.1 % of least frequent age data

eit.data.age.cut <- eit.data.age.cnt[eit.data.age.cnt$Count/sum(eit.data.age.cnt$Count) > 0.001,]
ggplot(eit.data.age.cut, aes(x = factor(Age), y = Count)) + 
    geom_bar(stat = "identity") + theme_gray() +
    labs(title = "Розподіл екзаменованих під час ЗНО 2016 за віком - фільтр 0.1 % вибірки", x = "Вік", y = "Кількість") + 
        theme(plot.title = element_text(size = 36),
              axis.title = element_text(size = 20),
              axis.text = element_text(size = 16))

Group EIT results by age

eit.data.age <- aggregate(eit.data.age.sub[, 2:ncol(eit.data.age.sub)], 
                      by = list(eit.data.age.sub$Age), FUN = mean, na.rm=TRUE)

colnames(eit.data.age) <- c("Age", "Українська мова та література", "Історія України", 
                            "Математика", "Фізика", "Хімія", "Біологія", "Географія", 
                            "Англійська", "Французька", "Німецька", "Іспанська", "Російська")

# Apply 0.01 % cut off
eit.data.age <- eit.data.age[eit.data.age$Age %in% eit.data.age.cut$Age,]

eit.data.age.melted <- melt(eit.data.age, id.vars=c("Age"))
eit.data.age.melted$variable <- factor(eit.data.age.melted$variable, levels = levels(eit.data.age.melted$variable)[12:1], ordered = TRUE)

EIT results by age

library(cowplot)

hm <- ggplot(data = eit.data.age.melted, aes(x=factor(Age), y=variable, fill=value)) + 
    geom_tile() + 
    scale_fill_distiller(name = "Оцінка за шкалою 100-200", palette = "Blues", direction = 1, na.value = "transparent") +
    scale_x_discrete(breaks=unique(eit.data.age.melted$Age),labels=unique(eit.data.age.melted$Age)) +
    theme_gray() +
    theme(legend.position="bottom",
          legend.direction="horizontal",
          legend.title = element_text(size = 40, margin=margin(20,0,0,0)),
          legend.key.size = unit(3,"cm"),
          legend.text = element_text(size = 30)
          ) +
    guides(fill = guide_colorbar(title.position = "top", title.hjust = 0.5))

eit.data.age.avg <- aggregate(eit.data.age.melted$value, by = list(eit.data.age.melted$Age), 
                              FUN = mean, na.rm=TRUE)
colnames(eit.data.age.avg) <- c("Age", "ScoreAvg")

eit.data.dis.avg <-aggregate(eit.data.age.melted$value, by = list(eit.data.age.melted$variable), 
                             FUN = mean, na.rm=TRUE)
colnames(eit.data.dis.avg) <- c("Discipline", "ScoreAvg")

ageBG <- ggplot(data = eit.data.age.avg, aes(x=factor(Age), y=ScoreAvg)) + 
    geom_bar(stat="identity", aes(fill=ScoreAvg)) + 
    theme_gray() +
    theme(axis.title.y=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks.y=element_blank(),
          axis.title.x = element_text(size = 40, margin=margin(20,0,0,0)),
          axis.text.x = element_text(size = 30),
          legend.position="none") +
    scale_fill_distiller(name = "Score", palette = "Blues", direction = 1) + 
    labs(x = "Вік")

ageBGFlip <- switch_axis_position(ageBG, "x")

discBG <- ggplot(data = eit.data.dis.avg, aes(x=Discipline, y=ScoreAvg)) + 
    geom_bar(stat="identity", aes(fill=ScoreAvg)) +
    coord_flip() + 
    theme_gray() +
    theme(axis.title.x=element_blank(),
          axis.text.x=element_blank(),
          axis.ticks.x=element_blank(),
          axis.title.y = element_text(size = 40, margin=margin(0,0,0,20), angle = -90),
          axis.text.y = element_text(size = 30),
          legend.position="none") +
    scale_fill_distiller(name = "Score", palette = "Blues", direction = 1) + 
    labs(x = "Предмети")

discBGFlip <- switch_axis_position(discBG, "y")

# Substract legend for heatmap
tmp <- ggplot_gtable(ggplot_build(hm))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]

# Remove legend from heatmap
hmNoLg <-hm +
    theme(axis.title.y=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks.y=element_blank(),
            axis.title.x=element_blank(),
                    axis.text.x=element_blank(),
                    axis.ticks.x=element_blank(),
          legend.position="none")

#grid.newpage()
gg <- arrangeGrob(ageBGFlip, legend, hmNoLg, discBGFlip, 
                  nrow = 2, ncol = 2, widths = c(50, 30), heights = c(30, 70),
                  padding = c(0,0,0,0))
grid.draw(gg)

detach("package:cowplot", unload=TRUE)

Restore locale

# Restore system locale settings
for(locale.item in strsplit(l, ";")) { 
    li <- strsplit(locale.item, "=")
    Sys.setlocale(category = li[[1]][1], locale = li[[1]][2])
}