Autor*innen: Daniel Deimel
Die Grafik zeigt die Verteilung der Leistungen in Naturwissenschaften (WLE) in 2012 und 2013, jeweils getrennt für Gymnasien und nicht-gymnasiale Schulformen. Es zeigt sich tendenziell, dass die Leistungen über ein Jahr vor allem im oberen Leistungsbereich an Gymnasien gestiegen sind. Dies gäbe Anlass für vertiefende Analysen schulformspezifischer Effekte. Die Grafik nutzt den Datensatz des PISA Plus-Campus Files und wurde mit ggplot2 erstellt. Hierbei wird eine Kombination aus Boxplot und Split Violin Plot verwendet.
—
#####################################################################
# digiGEBF21 data challenge (Daniels contribution)
library(dplyr)
library(ggplot2)
#####################################################################
# define function geom_split_violin
# function documented by user jan-glx on stackoverflow
# https://stackoverflow.com/users/1870254/jan-glx
GeomSplitViolin <- ggproto(
„GeomSplitViolin“,
GeomViolin,
draw_group = function(self, data, …, draw_quantiles = NULL) {
data <- transform(data,
xminv = x – violinwidth * (x – xmin),
xmaxv = x + violinwidth * (xmax – x))
grp <- data[1,’group‘]
newdata <- plyr::arrange(
transform(data, x = if(grp%%2==1) xminv else xmaxv),
if(grp%%2==1) y else -y
)
newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])
newdata[c(1,nrow(newdata)-1,nrow(newdata)), ‚x‘] <- round(newdata[1, ‚x‘])
if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))
quantiles <- ggplot2:::create_quantile_segment_frame(data, draw_quantiles)
aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c(„x“, „y“)), drop = FALSE]
aesthetics$alpha <- rep(1, nrow(quantiles))
both <- cbind(quantiles, aesthetics)
quantile_grob <- GeomPath$draw_panel(both, …)
ggplot2:::ggname(„geom_split_violin“,
grid::grobTree(GeomPolygon$draw_panel(newdata, …), quantile_grob))
} else {
ggplot2:::ggname(„geom_split_violin“, GeomPolygon$draw_panel(newdata, …))
}
}
)
geom_split_violin <- function (mapping = NULL,
data = NULL,
stat = „ydensity“,
position = „identity“, …,
draw_quantiles = NULL,
trim = TRUE,
scale = „area“,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(data = data,
mapping = mapping,
stat = stat,
geom = GeomSplitViolin,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(trim = trim,
scale = scale,
draw_quantiles = draw_quantiles,
na.rm = na.rm, …)
)
}
#####################################################################
# PISA Plus Campus File provided by IQB FDZ
# http://doi.org/10.5159/IQB_PISA_Plus_2012-13_CF_v1
# load dataset
load(file = „./data/PISA-Plus-2012-2013_Dataset_CF.rda“)
# create subset
pisa_dat <- pisa_2012_2013_data %>%
select(.,
idstud,
schtype,
sci_wle_t1,
sci_wle_t2) %>%
# dichotomize & rename school type
mutate(.,
school_type = case_when(
schtype == „schools with several courses of education“ ~ „Other“,
schtype == „Realschule“ ~ „Other“,
schtype == „Gymnasium (academic track)“ ~ „Gymnasium (academic track)“
))
# change order of school_type (because the results looks nicer)
pisa_dat$school_type <- as.factor(pisa_dat$school_type)
pisa_dat$school_type <- with(pisa_dat,
relevel(school_type, „Other“))
# prepare catergorial variable required for side by side comparison
# one row for each t, assign correct wle to each t category
pisa_dat_split_sci <-
tidyr::gather(pisa_dat, „sci_wle_t1“, „sci_wle_t2“,
key = „sci_t“,
value = „sci_wle“) %>%
mutate(.,
sci_t = case_when(
sci_t == „sci_wle_t1“ ~ „2012 (t1)“,
sci_t == „sci_wle_t2“ ~ „2013 (t2)“
))
#####################################################################
# define theme
bgcolor <- „#ffffff“
textcolor <- „#000000“
daniels_theme <- theme(
plot.background = element_rect(fill = bgcolor,
colour = bgcolor),
panel.background = element_rect(fill = NA),
panel.grid = element_line(colour = „#d3d3d3“,
size = 0.2),
panel.grid.major.x = element_blank(),
legend.position = „bottom“,
legend.margin = margin(),
text = element_text(colour = textcolor,
family = „serif“,
size = 18),
plot.title = element_text(color = textcolor,
face = „bold.italic“,
size = 18,
hjust = 0.5))
# create plot
ggplot(pisa_dat_split_sci, aes(sci_t , sci_wle, fill = school_type)) +
geom_hline(yintercept = 0,
color = „#000000“,
size = 0.2) +
geom_split_violin(color = textcolor,
trim = FALSE,
alpha = 0.5) +
geom_boxplot(color = textcolor,
width = 0.1,
position = position_dodge(width = 0.3)) +
ylab(„Science Achievement (WLE)“) +
xlab(„Year“) +
ggtitle(„Distribution of Science Achievement\nCompared across School Types and Year“) +
ylim(-5, 5) +
scale_fill_manual(name = „School Type“,
values = c(„#cc3dad“, „#3dbbcc“)) +
daniels_theme
#####################################################################
GEBF 2023 