Im Juni und September 2016 haben wir uns in einem automatisierten Prozess auf 6798 Wohnungsannoncen in Berlin, Leipzig, München, Magdeburg, Dortmund, Köln, Nürnberg, Frankfurt, Dresden, Hamburg beworben. Die Absender der 20728 E-Mail-Anfragen unterschieden sich lediglich im Namen, der auf einen deutschen, arabischen, türkischen, italienischen oder polnischen Hintergrund schließen lässt. In ihren sonstigen Eigenschaften waren die Personen identisch – zwischen 20 und 30 Jahre alt, Berufseinsteiger in einer Agentur, mit Anschreiben in perfektem Deutsch. Männer und Frauen waren gleich häufig vertreten.
Auf die Anfragen erhielten wir rund 8000 Antworten, die wir händisch in Kategorien einsortierten. Nur so konnten wir sicher erfassen, ob ein Bewerber zur Wohnungsbesichtigung eingeladen wurde oder nicht. Das Ergebnis ist ein Datensatz, der ein Schlaglicht auf den deutschen Mietwohnungsmarkt wirft, und zugleich groß genug ist, um signifikante Unterschiede zwischen Nationalitäten, Geschlechtern und Städten zu zeigen.
persons = read_excel("input/persons.xlsx") %>%
# modifying value "extreme", since aggregation of both extremes doesn't make sense
mutate(typ = ifelse(name == "Carsten Meier", "extreme positive", typ)) %>%
mutate(typ = ifelse(name == "Lovis Kuhn", "extreme negative", typ)) %>%
rename(kuerzel = reihenfolge)
confirmations = read_csv("input/confirmations.csv",
col_types = cols(
date = col_datetime(format = "%Y-%m-%dT%H:%M:%S%Z"),
delta = col_double(),
delta_bin = col_number())) %>%
rename(link = flat_link) %>%
mutate(run = ifelse(date < as.Date("2016-08-31"), 1, 2)) %>%
mutate(duplicate = (duplicate == "true")) %>%
mutate(first = (first == "true"))
flats = read_csv("input/flats.csv",
col_types = cols(
request_date = col_date(format = "%Y-%m-%d"),
request_datetime = col_datetime(format = "%Y-%m-%dT%H:%M:%S%Z"),
flat_meta.price = col_double(),
flat_meta.surface = col_double())) %>%
# add column run analogue to mails
mutate(run = ifelse(request_date < as.Date("2016-08-31"), 1, 2)) %>%
mutate(geography = ifelse(city %in% c("berlin", "dresden", "leipzig", "magdeburg"), "ost", "west")) %>%
# calculate a 'normalized' order concerning only non-duplicate requests from normal profiles
mutate(
order_normal = gsub("[xy]", "", order),
# convert first occurence of a person from each nationality
order_normal = sub("a", "A", order_normal),
order_normal = sub("i", "I", order_normal),
order_normal = sub("p", "P", order_normal),
order_normal = sub("t", "T", order_normal),
order_normal = sub("g", "G", order_normal),
# remove duplicate occurences
order_normal = gsub("[aiptg]", "", order_normal),
order_normal = tolower(order_normal)
)
# select immowelt-version of flats inserated on both websites (with same title)
flats_duplicates_immowelt = flats %>%
group_by(city, flat_meta.price, flat_meta.surface, request_date, flat_meta.title) %>%
summarise(n = n(), website_distinct = n_distinct(website), link = max(link), run = max(run)) %>%
select(-flat_meta.title) %>%
filter(n == 2) %>%
arrange(website_distinct) %>%
filter(website_distinct == 2)
# select immowelt-version of flats inserated on both websites (without same title)
flats_duplicates_immowelt_excl = flats %>%
group_by(city, flat_meta.price, flat_meta.surface, request_date) %>%
summarise(n = n(), website_distinct = n_distinct(website), link = max(link), run = max(run)) %>%
filter(n == 2) %>%
arrange(website_distinct) %>%
filter(website_distinct == 2)
flats = flats %>%
anti_join(flats_duplicates_immowelt, by = c("link", "run")) %>%
anti_join(flats_duplicates_immowelt_excl, by = c("link", "run"))
# e.g. flats whose owners uncovered our experiment
flatsTrash = read_csv("input/_flats_trash.csv",
col_types = cols(
request_date = col_date(format = "%Y-%m-%d"),
request_datetime = col_datetime(format = "%Y-%m-%dT%H:%M:%S%Z"),
flat_meta.price = col_double(),
flat_meta.surface = col_double())) %>%
# add column run analogue to mails
mutate(run = ifelse(request_date < as.Date("2016-08-31"), 1, 2))
mails = read_excel("input/mails.xlsx",
col_types = c("text", "text", "text", "text",
"numeric", "numeric", "numeric", "text")) %>%
# consistent NA-values
mutate_each(funs(replace(., . == "NA", NA))) %>%
mutate_each(funs(replace(., . == ",", NA))) %>%
mutate(zeit = parse_datetime(zeit)) %>%
# Absender nicht 100% konsistent. Manueller fix:
mutate(person = ifelse(person == "drcarstenmeier@gmail.com", "carsten.j.meier@gmail.com", person)) %>%
mutate(person = ifelse(person == "dan.bschle.im@gmail.com", "danielbuschle2@gmail.com", person)) %>%
mutate(person = ifelse(person == "maryam.abedini.im@gmail.com", "ma03592@gmail.com", person)) %>%
mutate(person = ifelse(person == "milena.adamowicz.im@gmail.com", "madameowicz@gmail.com", person)) %>%
# Entferne Mails an Gulsen Demirci (TODO: in Excel)
filter(!person == "gulsen.demirci.im@gmail.com") %>%
filter(!is.na(person)) %>%
# Remove because of inconsistent categorizing (TODO: in Excel)
filter(!(id %in% c("ObjectId(578793e9a013d54b71559407)", "ObjectId(5788e55ba013d54b7155944a)", "ObjectId(578793e4a013d54b71559401)"))) %>%
# Remove mail-duplicates (no usage of unique() because of property id)
distinct(zeit, person, flat_id, .keep_all = TRUE) %>%
# setNames(gsub("ErsterWertvon", "", names(.))) %>%
rename(run = scraping_run) %>%
rename(link = flat_link) %>%
mutate(link = ifelse(is.na(link), "unknown", link))
update_links = function(path) {
# update mails_meta with corrected links from new CSV-file
mails_updated = read_csv(path, trim_ws = TRUE)
mails %>%
left_join(mails_updated, by = c("id")) %>%
mutate(link = ifelse(is.na(link.y), link.x, link.y)) %>%
select(-link.x, -link.y)
}
mails = update_links("input/_add_links_short.csv")
mails = update_links("input/_add_links_5_7_short.csv")
mails = update_links("input/_fix_links_short.csv")
mails = update_links("input/_fix_links_round2_short.csv")
# TODO: no (--> cat6) in Excel
mails = mails %>%
filter(link != "no" & link != "pre" & link != "quoka" & link != "stage0")
# remove mails that relate to black-listed flats
mails = mails %>%
anti_join(flatsTrash, by = c("link", "run"))
################################## JOIN METADATA TO UNITS ##################################
mails_meta = mails %>%
left_join(persons, by = c("person" = "mail_1")) %>%
select(id, zeit, category, link, person,
run, herkunft, typ, migrationshintergrund, geschlecht, name, kuerzel)
# dynamically join flat metadata to mails
mails_meta = mails_meta %>%
left_join(flats, by = c("link", "run")) %>%
rename(flat_metaprice = flat_meta.price) %>%
rename(scrape_date = request_date)
find_positions = function(patterns, texts) {
# returns vector with position of i-th element in patterns in i-th element of texts
apply(cbind(patterns, texts), 1, function(v) { regexpr(v[1], v[2]) })
}
confirmations_meta = confirmations %>%
left_join(persons, by = c("person" = "mail_1")) %>%
inner_join(flats %>% select(link, run, order_normal), by = c("link", "run")) %>%
mutate(position_normal = find_positions(kuerzel, order_normal))
flats_meta = flats %>%
left_join(confirmations_meta %>% select(link, run, geschlecht) %>% unique(), by = c("link", "run"))Im Kern besteht der Datensatz aus vier Tabellen:
dir.create("data")
write_csv(flats %>% select(`_id`, link, website, request_time, request_date, request_datetime, flat_meta.price, flat_meta.surface, city, order, orga, run), "data/flats.csv")
write_csv(persons, "data/persons.csv")
write_csv(mails %>% select(-flat_id), "data/mails.csv")
write_csv(confirmations, "data/confirmations.csv")| Kategorie | Umschreibung |
|---|---|
| 1 | positv: Zusage eines Besichtigungstermins |
| 2 | positive Tendenz: Ein Besichtigungstermin wird in Aussicht gestellt |
| 3 | Kenntnise: Anfrage wurde zur Kenntnis genommen. Enthält keine Wertung |
| 4 | negativ: Absage |
| 5 | Wohung nicht verwertbar: z.B. Seniorenwohnanlage, WG-Zimmer |
| 6 | Mail nicht verwertbar: keine relevante Aussage (z.B. Newsletter) |
| 7 | Makler-Masche: Versuchtes Umgehen des Besteller-Prinzips |
| 8 | Spam/Scam: Ohne Aussage hinsichtlich der Diskriminierung |
# black-list of mails because of category
mails_cat578 = mails_meta %>%
filter(category == 5 | category == 7 | category == 8)
mails_meta = mails_meta %>%
# filter mails relating to flats that were assigned 5, 7 or 8
anti_join(mails_cat578 %>% filter(link != "unknown"), by = c("link", "run"))
mails_linked = mails_meta %>%
filter(link != "unknown")
flats_meta = flats_meta %>%
anti_join(mails_cat578, by = c("link", "run"))
confirmations_meta = confirmations_meta %>%
anti_join(mails_cat578, by = c("link", "run"))
confirmations_meta_unique = confirmations_meta %>%
filter(duplicate != TRUE) %>%
inner_join(flats %>% select(link, run, orga, city, order), by = c("link", "run"))Für die folgenden Analysen wurden die einzelnen Datensätze jeweils gejoint (Namenssufix “_meta“). So enthält der data frame mails_meta nicht nur die Informationen zu den klassifizierten Antwortschreiben sondern auch die Personenmerkmale des fiktiven Charakters, der die Bewerbung gesendet hat sowie Metainformationen zur angefragten Wohnung. Entfernt wurden aus diesen Datensätzen zudem sämtliche Wohnungsannoncen, registierte Anfragen sowie eingegange Antworten von Anbietern, die uns im Lauf der Auswertung nicht verwertbare Antworten zugesendet habe (Kategorien 5,7 & 8).
Neben deskriptiven Auswertungen führen wir Regressionen durch um Erstere entweder abzusichern oder die Ergebnisse aus dem Modell direkt in der Berichterstattung zu verwenden. Ein Ziel ist es dabei, den Effekt einer im Interesse stehenden Variable von Verzerrungen durch andere Faktoren zu separieren (sprich diese zu “kontrollieren”).
Zur Methode: Wir rechnen eine logistische Regression mit einem Zufallsfaktor (Random Intercept) je ausgeschriebener Wohnung. Wir modellieren damit die Auswirkungen verschiedener Faktoren auf die Wahrscheinlichkeit, eine positive Rückmeldung auf eine Wohnungsanfrage zu erhalten. Die resultierenden Koeffizienten einer logistischen Regression beziehen sich auf logarithmierte Chancen (logits) und sind inhaltlich nur schwer interpretierbar. Daher verwenden wir in der Auswertung Average Marginal Effects (AMEs): Sie beschreiben den durchschnittlichen Effekt eines Faktors auf die Wahrscheinlichkeit eine positiven Antwort zu erhalten.
glmermfx <- function(x, nsims = 1000){
# implements a funtion to calculate AMEs for mixed model GLMs
# and its standard errors (for latter: Krinsky and Robb method)
set.seed(1984)
# fitted returns the predicted probabilities
# equivalences: -log((1-p)/p)) == log(p/(1-p)) == logit == x' * beta
# pdf is the average value of all approprietly transformed predicted values
pdf <- mean(dlogis(-log((1 - fitted(x)) / fitted(x))))
# error in working paper: pdfsd does not measure the standard error, but the standard deviation of the predicted probabilities
# pdfsd <- sd(dlogis(-log((1-fitted(x))/fitted(x))))
marginal.effects <- pdf * fixef(x)
# sim simulates 1000 fixef-vectors (based on fixef(x) and its standard errors)
sim <- matrix(rep(NA, nsims * length(fixef(x))), nrow = nsims)
for(i in 1:length(fixef(x))){
sim[ ,i] <- rnorm(nsims, fixef(x)[i],diag(vcov(x)^0.5)[i])
}
# transpose sim in order to select fixed effects per Simulation
sim_t <- as.list(data.frame(t(sim)))
# simulate pdf a 1000 times using the simulated fixed effects
pdfsim <- sapply(sim_t, function(b) {
names(b) = names(fixef(x))
mean(dlogis(predict(x, type = "link", newparams = list(beta = b))))
})
# error in working paper because of pdfsd (see above):
# pdfsim <- rnorm(nsims,pdf,pdfsd)
# calculate 1000 AMEs (same dimension as sim)
sim.se <- pdfsim * sim
# error in working paper:
# res <- cbind(marginal.effects,sd(sim.se))
# instead:
res <- cbind(marginal.effects, apply(sim.se, 2, sd))
colnames(res)[2] <- "standard.error"
# calculation of p-values
# assumption: AMEs normal-distributed with E(AME) = AME
# z-value = AME / se(AME)
# verified with logitmfx
res <- cbind(res, 2 * pnorm(-abs(res[ ,1] / res[ ,2])))
colnames(res)[3] <- "p-value"
ifelse(names(fixef(x))[1] == "(Intercept)", return (res[2:nrow(res), ]), return(res))
}
calculate_regression = function(flats_both, var_interact = NULL, vars_exclude = NULL) {
# calculates mixed model for requests made to flats in flats_both (1 row ~ 1 flat ~ 2 requests)
# var_interact is expected to be a single string
# vars_exclude is expected to be a vector of strings
# convert flats_both to long-format (1 row ~ 1 request)
flats_both_long = gather(flats_both, nat, positive, positive_ref, positive_req, factor_key = TRUE) %>%
mutate(
# extract "ref" or "req"
nat = substr(nat, 10, 12),
second = !first,
position = ifelse(nat == "req", second + 1, first + 1),
positive = as.numeric(positive),
geschlecht = factor(geschlecht),
nat = factor(nat),
position = factor(position),
# uncomment run and city when running simulate_auspurg()
run = factor(run),
city = ifelse(city=="münchen", "_münchen", city)
)
if (is.null(var_interact)) {
# default forumula for regression
s = "positive ~ nat + city + orga + geschlecht + position + run + (1 | link)"
} else {
s = paste0("positive ~ ", var_interact, " * ", "nat + city + orga + geschlecht + position + run + (1 | link)")
}
if (!is.null(vars_exclude)) {
exclude_var = function (formula_string, var_exclude) {
# excludes variable var_exclude from formula
gsub(paste0(" + ", var_exclude), "", formula_string, fixed = TRUE)
}
# exclude each var in vars_exclude from formula
s = Reduce(exclude_var, vars_exclude, init = s)
}
print(s)
f = formula(s)
# estimate the model and store results in m
m <- glmer(f, data = flats_both_long, family = binomial(link = logit), control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)
# OR-estimates with 95% CIs (see http://stats.idre.ucla.edu/r/dae/mixed-effects-logistic-regression/)
se <- sqrt(diag(vcov(m)))
tab <- cbind(Est = fixef(m), LL = fixef(m) - 1.96 * se, UL = fixef(m) + 1.96 * se)
exp(tab)
print(glmermfx(m))
m
}Zur Implementierung: Die Berechnung der marginalen Effekte im logistischen Modell ist dem Working Paper Simple Logit and Probit Marginal Effects in R von Alan Fernihough entnommen. Die Berechnung der Standardfehler wurde korrigiert und wird nach der Methode von Krinsky and Robb berechnet.
Am klarsten lässt sich Diskriminierung erkennen, wenn unsere fiktiven Personen bei der Bewerbung auf eine identische Wohnung unterschiedliche Antworten erhalten haben. Als Grundgesamtheit betrachten wir also Wohnungen, die von einer Persona der jeweiligen Minderheit (arabisch, italienisch, polnisch, türkisch) und einer deutschen Persona erfolgreich angeschrieben wurde. Die Zahl auswertbarer Wohnungen je Nationalität beträgt:
# set reference nationality against which to evalutate discrimination
# g: "german"
nat_ref = "g"
nats_f_long = c("arabisch", "italienisch", "polnisch", "türkisch")
nats_f = c("a", "i", "p", "t")
calculate_flats_both = function(nat_req, nat_ref) {
# returns flats that were correctly requested by a 2-tuple of persons of the requested nationality nat_ref and the reference nationality nat_req
# flats requested from tuple nat_ref * nat_req
flats_both = flats_meta %>%
filter(grepl(nat_ref, order)) %>%
filter(grepl(nat_req, order))
# all mails linked with a flat from flats_both
mails_both = mails_linked %>%
semi_join(flats_both, by = c("link", "run"))
calculate_flats_cat = function(nat) {
# calculates flats that received at least 1 email from the corresponding persona of nationality nat and the lowest category in case of several emails
cat = paste("cat_", ifelse(nat == nat_ref, "ref", "req"), sep = "")
# flatwise select lowest category assigned to corresponding persona of nationality nat
mails_both %>%
filter(kuerzel == nat) %>%
group_by(link, run) %>%
filter(category == min(category)) %>%
mutate_(.dots = setNames("category", cat)) %>%
slice(1) %>%
select_("link", "run", cat)
}
flats_cat_req = calculate_flats_cat(nat_req)
flats_cat_ref = calculate_flats_cat(nat_ref)
# add columns that indicate whether each nationality received a positive answer (category 1 or 2)
flats_both %>%
left_join(flats_cat_req, by = c("link", "run")) %>%
left_join(flats_cat_ref, by = c("link", "run")) %>%
select(link, run, orga, geschlecht, geography, city, cat_req, cat_ref, order_normal) %>%
# subset-flats
# filter(cat_f < 5 | cat_g < 5) %>%
mutate(
position_ref = find_positions(nat_ref, order_normal),
position_req = find_positions(nat_req, order_normal),
# dynamically build property first of 2-tuple
first = position_req < position_ref,
positive_req = !is.na(cat_req) & (cat_req<3),
positive_ref = !is.na(cat_ref) & (cat_ref<3),
discr = ifelse(positive_ref == positive_req, positive_ref + positive_req, positive_ref - positive_req)
) # %>%
# 3-Felder Analyse für Modell
# filter(discr != 0)
}
# contains flats_both for each nationality
flats_both_list = lapply(nats_f, calculate_flats_both, nat_ref = nat_ref)
# contains raw counts of correct pairs for each nationality
counts_flats_both = sapply(flats_both_list, nrow)
names(counts_flats_both) = nats_f_long
counts_flats_both arabisch italienisch polnisch türkisch
2734 2753 2774 2790 Jede dieser Wohnungen lässt sich in eine der folgenden Kategorien einordnen:
Für die vier untersuchten Minderheiten sieht das so aus:
# calculate counts of positve and negative discrimination
calculate_counts = function(flats_both) {
# for consideration of cases with at least 1 positive response
length_three_fields = nrow(flats_both %>% filter(discr != 0))
# count positive and negative discrimination
flats_both %>%
count(discr, sort = FALSE) %>%
mutate(share = n / nrow(flats_both)) %>%
mutate(share_three_fields = ifelse(discr == 0, NA, n / length_three_fields))
}
discr_counts_list = lapply(flats_both_list, calculate_counts)
names(discr_counts_list) = nats_f_long
discr_counts_list$arabisch
$italienisch
$polnisch
$türkisch# focus on 3-Felder-Tafel for rest of the notebook
flats_both_list = lapply(flats_both_list, function(flats_both) { flats_both %>% filter(discr != 0) })Neben einer Bevorzugung der deutschen Bewerber (pn) gibt es ebenso Fälle, in denen nur die Person mit ausländisch klingendem Namen eine positive Antwort erhält (np). Das kann eine bewusste Entscheidung des Vermieters sein. Oder schlicht damit zusammenhängen, dass der deutsche Bewerber später angeschrieben und der Vermieter die Anfrage gar nicht erst gelesen hat.
Um das tatsächliche Ausmaß der Diskriminierung von Personen mit ausländischem Namen nicht zu überschätzen, fließen auch diese Fälle in die Berechnung der Diskriminierungsrate ein. Indem wir diese Fälle (np) von den Fällen zugunsten der deutschen Bewerber (pn) abziehen, folgen wir einem Working Paper der empirischen Sozialforscherin Prof. Auspurg von der LMU München. Wir berechnen die Diskriminierungsrate folgendermaßen: NDR = (pn - np) / (pp + pn + np)
Wir setzen also die Fälle von Ungleichbehandlung ins Verhältnis zur Zahl der Wohnungen, deren Vermieter auf mindestens eine unserer beiden Anfragen positiv reagiert haben. Fälle, in denen keine unserer Personen eine Zusage erhalten hat (nn), berücksichtigen wir nicht bei der Ermittlung der Diskriminierungsrate. Sie zeigen, wie angespannt der Wohnungsmarkt ist. Hier eine tabellarische Darstellung der Ergebnisse:
share_to_percent = function(share) {
# converts share to percent and rounds to first decimal after the comma
round(share * 100, 1)
}
convert_numeric0 = function(i) {
# converts numeric0 to 0
ifelse(is.numeric(i) & length(i) == 0L, 0, i)
}
# return vector of GDR and NDR in %-points
calculate_rates = function(discr_counts) {
discr_count_neg = convert_numeric0((discr_counts %>% filter(discr == -1) %>% select(n))[[1]])
discr_count_2 = (discr_counts %>% filter(discr == 2) %>% select(n))[[1]]
discr_count_pos = convert_numeric0((discr_counts %>% filter(discr == 1) %>% select(n))[[1]])
# 3-Felder-Tafel
discr_count_0 = 0
# # 4-Felder-Tafel
# discr_count_0 = (discr_counts %>% filter(discr == 0) %>% select(n))[[1]]
# 3-Felder-Tafel
discr_count_sum = discr_count_neg + discr_count_pos + discr_count_2
# # 4 Felder-Tafel
# discr_count_sum = (discr_counts %>% summarise(sum = sum(n)) %>% select(sum))[[1]]
table_1_response_var = matrix(c(discr_count_pos + discr_count_2, discr_count_neg + discr_count_2, discr_count_0 + discr_count_neg, discr_count_0 + discr_count_pos), nrow = 2)
colnames(table_1_response_var) = c("positive", "negative")
rownames(table_1_response_var) = c("german", "foreign")
# calculate gross discrimination rate
gdr = discr_count_pos / discr_count_sum
gdr_interval = prop.test(discr_count_pos, discr_count_sum, conf.level = 0.95)$conf.int
# calculate net disrimination rate
ndr = gdr - (discr_count_neg / discr_count_sum)
ndr_interval = prop.test(table_1_response_var, conf.level = 0.95)$conf.int
# see: http://www.r-tutor.com/elementary-statistics/inference-about-two-populations/comparison-two-population-proportions
# alternative to calculate conf-int: t.test(flats_both$positive_req, flats_both$positive_ref)
sapply(c(ndr_interval[2], ndr, ndr_interval[1], gdr_interval[2], gdr, gdr_interval[1]), share_to_percent)
}
discr_rates_matrix = sapply(discr_counts_list, calculate_rates)
colnames(discr_rates_matrix) = nats_f_long
rownames(discr_rates_matrix) = c("NDR_upper", "NDR", "NDR_lower", "GDR_upper", "GDR", "GDR_lower")
discr_rates_matrix[1:3, ] arabisch italienisch polnisch türkisch
NDR_upper 30.6 11.8 15.9 27.4
NDR 26.7 8.3 12.2 23.6
NDR_lower 22.8 4.8 8.4 19.8Die Ober- und Untergrenze des 95%-Konfidenzintervalls wurden mit Hilfe eine Tests der Differenz zweier Anteilswerter normalverteilter Populationen berechnet. Hier eine grafische Darstellung der Ergebnisse:
# bring discr_rates_matrix into tidy form
summary_global = data.frame(discr_rates_matrix) %>%
rownames_to_column("rate") %>%
gather(nationality, value, arabisch:türkisch, factor_key = FALSE) %>%
filter(rate == "NDR" | rate == "GDR") %>%
arrange(rate, nationality)
# add columns with lower and upper bound of the confidence interval
summary_global[[4]] = c(discr_rates_matrix["GDR_lower", ], discr_rates_matrix["NDR_lower", ])
summary_global[[5]] = c(discr_rates_matrix["GDR_upper", ], discr_rates_matrix["NDR_upper", ])
colnames(summary_global)[4:5] <- c("lower", "upper")
ggplot(
summary_global %>%
filter(rate == "NDR"),
aes(x = nationality, y = value, fill = rate)) +
geom_bar(
stat = "identity",
colour = "black",
fill = "#535353",
size = .3) +
geom_text(
aes(x = nationality, y = value, label = paste0(round(value, 0), "%")),
# nudge_y = 5,
colour="#333333",
position = position_dodge(width = 1),
vjust = -0.5) +
geom_errorbar(
aes(ymin = lower, ymax = upper),
size = .3,
width = .2,
position = position_dodge(.9)) +
scale_y_continuous(breaks = 0:20 * 4) +
theme_bw() +
labs(subtitle = "Lesebeispiel: In ca. 12 % der Fälle, in denen ein Deutscher eine Einladung zu einer Besichtigung erhält, werden Menschen mit polnischem\n Namen übergangen.", x = "Nationalität", y = "Diskriminerung (%)")