Diskriminierung auf dem deutschen Wohnungsmarkt

Das Experiment

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.

Datensatzbeschreibung

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")

• persons.xlsx - Die 14 fiktiven Personen, die für die Kontaktaufname genutzt wurden sowie deren Name, Geschlecht, Herkunft und Mail-Adresse.
• confirmations.csv - Übersicht über alle im Lauf des Versuchs erfolgreich angefragten Wohnungsannoncen. Beinhaltet u.A. die anfragende Person, den Link zur Annonce sowie den zeitlichen Abstand zwischen den Anfragen mit den verschiedenen Profilen.
• flats.csv - Beinhaltet neben dem Link und dem Zeitstempel Meta-Daten zu den angefragten Wohnungen. Aus Datenschutzgründen werden Informationen, die Rückschlüsse auf einzelne Wohnungen oder Inserenten zulassen (Ansprechpartner, Adresse, Betreff, Telefonnumer) nicht veröffentlicht.
• mails.xlsx - Die Kategorisierung der empfangenen Emails. Es wurde folgendes Codebuch verwendet:

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).

Berechnungen

Hilfsfunktion: Generalised Linear Mixed Model

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.

Diskriminierung

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:

• np: Die deutsche Persona wird benachteiligt (-1)
• nn: Beide Personas erhalten negative Antwort (0)
• pn: Die Minderheit wird benachteiligt (1)
• pp: Beide Personas erhalten positive Antwort (2)

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.8

Die 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 (%)")

P-Values werden mithilfe von McNemar-Tests berechnet, um die statistische Signifikanz der einzelnen Netto-Diskriminierunsraten zu überprüfen:

calculate_mcnemar = function(flats_both) {
  # calculate McNemar p-values of discrimination for a list of flats  
  # table(flats_both[,c("positive_ref", "positive_req")]),
  mcnemar.test(table(flats_both[ , c("positive_ref", "positive_req")]))$p.value
}
mcnemar_value_list = sapply(flats_both_list, calculate_mcnemar)
names(mcnemar_value_list) = nats_f_long
mcnemar_value_list

    arabisch  italienisch     polnisch     türkisch 
1.511853e-30 2.067752e-05 1.576912e-08 1.802082e-26 

Ergebnis:

• Bewerber mit ausländisch klingendem Namen werden auf dem Mietmarkt gegenüber deutschen Bewerbern deutlich und statistisch signifikant benachteiligt.
• In jedem vierten Fall, in dem ein Deutscher eine Einladung zu einer Besichtigung erhält, werden Menschen mit türkischem oder arabischem Namen übergangen. Damit werden sie mehr als doppelt so stark diskriminiert wie italienische oder polnische Bewerber. Diese werden ebenfalls statistisch signifikant benachteiligt, allerdings mit einer deutlich niedrigeren Häufigkeit.

Wir sichern die Diskriminierungsraten mit einer logistischen Regression ab, um andere Faktoren wie die Reihenfolge der Anschreiben zu kontrollieren. Oder ob eine Anfrage dem ersten (Juni) oder zweiten Durchlauf (September) zuzuordnen ist. Mit diesem Vorgehen beziehen wir uns auf eine Studie ebenfalls von Prof. Auspurg.

models = sapply(flats_both_list, calculate_regression)

[1] "positive ~ nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.265620793     0.04056291 5.816985e-11
cityberlin              0.019810058     0.04141062 6.323790e-01
citydortmund            0.052184389     0.05061519 3.025396e-01
citydresden             0.037935115     0.04833675 4.325656e-01
cityfrankfurt           0.014574586     0.04322813 7.360000e-01
cityhamburg             0.054967979     0.04319449 2.031710e-01
cityköln                0.052517934     0.04598940 2.534717e-01
cityleipzig             0.033538037     0.04505874 4.566841e-01
citymagdeburg           0.095611855     0.05848668 1.020988e-01
citynürnberg            0.054677857     0.04735193 2.482082e-01
orgaprivate            -0.032469145     0.02346249 1.663969e-01
geschlechtweiblich      0.080830655     0.01968523 4.022946e-05
position2              -0.010627680     0.01934419 5.827316e-01
run2                    0.009835658     0.02127390 6.438414e-01
[1] "positive ~ nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.083153445     0.02655016 0.0017365660
cityberlin              0.088784808     0.04069660 0.0291370504
citydortmund            0.051429260     0.04589786 0.2624941433
citydresden             0.094839727     0.04875020 0.0517241823
cityfrankfurt           0.091363318     0.04618546 0.0479080096
cityhamburg             0.083588459     0.04131191 0.0430370545
cityköln                0.082508070     0.04406332 0.0611390449
cityleipzig             0.048405789     0.04291620 0.2593561880
citymagdeburg           0.071763077     0.05253963 0.1719751746
citynürnberg            0.075170934     0.04581419 0.1008434327
orgaprivate            -0.040168720     0.02333824 0.0852227091
geschlechtweiblich      0.068160478     0.02040317 0.0008357322
position2              -0.003385752     0.01803636 0.8510975844
run2                    0.008484475     0.02014009 0.6735557400
[1] "positive ~ nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.121399682     0.02942473 3.694946e-05
cityberlin              0.097530702     0.04463105 2.886936e-02
citydortmund            0.119586610     0.05622088 3.341298e-02
citydresden             0.118449544     0.05469285 3.033239e-02
cityfrankfurt           0.075626939     0.04548278 9.636052e-02
cityhamburg             0.105623039     0.04583957 2.121202e-02
cityköln                0.110442590     0.05043763 2.854699e-02
cityleipzig             0.046366900     0.04545470 3.076961e-01
citymagdeburg           0.146489953     0.05865707 1.251091e-02
citynürnberg            0.050817783     0.04776417 2.873599e-01
orgaprivate            -0.043411890     0.02408734 7.150299e-02
geschlechtweiblich      0.065371440     0.02011271 1.153018e-03
position2              -0.008554325     0.01919174 6.557926e-01
run2                    0.002664361     0.02059333 8.970571e-01
[1] "positive ~ nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.236852166     0.04061602 5.493256e-09
cityberlin              0.079300914     0.04137104 5.526054e-02
citydortmund            0.072420002     0.05171172 1.613768e-01
citydresden             0.054287889     0.04832378 2.612593e-01
cityfrankfurt           0.063691184     0.04520607 1.588624e-01
cityhamburg             0.049559907     0.04179868 2.357482e-01
cityköln                0.057133620     0.04606566 2.148775e-01
cityleipzig             0.077261776     0.04683345 9.900155e-02
citymagdeburg           0.123271001     0.05768076 3.258781e-02
citynürnberg            0.058851220     0.04678629 2.084376e-01
orgaprivate            -0.008890854     0.02272122 6.955742e-01
geschlechtweiblich      0.077256873     0.01977311 9.338427e-05
position2              -0.031840216     0.01984765 1.086632e-01
run2                    0.022532717     0.02117523 2.872800e-01

Die Modelle bestätigen die Ergebnisse aus der deskriptiven Berechnung und deren statistische Siginifikanz.

Diskriminierung nach Geschlecht

Analog berechnen wir nun deskriptiv die Diskriminierungsraten und p-Values getrennt nach männlichen und weiblichen Bewerbern:

filter_matches = function (flats_both, key, value) {
  # filters flats that match value for key
    flats_both %>%
      filter_(paste0(key, '==', '"', value, '"'))
  }
calculate_summary = function (key, value) {
  # calculates individual summary for flats that match value for key
  
  flats_both_list_subset = lapply(flats_both_list, filter_matches, key, value)
  discr_counts_list_subset = lapply(flats_both_list_subset, calculate_counts)
  discr_rates_matrix_subset = sapply(discr_counts_list_subset, calculate_rates)
  colnames(discr_rates_matrix_subset) = nats_f_long
  rownames(discr_rates_matrix_subset) = c("NDR_upper", "NDR", "NDR_lower", "GDR_upper", "GDR", "GDR_lower")
  
  data.frame(t(discr_rates_matrix_subset)) %>% 
    rownames_to_column("nationality") %>%
    mutate(subgroup = value)
}
wrap_mcnemar = function (key, value) {
  # calculates mcnemar p-value for discrimination of flats that match value for key (for each nationality)
  
  flats_both_list_subset = lapply(flats_both_list, filter_matches, key, value)
  sapply(flats_both_list_subset, calculate_mcnemar)
}
plot_discr_per_group = function (key, value1, value2, nats_visible) {
  # plots the NDRs for the two groups with value1 and value2 as key
  
  summary = calculate_summary(key, value1) %>%
    union(calculate_summary(key, value2)) %>%
    arrange(nationality)
  
  ggplot(
      summary %>% filter(nationality %in% nats_visible), 
      aes(x = nationality, y = NDR, fill = subgroup)) + 
    geom_bar(
      position=position_dodge(), 
      stat = "identity",
      colour = "black",
      size = .3) +
    geom_text(
      aes(x = nationality, y = NDR, label = paste0(round(NDR, 0), "%")), 
      colour="#333333",
      position = position_dodge(width = 1),
      vjust = -0.5) +
    geom_errorbar(
      aes(ymin = NDR_lower, ymax = NDR_upper),
      size = .3,
      width = .2,
      position=position_dodge(.9)) +
    xlab("Nationalität") +
    ylab("Diskriminerung (%)") +
    scale_fill_hue(
      name = key,
      breaks = c(value1, value2),
      labels = c(value1, value2)) +
    scale_y_continuous(breaks = 0:20 * 4) +
    theme_bw()
}
calc_mcnemar_per_group = function (key, value1, value2) {
  
  # print(calculate_mcnemar(key, value1))
  mcnemars =mapply(c, wrap_mcnemar(key, value1), wrap_mcnemar(key, value2), SIMPLIFY = TRUE)
  colnames(mcnemars) = nats_f_long
  rownames(mcnemars) = c(value1, value2)
  print("McNemar p-values:")
  print(mcnemars)
  cat("\n")
}
plot_discr_per_group("geschlecht", "männlich", "weiblich", nats_f_long)

calc_mcnemar_per_group("geschlecht", "männlich", "weiblich")

[1] "McNemar p-values:"
             arabisch  italienisch     polnisch     türkisch
männlich 3.840507e-17 0.0121956017 2.625626e-04 7.226049e-20
weiblich 9.457430e-15 0.0004743883 1.551772e-05 9.188840e-09

Ergebnis:

• Bei Bewerbern mit türkischem Namen gibt es einen Unterschied bzgl. des Geschlechts: Männer werden statistisch signifikant stärker diskriminiert (ggü deutschen Bewerbern) als Frauen (gegenüber deutschen Bewerberinnen) – und zwar annähernd doppelt so stark. Auch bei Bewerbern mit arabisch klingendem Namen ist diese Tendenz festzustellen.

Erneut sichern wir die Ergebnisse im Modell durch eine logistische Regression ab. Dies passiert auf zwei Wegen. Zunächst rechnen wir ein Modell mit einem Interaktionsterm zwischen der Nationalität und dem zu untersuchenden Merkmal (hier Geschlecht). Dieser sagt uns wie groß eine unterschiedliche Diskriminierung ausfällt und ob der Unterschied statistisch signifikant ist.

calculate_modell = function (key, value, exclude = NULL) {
  # calculates mixed models for the subset where (key == value) that exclude key from formula
  
  flats_both_list_subset = lapply(flats_both_list, filter_matches, key, value)
  
  if (is.null(exclude)) {
    sapply(flats_both_list_subset, calculate_regression, vars_exclude = key)
  } else {
    sapply(flats_both_list_subset, calculate_regression, vars_exclude = c(key, exclude))
  }
}
print("Modell with interaction term:")

[1] "Modell with interaction term:"

models = sapply(flats_both_list, calculate_regression, var_interact = "geschlecht", vars_exclude = NULL)

[1] "positive ~ geschlecht * nat + city + orga + geschlecht + position + run + (1 | link)"
                          marginal.effects standard.error      p-value
geschlechtweiblich             0.073315381     0.03438234 3.297759e-02
natreq                        -0.270106648     0.04950857 4.876513e-08
cityberlin                     0.019787341     0.04185195 6.363604e-01
citydortmund                   0.052189134     0.05103055 3.064479e-01
citydresden                    0.037920935     0.04611140 4.108626e-01
cityfrankfurt                  0.014554898     0.04391428 7.403130e-01
cityhamburg                    0.054967234     0.04382289 2.097314e-01
cityköln                       0.052506871     0.04476162 2.407824e-01
cityleipzig                    0.033515632     0.04806019 4.855727e-01
citymagdeburg                  0.095603244     0.05611261 8.842318e-02
citynürnberg                   0.054662362     0.04628143 2.375684e-01
orgaprivate                   -0.032472941     0.02437726 1.828274e-01
position2                     -0.010226484     0.01933280 5.968257e-01
run2                           0.009830704     0.02122444 6.432364e-01
geschlechtweiblich:natreq      0.010250512     0.04204346 8.073799e-01
[1] "positive ~ geschlecht * nat + city + orga + geschlecht + position + run + (1 | link)"
                          marginal.effects standard.error     p-value
geschlechtweiblich             0.087199474     0.02875329 0.002423939
natreq                        -0.068801833     0.03118635 0.027373343
cityberlin                     0.088834358     0.04192334 0.034092879
citydortmund                   0.051430965     0.04683789 0.272176854
citydresden                    0.094887809     0.04785414 0.047383635
cityfrankfurt                  0.091398193     0.04873801 0.060752025
cityhamburg                    0.083658605     0.04217180 0.047282956
cityköln                       0.082555845     0.04398338 0.060521077
cityleipzig                    0.048480083     0.04570354 0.288802960
citymagdeburg                  0.071810819     0.05140678 0.162439609
citynürnberg                   0.075238108     0.04571732 0.099820551
orgaprivate                   -0.040187511     0.02430861 0.098285822
position2                     -0.003739353     0.01815333 0.836800942
run2                           0.008475269     0.02022049 0.675111868
geschlechtweiblich:natreq     -0.031446741     0.03879061 0.417549896
[1] "positive ~ geschlecht * nat + city + orga + geschlecht + position + run + (1 | link)"
                          marginal.effects standard.error     p-value
geschlechtweiblich             0.082357267     0.02960769 0.005408879
natreq                        -0.108849075     0.03463436 0.001673366
cityberlin                     0.097621502     0.04572232 0.032753225
citydortmund                   0.119679703     0.05681901 0.035175525
citydresden                    0.118517325     0.05329297 0.026156336
cityfrankfurt                  0.075718550     0.04716205 0.108384404
cityhamburg                    0.105703411     0.04653937 0.023130717
cityköln                       0.110555402     0.04986103 0.026604582
cityleipzig                    0.046453868     0.04844650 0.337624533
citymagdeburg                  0.146516766     0.05742498 0.010727680
citynürnberg                   0.050915297     0.04683796 0.277013864
orgaprivate                   -0.043438556     0.02503346 0.082701919
position2                     -0.009253013     0.01925028 0.630751789
run2                           0.002655571     0.02058556 0.897356376
geschlechtweiblich:natreq     -0.027586810     0.03992922 0.489632963
[1] "positive ~ geschlecht * nat + city + orga + geschlecht + position + run + (1 | link)"
                          marginal.effects standard.error      p-value
geschlechtweiblich            -0.015262063     0.03624490 6.736954e-01
natreq                        -0.299951189     0.06025735 6.429906e-07
cityberlin                     0.079397293     0.04244610 6.140830e-02
citydortmund                   0.072481780     0.05201678 1.634896e-01
citydresden                    0.054372595     0.04620240 2.392614e-01
cityfrankfurt                  0.063867054     0.04648671 1.694797e-01
cityhamburg                    0.049529032     0.04250062 2.438685e-01
cityköln                       0.057360635     0.04485791 2.009963e-01
cityleipzig                    0.077526674     0.04990695 1.203217e-01
citymagdeburg                  0.123660029     0.05609942 2.750314e-02
citynürnberg                   0.059003656     0.04574088 1.970664e-01
orgaprivate                   -0.008938414     0.02359692 7.048395e-01
position2                     -0.032346552     0.01993265 1.046338e-01
run2                           0.022670981     0.02125007 2.860324e-01
geschlechtweiblich:natreq      0.128557250     0.04082298 1.637520e-03

Anschließend berechnen wir getrennte Modelle für jede Teilgruppe, sprich Männer und Frauen. Hier sehen wir ob der Effekt der Nationalität auch im Modell für jede Teilgruppe statistisch signifikant ist. Außerdem sind getrennte Modelle hilfreich, da Interaktionseffekte in der logisitischen Regression auch ohne explizite Formulierung zu einem gewissen Grad implizit modelliert werden. Das heißt ein statistisch nicht-signifikanter Interaktionseffekt im obigen Modell bedeutet nicht zwangsläufig, dass es keinen signifikanten Unterschied gibt (siehe arabisch).

calculate_separate_models = function (key, value1, value2, collinear_var = NULL) {
  # calculates models for each each subroup (value1 and value2) without interaction-term
  
  print(paste("Models for subgroup:", value1))
  calculate_modell(key, value1, collinear_var)
  print(paste("Models for subgroup:", value2))
  calculate_modell(key, value2, collinear_var)
  
  TRUE
}
calculate_separate_models("geschlecht", "männlich", "weiblich")

[1] "Models for subgroup: männlich"
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error      p-value
natreq            -0.294757885     0.04902697 1.830696e-09
cityberlin        -0.024560323     0.06468058 7.041554e-01
citydortmund       0.048159015     0.08117956 5.530201e-01
citydresden        0.016868358     0.07609622 8.245697e-01
cityfrankfurt     -0.053341264     0.06680903 4.246303e-01
cityhamburg        0.061034843     0.06670534 3.601959e-01
cityköln           0.029656369     0.07162626 6.788424e-01
cityleipzig        0.022066914     0.07037555 7.538557e-01
citymagdeburg      0.186113913     0.09845333 5.870754e-02
citynürnberg       0.049586627     0.07195071 4.907132e-01
orgaprivate       -0.023793228     0.03540191 5.015272e-01
position2         -0.033892723     0.02989932 2.569784e-01
run2              -0.008059735     0.03060346 7.922729e-01
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error    p-value
natreq            -0.080972261     0.03604661 0.02468346
cityberlin         0.098512875     0.06531801 0.13150237
citydortmund       0.134683487     0.08841807 0.12769431
citydresden        0.137126671     0.08647515 0.11279942
cityfrankfurt      0.102652948     0.07226071 0.15543555
cityhamburg        0.101929143     0.06721328 0.12939222
cityköln           0.101649407     0.07083942 0.15130786
cityleipzig        0.100472614     0.07440383 0.17689769
citymagdeburg      0.023678855     0.08096352 0.76993245
citynürnberg       0.068889604     0.07557097 0.36198551
orgaprivate       -0.057398735     0.03705649 0.12139319
position2         -0.004017706     0.02892733 0.88953740
run2               0.040970823     0.03287228 0.21263083
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error     p-value
natreq            -0.121271973     0.03845528 0.001612784
cityberlin         0.023650412     0.06943236 0.733385747
citydortmund       0.023984697     0.08200183 0.769912169
citydresden        0.079340279     0.08506961 0.351000036
cityfrankfurt      0.011300354     0.07172938 0.874818103
cityhamburg        0.061551044     0.07020061 0.380601875
cityköln           0.108725397     0.08195862 0.184644694
cityleipzig        0.019853846     0.07364986 0.787490520
citymagdeburg      0.192713751     0.09693622 0.046806506
citynürnberg       0.005362846     0.07838873 0.945456489
orgaprivate       -0.015318521     0.03580814 0.668800817
position2         -0.021333579     0.02963827 0.471649206
run2               0.030008214     0.03027598 0.321609536
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error      p-value
natreq            -0.322090374     0.05371662 2.021090e-09
cityberlin         0.166596621     0.06141041 6.670929e-03
citydortmund       0.111966743     0.08153571 1.696829e-01
citydresden        0.076925106     0.07173528 2.835642e-01
cityfrankfurt      0.128200214     0.06708968 5.602023e-02
cityhamburg        0.153945720     0.06318610 1.483485e-02
cityköln           0.123354744     0.06862535 7.225472e-02
cityleipzig        0.207543023     0.07352098 4.759011e-03
citymagdeburg      0.239993723     0.08408139 4.313142e-03
citynürnberg       0.196225058     0.07904236 1.304529e-02
orgaprivate        0.021591840     0.03509911 5.384439e-01
position2          0.001567109     0.02784655 9.551215e-01
run2               0.043827112     0.02962838 1.390795e-01
[1] "Models for subgroup: weiblich"
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error      p-value
natreq             -0.23379342     0.05649029 3.493582e-05
cityberlin          0.05786920     0.05291369 2.741073e-01
citydortmund        0.05634466     0.06180580 3.619581e-01
citydresden         0.05060854     0.06048947 4.027891e-01
cityfrankfurt       0.08359917     0.05795076 1.491361e-01
cityhamburg         0.04313948     0.05435811 4.274189e-01
cityköln            0.06902153     0.05836107 2.369424e-01
cityleipzig         0.03713510     0.05649520 5.109788e-01
citymagdeburg       0.02521846     0.06880400 7.139725e-01
citynürnberg        0.04516011     0.06133057 4.615242e-01
orgaprivate        -0.03280138     0.03039959 2.805845e-01
position2           0.01118722     0.02529924 6.583474e-01
run2                0.03766845     0.02988396 2.074925e-01
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error    p-value
natreq            -0.085365797     0.03750565 0.02284132
cityberlin         0.082549766     0.05207918 0.11294776
citydortmund       0.005189559     0.05184423 0.92026568
citydresden        0.063610719     0.05651267 0.26033447
cityfrankfurt      0.078205272     0.06083505 0.19860722
cityhamburg        0.071547668     0.05218120 0.17033170
cityköln           0.065184939     0.05655627 0.24908781
cityleipzig        0.008574352     0.05112073 0.86679767
citymagdeburg      0.135347763     0.08303830 0.10311337
citynürnberg       0.079335528     0.05792055 0.17077116
orgaprivate       -0.022379230     0.02922046 0.44375044
position2         -0.003331806     0.02394011 0.88931383
run2              -0.017757413     0.02713515 0.51285015
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error     p-value
natreq            -0.120877037     0.04085356 0.003088511
cityberlin         0.154256914     0.06203070 0.012890385
citydortmund       0.203902075     0.08683697 0.018869345
citydresden        0.135190079     0.07063078 0.055615134
cityfrankfurt      0.112349243     0.05981188 0.060329630
cityhamburg        0.126274547     0.06104774 0.038597198
cityköln           0.105928550     0.06124007 0.083679217
cityleipzig        0.061026508     0.05628522 0.278259769
citymagdeburg      0.101009456     0.06882427 0.142201216
citynürnberg       0.073542571     0.05885191 0.211438111
orgaprivate       -0.055168791     0.03227041 0.087343935
position2          0.001125578     0.02547251 0.964754584
run2              -0.015111074     0.02893438 0.601493992
[1] "positive ~ nat + city + orga + position + run + (1 | link)"
              marginal.effects standard.error      p-value
natreq            -0.160178085     0.04774876 0.0007947922
cityberlin         0.007145533     0.05784785 0.9016930636
citydortmund       0.031184888     0.06797829 0.6464153028
citydresden        0.042528962     0.06930791 0.5394641416
cityfrankfurt      0.008586143     0.06260835 0.8909197056
cityhamburg       -0.038951440     0.05882553 0.5078738120
cityköln           0.004186709     0.06425643 0.9480495784
cityleipzig       -0.023263016     0.06275007 0.7108424027
citymagdeburg      0.018510154     0.07874845 0.8141666726
citynürnberg      -0.035319372     0.06230103 0.5707720932
orgaprivate       -0.034848656     0.03022937 0.2489892460
position2         -0.061624148     0.03036456 0.0424098171
run2               0.001163157     0.02954282 0.9685938704
[1] TRUE

Diskriminierung nach Organisationsform

Die Auswertung der Diskriminierung nach Geschlecht lässt sich analog auf die Organisationsform des Vermieters der angebotenen Wohnungen übertragen:

plot_discr_per_group("orga", "company", "private", nats_f_long)

calc_mcnemar_per_group("orga", "company", "private")

[1] "McNemar p-values:"
            arabisch  italienisch     polnisch     türkisch
company 3.767000e-24 0.0052757446 8.608579e-05 7.967998e-20
private 1.158094e-07 0.0004480076 1.068645e-05 5.852130e-08

Ergebnis:

• Privatanbieter diskriminieren stärker als professionelle Anbieter von Wohnungen. Statistisch signifikant ist der Unterschied bei italienischen und polnischen Bewerbern.

print("Modell with interaction term:")

[1] "Modell with interaction term:"

models = sapply(flats_both_list, calculate_regression, var_interact = "orga", vars_exclude = NULL)

[1] "positive ~ orga * nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
orgaprivate           -0.0328237897     0.04411163 4.568115e-01
natreq                -0.2657349113     0.04291502 5.936088e-10
cityberlin             0.0198097886     0.04177947 6.353920e-01
citydortmund           0.0521829889     0.05094050 3.056506e-01
citydresden            0.0379346781     0.04591625 4.087071e-01
cityfrankfurt          0.0145750686     0.04387431 7.397379e-01
cityhamburg            0.0549666831     0.04339963 2.053255e-01
cityköln               0.0525174380     0.04477320 2.408095e-01
cityleipzig            0.0335388520     0.04799673 4.846934e-01
citymagdeburg          0.0956129318     0.05595678 8.750791e-02
citynürnberg           0.0546779670     0.04596889 2.342603e-01
geschlechtweiblich     0.0808302503     0.01976962 4.339666e-05
position2             -0.0106352056     0.01927805 5.811714e-01
run2                   0.0098360274     0.02117345 6.422571e-01
orgaprivate:natreq     0.0004957252     0.04995542 9.920824e-01
[1] "positive ~ orga * nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
orgaprivate             0.011255499     0.03507361 0.7482780005
natreq                 -0.062553000     0.02582748 0.0154372457
cityberlin              0.089128400     0.04108201 0.0300429208
citydortmund            0.051975984     0.04643464 0.2629966430
citydresden             0.095229625     0.04674928 0.0416471522
cityfrankfurt           0.091884509     0.04809614 0.0560773551
cityhamburg             0.084019127     0.04128697 0.0418505249
cityköln                0.083051691     0.04351045 0.0562910379
cityleipzig             0.048988861     0.04520169 0.2784606035
citymagdeburg           0.072207442     0.05080804 0.1552640112
citynürnberg            0.075599178     0.04492884 0.0924443134
geschlechtweiblich      0.068149739     0.02054088 0.0009074205
position2              -0.003290770     0.01796891 0.8546906129
run2                    0.008473328     0.02000180 0.6718369678
orgaprivate:natreq     -0.083184982     0.04708331 0.0772681859
[1] "positive ~ orga * nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
orgaprivate             0.028788098     0.03857247 0.4554633159
natreq                 -0.094915529     0.02814635 0.0007456633
cityberlin              0.097446656     0.04502247 0.0304336417
citydortmund            0.119741500     0.05622642 0.0332021225
citydresden             0.118202123     0.05224815 0.0236775295
cityfrankfurt           0.075561208     0.04686776 0.1069137961
cityhamburg             0.105781033     0.04569640 0.0206202663
cityköln                0.110919782     0.04951075 0.0250703508
cityleipzig             0.046579568     0.04811407 0.3329908817
citymagdeburg           0.146098000     0.05660294 0.0098485264
citynürnberg            0.050596165     0.04645147 0.2760540692
geschlechtweiblich      0.065353754     0.02007632 0.0011328641
position2              -0.008379270     0.01907904 0.6605259017
run2                    0.002780621     0.02040409 0.8916017936
orgaprivate:natreq     -0.114908287     0.05120287 0.0248210451
[1] "positive ~ orga * nat + city + orga + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
orgaprivate              0.01758593     0.04355237 6.863685e-01
natreq                  -0.22885838     0.04157070 3.685787e-08
cityberlin               0.07960307     0.04194454 5.772014e-02
citydortmund             0.07275882     0.05206791 1.622984e-01
citydresden              0.05464093     0.04598943 2.347864e-01
cityfrankfurt            0.06396362     0.04640059 1.680463e-01
cityhamburg              0.04991044     0.04210483 2.358652e-01
cityköln                 0.05743454     0.04496537 2.014942e-01
cityleipzig              0.07753321     0.04970059 1.187585e-01
citymagdeburg            0.12343722     0.05545985 2.603401e-02
citynürnberg             0.05914179     0.04554744 1.941273e-01
geschlechtweiblich       0.07728569     0.01986195 9.977317e-05
position2               -0.03118000     0.01979303 1.151867e-01
run2                     0.02255141     0.02106197 2.842967e-01
orgaprivate:natreq      -0.03678091     0.05071401 4.682918e-01

calculate_separate_models("orga", "company", "private")

[1] "Models for subgroup: company"
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.261796897     0.04597918 1.242323e-08
cityberlin              0.040841071     0.04624906 3.771994e-01
citydortmund            0.035197690     0.05676241 5.351998e-01
citydresden             0.051201150     0.05358912 3.393556e-01
cityfrankfurt           0.029566675     0.05010993 5.551663e-01
cityhamburg             0.085266794     0.05067473 9.244684e-02
cityköln                0.045028258     0.05232287 3.894669e-01
cityleipzig             0.041387393     0.05055158 4.129484e-01
citymagdeburg           0.103163738     0.06373209 1.055098e-01
citynürnberg            0.076724166     0.05569199 1.683108e-01
geschlechtweiblich      0.085557613     0.02155620 7.215998e-05
position2              -0.000253155     0.02149464 9.906031e-01
run2                    0.008186246     0.02258243 7.169746e-01
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error    p-value
natreq                 -0.060152907     0.02731121 0.02763009
cityberlin              0.076670597     0.04776297 0.10844297
citydortmund            0.018210452     0.05476645 0.73950339
citydresden             0.078361286     0.05602840 0.16193313
cityfrankfurt           0.064801082     0.05561451 0.24394495
cityhamburg             0.086691328     0.05357063 0.10560611
cityköln                0.061069632     0.05633540 0.27834858
cityleipzig             0.037963588     0.05022011 0.44968281
citymagdeburg           0.056236825     0.05889225 0.33962298
citynürnberg            0.103700492     0.06143558 0.09141985
geschlechtweiblich      0.055827256     0.02172509 0.01017826
position2              -0.008076024     0.02090694 0.69928611
run2                    0.009320920     0.02134186 0.66229731
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error     p-value
natreq                 -0.092295353     0.02994556 0.002055424
cityberlin              0.081011259     0.04996184 0.104918459
citydortmund            0.114383007     0.06457820 0.076522029
citydresden             0.112341539     0.06028146 0.062375565
cityfrankfurt           0.062110123     0.05377617 0.248100736
cityhamburg             0.087297332     0.05333298 0.101664767
cityköln                0.133267541     0.06451155 0.038847984
cityleipzig             0.025507168     0.05173866 0.622012460
citymagdeburg           0.125563197     0.06337811 0.047571541
citynürnberg            0.073540016     0.05926527 0.214656770
geschlechtweiblich      0.072388773     0.02254620 0.001324185
position2              -0.019925730     0.02225280 0.370559562
run2                   -0.001016858     0.02206776 0.963247363
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                  -0.22701279     0.04570788 6.813653e-07
cityberlin               0.11075593     0.04969390 2.582967e-02
citydortmund             0.10864562     0.06373190 8.824500e-02
citydresden              0.08229831     0.05643220 1.447421e-01
cityfrankfurt            0.10605363     0.05605138 5.848047e-02
cityhamburg              0.08736634     0.05159118 9.037256e-02
cityköln                 0.05980344     0.05661657 2.908364e-01
cityleipzig              0.10079109     0.05468989 6.533538e-02
citymagdeburg            0.17046229     0.06736427 1.139146e-02
citynürnberg             0.10427122     0.05785876 7.151893e-02
geschlechtweiblich       0.08548934     0.02232875 1.288396e-04
position2               -0.02270327     0.02190908 3.000859e-01
run2                     0.03893426     0.02288494 8.888566e-02
[1] "Models for subgroup: private"
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.274783787     0.06766415 4.886393e-05
cityberlin             -0.080564479     0.09178735 3.800904e-01
citydortmund            0.129925785     0.11113180 2.423576e-01
citydresden            -0.002525568     0.11213314 9.820308e-01
cityfrankfurt          -0.029200741     0.08225118 7.225753e-01
cityhamburg            -0.029231709     0.08317208 7.252428e-01
cityköln                0.081790018     0.09256947 3.769376e-01
cityleipzig             0.010625994     0.09713610 9.128909e-01
citymagdeburg           0.096339815     0.14952891 5.193881e-01
citynürnberg           -0.007153110     0.08896922 9.359193e-01
geschlechtweiblich      0.056904677     0.03992373 1.540605e-01
position2              -0.049390931     0.04420297 2.638375e-01
run2                    0.007593249     0.05732420 8.946193e-01
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error     p-value
natreq                  -0.16603895     0.06022401 0.005833032
cityberlin               0.12376240     0.10326977 0.230746622
citydortmund             0.15057140     0.09624929 0.117726059
citydresden              0.16734997     0.13404963 0.211878005
cityfrankfurt            0.15427849     0.08524596 0.070326182
cityhamburg              0.08273928     0.06956263 0.234273872
cityköln                 0.12258515     0.07222187 0.089632172
cityleipzig              0.07884221     0.11366951 0.487927367
citymagdeburg            0.16663831     0.18124749 0.357888193
citynürnberg             0.01963896     0.07689070 0.798403398
geschlechtweiblich       0.09551764     0.03974022 0.016236719
position2                0.01609428     0.03975761 0.685617090
run2                     0.00307698     0.05710377 0.957027572
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                 -0.230978326     0.06381142 0.0002949428
cityberlin              0.201959213     0.11683830 0.0838921763
citydortmund            0.100286226     0.11246536 0.3725496255
citydresden             0.060873810     0.15964578 0.7029765970
cityfrankfurt           0.093482586     0.08396374 0.2655501877
cityhamburg             0.139595579     0.08714363 0.1091772073
cityköln                0.073999656     0.08470761 0.3823419911
cityleipzig             0.136250473     0.10239226 0.1832970764
citymagdeburg           0.320892294     0.19749228 0.1041978081
citynürnberg           -0.001629369     0.08541919 0.9847812898
geschlechtweiblich      0.039770107     0.04012264 0.3215813129
position2               0.037918087     0.04115663 0.3568876635
run2                    0.044084077     0.05611334 0.4320868952
[1] "positive ~ nat + city + geschlecht + position + run + (1 | link)"
                   marginal.effects standard.error      p-value
natreq                  -0.26626526     0.07028249 0.0001515591
cityberlin               0.01710053     0.07977052 0.8302573065
citydortmund             0.01157406     0.08932452 0.8969041270
citydresden              0.03525541     0.10736837 0.7426399292
cityfrankfurt           -0.02378151     0.07774166 0.7596774480
cityhamburg             -0.02381608     0.07351135 0.7459544777
cityköln                 0.07359866     0.07791208 0.3448440759
cityleipzig              0.08004125     0.11006106 0.4670764960
citymagdeburg           -0.12480598     0.14175471 0.3786230679
citynürnberg            -0.02599103     0.08166158 0.7502745355
geschlechtweiblich       0.03314458     0.03815743 0.3850510989
position2               -0.04827867     0.04301348 0.2616890688
run2                    -0.07197155     0.05445090 0.1862448736
[1] TRUE

Auch hier bestätigen die Modelle die Ergebnisse der deskriptiven Auswertung.

Anteil positiver Rückmeldungen

Neben dem Ausmaß der Diskriminierung betrachten wir ebenfalls, wie häufig einzelne Personen oder Gruppen positive Antworten erhalten haben. Und zwar relativ zur Gesamtzahl der gestellten Anfragen: p = positive_antworten / anfragen

Betrachtet man nur den Anteil an Anfragen, auf die die jeweilige Person zu einem Besichtigungstermin eingeladen wurde oder einen solchen in Aussicht gestellt bekam, zeigt sich folgendes Bild:

# Um den Anteil aller tendenziell positiven Antworten (Kategorie 1+2) an allen gesendeten Mails zu berechnen filtern wir diejenigen Fälle aus, in denen die selbe Person mehrfach dieselbse Wohnung angeschreiben hat. Falls bei uns für eine Person und eine Wohnung mehrere verschiedene Antworten eingegangen sind (Meinung geändert, Newsletter, Einladung nachdem vorher nur eine automatisierte Posteingangs-Mail vorlag), behalten wir nur die positivste.
mails_meta_positive = mails_meta %>% 
  filter(category <= 2) %>% 
  distinct(link, person, city, migrationshintergrund, run, herkunft, geschlecht, typ, orga)
confirmations_per_person = confirmations_meta_unique %>% count(person)
positive_per_person = mails_meta_positive %>% count(person)
share_positive_per_person = left_join(confirmations_per_person, positive_per_person, by=c("person")) %>%
  rename(count_positive = n.y, count_total = n.x) %>% 
  mutate(share = count_positive / count_total) %>%
  rowwise() %>% 
  mutate(lower = prop.test(count_positive, count_total)$conf.int[1]) %>% 
  mutate(upper = prop.test(count_positive, count_total)$conf.int[2]) %>% 
  select(person, share, lower, upper) %>% 
  left_join(persons, by=c("person" = "mail_1")) %>% 
  unite(migrationshintergrund_typ, migrationshintergrund, typ, sep="_")
ggplot(share_positive_per_person) +
  geom_bar(aes(x=reorder(name, share, max), y = share, fill = migrationshintergrund_typ), stat='identity') +
  geom_errorbar(aes(x=reorder(name, share, max), ymin=lower, ymax=upper),
                  size=.3,    # Thinner lines
                  width=.2,
                  position=position_dodge(.9)) +
  xlab("") +
  ylab("Positive Rückmeldungen (%)") +
  geom_text(aes(x=name, share, y=share, 
            label= paste0(round(share *100,1), "%")), nudge_y=-0.018, colour="white") +
  coord_flip() + 
  scale_fill_manual(name="",
            breaks=c("ja_normal",
                  "nein_normal",
                  "nein_extreme positive",
                  "nein_extreme negative"),
            values=c("ja_normal" = "#f69b69", 
                 "nein_normal" = "#555555",
                 "nein_extreme positive" = "#1a9641",
                 "nein_extreme negative" = "#d7191c"),
            labels=c("Migrationshintergrund",
                  "kein Migrationshintergrund",
                  "Extremprofil - positiv",
                  "Extremprofil - negativ")) +
  theme(axis.ticks.x=element_blank(), axis.text.x=element_blank()) # + 

  # labs(subtitle="Anteil Anfragen, auf die die jeweilige Person zu einem Besichtigungstermin eingeladen wurde\n oder einen solchen in Aussicht gestellt bekam", x="", y="")

• Die Rücklaufquoten der einzelnen Personas bestätigen die Versuchsanordnung.
• Dr. Carsten Meier bekommt anteilig die meisten positiven Antworten, Lovis Kuhn landet im hinteren Drittel. Dass er trotz eines laxen Anschreibens ähnlich oder besser als die ausländischen männlichen Bewerber abschneidet, unterstreicht das Ausmaß der Diskriminierung am Mietmarkt.
• Interessant ist Daniel Buschle, der im Vergleich zu den anderen deutschen Profilen abfällt. Das könnte an einer negativen Konnotation seines Namens liegen.

Es gibt unterschiedliche Typen von Vermietern. Während manche Massenbesichtigungen durchführen, laden andere nur wenige Bewerber zu einem Treffen vor Ort ein. Da wir im weiteren Verlauf alle Anfragen einer Personengruppe einfließen lassen, rechnen wir erneut eine logistische Regression mit einen Zufallsfaktor je angeschriebener Wohnung. Dieser modelliert das unterschiedliche Antwortverhalten verschiedener Vermieter. Im Unterschied zu den Diskriminierungsraten verwenden wir für die weiteren Kennzahlen die Ergebnisse aus den Modellen auch direkt in der Berichterstattung.

Positive Rückmeldungen nach Geschlecht

Hier führen wir eine logistische Regression durch, in der wir alle uns zur Verfügung stehenden Variablen kontrollieren:

positive ~ nat + geschlecht + orga + city + run + position_normal + (1 | link)

Unser Ziel ist es den Effekt, den das Geschlecht auf die Wahrscheinlichkeit einer positiven Rückmeldung hat, separiert vom Einfluss anderer Faktoren darzustellen. Die Differenz der vorhergesagten Wahrscheinlichkeiten auf eine positive Rückmeldung für Frauen und Männer, entspricht den AMEs aus dem Regressionsmodell (annähernd exakt).

# exclude requests from persons with extreme profile and duplicate-requests
dat = confirmations_meta %>%
  filter(duplicate != TRUE) %>%
  filter(profile_type == "normal") %>%
  inner_join(
    flats %>%
      select(link, city, orga, order, order_normal, run),
    by = c("link", "run")) %>%
  left_join(
    mails_meta %>%
      group_by(link, run, person) %>%
      filter(category == min(category)) %>%
      slice(1),
    by = c("link", "run", "person", "herkunft", "city", "orga", "geschlecht")) %>%
  mutate(
    nat = herkunft,
    hintergrund = ifelse(nat == "deutsch", "bio", "mig"),
    nat = ifelse(nat == "deutsch", "_deutsch", nat),
    positive = ifelse(is.na(category) | category > 2, 0, 1),
    city = ifelse(city == "münchen", "_münchen", city)
  ) %>%
  select(positive, nat, city, orga, geschlecht, run, link, hintergrund, position_normal)
predict_probabilities = function(model, var_fixed, categories) {
  # predicts the mean probability for each category of var_fixed referring to model
  predict_mean_probability = function (value) {
    # predicts the mean probability for var_fixed = value
    value = paste0("'", value, "'")
    tmpdat = dat %>% mutate_(.dots = setNames(value, var_fixed))
    pp = predict(model, newdata = tmpdat, type = "response")
    mean(pp) * 100
  }
  positive_shares = as.data.frame(sapply(categories, predict_mean_probability))
  positive_shares$var_fixed = rownames(positive_shares)
  colnames(positive_shares)[1] = "share"
  ggplot(positive_shares) +
    geom_bar(
      aes(x = reorder(var_fixed, share, max), y = share),
      stat ='identity') +
    ylab("Positive Rückmeldungen (%)") +
    geom_text(
      aes(x = var_fixed, share, y=share, label = paste0(round(share, 0), "%")),
      nudge_y = -1,
      colour="white") +
    theme(axis.title.y = element_blank()) +
    coord_flip()
}
# include both for effect of gender
m <- glmer(positive ~ nat + geschlecht + orga + city + run + position_normal + (1 | link), data = dat, family = binomial(link=logit), control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)
predict_probabilities(m, "geschlecht", c("männlich", "weiblich"))

glmermfx(m)

                   marginal.effects standard.error      p-value
natarabisch           -0.0771914628    0.005889405 3.008965e-39
natitalienisch        -0.0264067300    0.005078624 1.997353e-07
natpolnisch           -0.0349296357    0.005124395 9.338677e-12
nattürkisch           -0.0689866353    0.005699879 1.016025e-33
geschlechtweiblich     0.0486277834    0.009113675 9.517980e-08
orgaprivate           -0.0955645424    0.011251284 2.002358e-17
cityberlin             0.1844188674    0.021993399 5.064316e-17
citydortmund           0.0314212592    0.021769342 1.489157e-01
citydresden           -0.0001610433    0.022373128 9.942568e-01
cityfrankfurt          0.0860595856    0.021921047 8.641016e-05
cityhamburg            0.1391437339    0.021288299 6.311828e-11
cityköln               0.0842501263    0.021465867 8.678687e-05
cityleipzig            0.0475763405    0.021867263 2.957860e-02
citymagdeburg          0.0162161336    0.023381511 4.879675e-01
citynürnberg           0.0871719757    0.022247684 8.919434e-05
run                   -0.0729745918    0.010511255 3.851687e-12
position_normal       -0.0034310035    0.001994839 8.544333e-02

• Frauen haben generell eine statistisch signifikant höhere Wahrscheinlichkeit, eine positive Rückmeldung zu erhalten, als Männer – und zwar unabhängig von der Herkunft.

Positive Rückmeldungen nach Organisationsform

Hier ist das Vorgehen analog zur Auswertung nach Geschlecht. Wir verwenden das gleiche Modell wie oben.

predict_probabilities(m, "orga", c("company", "private"))

• Private Anbieter geben generell statistisch signifikant weniger positive Rückmeldungen als professionelle.

Positive Rückmeldungen nach Stadt

Auch hier ist das Vorgehen analog zur Auswertung nach Geschlecht. Einziger Unterschied ist, dass wir hier ein Modell rechenen, das nicht die Organisationsform der Vermieter kontrolliert:

positive ~ nat + geschlecht + city + run + position_normal + (1 | link)

Wir gehen nämlich davon aus, dass die Verteilung von privaten und gewerblichen Wohnungsanbietern zwischen den Städten unterschiedlich ist und wir diese in unserem Experiment entsprechend erfasst haben. Diese Unterschiede möchten wir in die Auswertung einfließen lassen.

cities = c("_münchen", "dresden", "dortmund", "magdeburg", "köln", "leipzig", "frankfurt", "nürnberg", "hamburg", "berlin")
m_without_orga <- glmer(positive ~ nat + geschlecht + city + run + position_normal + (1 | link), data = dat, family = binomial(link=logit), control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)
predict_probabilities(m_without_orga, "city", cities)

glmermfx(m_without_orga)

                   marginal.effects standard.error      p-value
natarabisch            -0.076484349    0.005873041 9.059543e-39
natitalienisch         -0.026268345    0.005027984 1.746934e-07
natpolnisch            -0.034634256    0.005096294 1.075869e-11
nattürkisch            -0.068388633    0.005706224 4.262651e-33
geschlechtweiblich      0.047348311    0.009040731 1.630120e-07
cityberlin              0.209524352    0.021723151 5.150570e-22
citydortmund            0.041324560    0.020805912 4.701189e-02
citydresden             0.034998164    0.019284310 6.954669e-02
cityfrankfurt           0.087233685    0.022088898 7.840970e-05
cityhamburg             0.154075681    0.021450264 6.823457e-13
cityköln                0.077120326    0.019802885 9.844273e-05
cityleipzig             0.078922191    0.020790420 1.469994e-04
citymagdeburg           0.052729637    0.021979192 1.643674e-02
citynürnberg            0.092540513    0.022071879 2.756680e-05
run                    -0.073178041    0.010197383 7.169736e-13
position_normal        -0.003614029    0.002048099 7.763482e-02

• Die Quote positiver Rückmeldungen unterscheidet sich stark je Stadt. Die deutlich niedrigste Quote weist München auf. In Berlin und auch in Hamburg erhalten die Bewerber vergleichsweise viele Rückmeldungen.

Chancenverhältnisse

Ein Regressionsmodell bildet auch die Grundlage für die Berechnung des Chancenverhältnisses zwischen Deutschen und Bewerbern mit ausländischen Namen. Die Chance auf eine positive Rückmeldung ergibt sich aus dem Anteil der positiven Rückmeldungen (p) wie folgt:

chance = p / (1 - p)

Das Chancenverhältnis (r) zwischen ausländischen und deutschen Bewerbern ist somit:

r = chance_auslaendisch / chance_deutsch

Es bildet ab, wie schwer es Personen mit ausländischem Namen im Vergleich zu deutschen Bewerbern auf dem Wohnungsmarkt haben. Das Chancenverhältnis ermöglicht es, die vier ausländischen Gruppen zusammenzufassen und Aussagen auf Stadtebene zu treffen.

Aus den gleichen Gründen wie oben, verwenden wir in der Berichterstattung auch hier die Ergebnisse aus der logistischen Regression. Wir rechnen hier ein Modell, in dem eine Interaktion zwischen der Stadt und dem zugeschriebenen Migrationshintergrund eines Bewerbers explizit modelliert wird.

positive ~ hintergrund * city + geschlecht + run + position_normal + (1 | link)

Genau das ist ja die Annahme, die dieser Metrik zugrunde liegt. Als Ergebnis erhalten wir folgendes Balkendiagramm:

m_interact <- glmer(positive ~ hintergrund * city + geschlecht + run + position_normal + (1 | link), data = dat, family = binomial(link=logit), control = glmerControl(optimizer = "bobyqa"), nAGQ = 10)
calculate_discr_indicator = function (var_city, indicator) {
  # calculate indicator ("OR" | "delta") that indicates discrimination for a city
  tmpdat = dat %>% mutate(city = var_city)
  jvalues =c("bio", "mig")
  pp = sapply(jvalues, function(j) {
    # predict the probabilities once for Germans ("bio") and once for foreigners ("mig")
    tmpdat$hintergrund <- j
    predict(m_interact, newdata = tmpdat, type = "response")
  })
  if (indicator == "OR") {
    ratio = (mean(pp[ , 1]) / (1 - mean(pp[ , 1])))/(mean(pp[ , 2]) / (1 - mean(pp[ , 2])))
    ratio
  } else if (indicator == "RR") {
    
    
    ratio = (mean(pp[ , 1])) / (mean(pp[ , 2]))
    ratio
  } else {
    delta = mean(pp[ , 1]) - mean(pp[ , 2])
    # print(paste("manually calculated AME:", delta, "(mean - mean)"))
    # print(paste("manually calculated AME:", mean(pp[ , 1] - pp[ , 2]), "(mean - )"))
    delta
  }
}
OR_per_city = as.data.frame(sapply(cities, calculate_discr_indicator, indicator = "OR"))
OR_per_city$city = rownames(OR_per_city)
# calculate how many percentage the odds of foreigners are lower compared to the odds of Germans
OR_per_city$share = -(1 - (OR_per_city[1])^-1) * 100
ggplot(OR_per_city) +
  geom_bar(
    aes(x = reorder(city, -share), y = share),
    stat = 'identity') +
  geom_text(
    aes(x = city, y = share, label = paste0(round(share, 0), "%")),
    nudge_y = 2,
    colour = "white") +
  # theme(axis.title.y = element_blank()) +
  coord_flip() + 
  labs(subtitle = "Lesebeispiel: In München sind die Chancen auf eine positive Rückmeldung für einen ausländischen Bewerber beinahe um die\n Hälfte niedriger als die einer deutschen Person", x = "", y = "Chancenminus (%)")

• In München haben ausländische Bewerber gegenüber deutschen deutlich geringere Chancen eine positive Rückmeldung zu erhalten als in den übrigen Städten. Mit einigem Abstand folgt Frankfurt an zweiter Stelle. In Dortmund und den ostdeutschen Städten Magdeburg und Leipzig ist der Chancenunterschied hingegen am geringsten. Aufgrund teils niedriger Fallzahlen sind kleinere Unterschiede zwischen den Städten und deren jeweilige Positionen gerade im mittleren Bereich nur sehr vorsichtig zu interpretieren.

Ansprechpartner

Bayerischer Rundfunk
BR Data

Uli Köppen
Robert Schöffel
Oliver Schnuck

Spiegel Online
Ressort Datenjournalismus

Christina Elmer
Patrick Stotz
Achim Tack