Explorative Datenanalyse von Fahrraddiebstähle

1. Herkunft der Daten

Die zugrunde liegenden Daten wurden in einer Online-Umfrage im November 2021 erhoben. Das Ziel dieser Umfrage ist es, das Ausmaß von Fahrraddiebstahl in Nordamerika, Europa und dem Vereinigten Königreich einschätzen zu können.

Die Umfrage umfasst 12 Fragen, welche hier unverändert in der aufgelistet sind. Bei der Auswahl der Antwort-Möglichkeiten “Other” beziehungsweise “Others” wird zusätzlich gewünscht, diese Antwort als Freitext zu spezifizieren. Eine Verifizierung der Eingabe bietet das Formular nicht. So ist es beispielsweise möglich anzugeben, das Fahrrad wäre gleichzeitig abgesichert und nicht abgesichert gewesen.

Frage	Antwort-Möglichkeiten	Mehrfachauswahl	Verpflichtend
How many times has your bike been stolen since you started cycling?	Never 1 2 3 4 5 6 times or more	Nein	Ja
Where was the last bike stolen from?	Street Front garden / yard Back garden / yard Shed Garage Inside home Work or Public Authority bike parking	Nein	Nein
What was the bike secured with?	It wasn’t locked Cable lock U-lock / D-lock Chain lock Folding lock	Ja	Nein
What security rating did the primary lock have?	Don’t know None Sold Secure Bronze Sold Secure Silver Sold Secure Gold Sold Secure Diamond Other	Nein	Nein
How much did you spend on your locks?	Less than 20 20 - 40 41 - 60 61 - 100 More than 100	Nein	Nein
What was the approximate value of the bike?	Less than 100 100 - 400 401 - 700 701 - 1000 Over 1000	Nein	Nein
Did you have a record of the frame number of the bike?	Yes No	Nein	Nein
Did you report the stolen bike to the police?	Yes No	Nein	Nein
Did you get the stolen bike back?	Yes No	Nein	Nein
How many times have components (wheels, seats, brakes etc) been stolen from your bike?	Never 1 2 3 4 5 6 times or more	Nein	Ja
Which components have been stolen?	Wheels Seats Handlebars Headset Forks Brakes Gears Lights Others	Ja	Nein
What was the last stolen component attached / secured with?	Quick release clamp only Quick release clamp plus cable Hex bolt or Standard nut only Hex bolt or Standard nut plus cable Security skewers / nuts (Pinhead, Pitlock, Hexlox etc) Any other type of secondary bike lock	Nein	Nein

Als Belohnung wurde den ersten 5000 Teilnehmern eine Gewinnchance auf ein Fahrrad im Wert von bis zu 600 $ in Aussicht gestellt. Eine Mehrfachteilnahme wird nicht verhindert, weshalb es nahe liegt, dass einzelne Teilnehmer mehrfach die Umfrage beantworten, um ihre Gewinnchancen zu steigern.

Neben den Antworten auf die Fragen enthält der Datensatz den Standort der Teilnehmer. Da diese nicht explizit vom Teilnehmer angegeben wird, handelt es sich wahrscheinlich um eine grobe Bestimmung anhand der IP-Adresse statt einer exakten Methode.

2. Einlesen der Daten

Die Daten liegen in einer Excel-Datei vor, welche als Spaltennamen die jeweiligen Fragen verwendet. Für eine bessere Handhabung werden die Spaltennamen durch Umbenennen vereinfacht.

library(rmarkdown)

knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)

library(readxl)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

data_source <- './Data_With_Geolocations_stud.xlsx'
sheet_name <- 'Geolocation expanded'

data <- read_excel(data_source, sheet = sheet_name) %>%
  rename(
    bike_stolen_frequency = 'How many times has your bike been stolen since you started cycling?',
    place_of_last_bike_theft = 'Where was the last bike stolen from?',
    bike_securing_method = 'What was the bike secured with?',
    bike_lock_rating = 'What security rating did the primary lock have?',
    other_lock_rating = 'Please specify the other security rating...',
    bike_lock_cost = 'How much did you spend on your locks?',
    bike_cost = 'What was the approximate value of the bike?',
    frame_number_record = 'Did you have a record of the frame number of the bike?',
    police_report = 'Did you report the stolen bike to the police?',
    bike_retrieved = 'Did you get the stolen bike back?',
    components_stolen_frequency = 'How many times have components (wheels, seats, brakes etc) been stolen from your bike?',
    components_stolen = 'Which components have been stolen?',
    other_components_stolen_description = 'Please specify the other components...',
    component_securing_method = 'What was the last stolen component attached / secured with?',
    location_description = 'Geolocation Details',
    location_latitude = 'Latitude',
    location_longitude = 'Longitude',
    location_country = 'Country',
    location_city = 'City'
  )

paged_table(data)

3. Aufbereitung

Alle gewählten Antworten bei Fragen mit Mehrfachauswahl befinden sich in der gleichen Spalte. Um die Qualität der Daten zu verbessern, wird für jede Option einer Mehrfachauswahl eine weitere Spalte abgeleitet.

library(stringr)
library(purrr)

check_multi_selection <- function(method, column) {
  if_else(
    is.na(column),
    NA,
    if_else(
      map_lgl(str_split(column, '\r\n'), ~method %in% .x),
      'Yes',
      'No'
    )
  )
}

data <- data %>%
  mutate(
    bike_not_locked = check_multi_selection('It wasn’t locked', bike_securing_method),
    bike_cable_lock = check_multi_selection('Cable lock', bike_securing_method),
    bike_u_d_lock = check_multi_selection('U-lock / D-lock', bike_securing_method),
    bike_chain_lock = check_multi_selection('Chain lock', bike_securing_method),
    bike_folding_lock = check_multi_selection('Folding lock', bike_securing_method),
    wheels_stolen = check_multi_selection('Wheels', components_stolen),
    seats_stolen = check_multi_selection('Seats', components_stolen),
    handlebars_stolen = check_multi_selection('Handlebars', components_stolen),
    headset_stolen = check_multi_selection('Headset', components_stolen),
    forks_stolen = check_multi_selection('Forks', components_stolen),
    brakes_stolen = check_multi_selection('Brakes', components_stolen),
    gears_stolen = check_multi_selection('Gears', components_stolen),
    lights_stolen = check_multi_selection('Lights', components_stolen),
    other_components_stolen = check_multi_selection('Others', components_stolen),
  )

paged_table(data)

4. Quantitative Betrachtung der Teilnahmen

Da die Umfragedaten keine Rückschlüsse auf die Teilnehmer zulassen, lassen sich lediglich die Teilnahmen betrachten. Eine mehrfache Teilnahme lässt sich nicht eindeutig identifizieren.

Wie viele Antworten auf die Umfrage wurden abgegeben?

library(ggplot2)

donut_diagram <- function(data, values, fill, annotation) {
  donut_diameter <- 2.5

  ggplot(data, aes(x = donut_diameter, y = values, fill = fill)) +
    geom_col() +
    geom_text(aes(label = values), position = position_stack(vjust = 0.5), color = 'white') +
    coord_polar(theta = "y") +
    xlim(c(0.2, donut_diameter + 0.5)) +
    theme(
      panel.background = element_rect(fill = 'white', color = 'white'),
      axis.title = element_blank(),
      axis.text = element_blank(),
      axis.ticks = element_blank()
    ) +
    annotate(
      'text',
      label = annotation,
      fontface = 'bold',
      color = 'black',
      size = 16,
      x = 0.3,
      y = 0
    )
}

total_count <- nrow(data)
unique_count <- data %>% unique() %>% nrow()

submission_counts <- data.frame(
  count = c(unique_count, total_count - unique_count),
  group = c("Yes", "No")
)

submission_counts %>%
  donut_diagram(values = submission_counts$count, fill = submission_counts$group, annotation = total_count) +
  labs(
    title = 'Anzahl der Teilnahmen',
    fill = 'Einzigartig'
  )

Die Doppelnennungen können zufällig entstehen, da ein Teilnehmer die gleiche Erfahrung gemacht haben kann wie ein anderer. Der Anteil dieser Antworten liegt bei unter 2 %, weshalb hier keine genauere Betrachtung benötigt wird und im restlichen Notebook der volle Datensatz verwendet wird.

5. Geographische Auswertung der Teilnahmen

Aus wie vielen Ländern kommen die Teilnahmen?

country_count <- data %>%
  select(location_country) %>%
  unique() %>%
  filter(!is.na(location_country)) %>%
  nrow()

ggplot() +
  annotate('text', x = 0, y = 0, size = 16, label = paste('≥', country_count)) +
  theme_void()

Das Ergebnis ist als Mindestanzahl zu verstehen, da Teilnahmen nicht immer einem Land zugeordnet werden können und gegebenenfalls aus weiteren Ländern getätigt worden sind.

Aus welchen Regionen kommen die Teilnahmen?

library(maps)

world_map <- map_data('world')

ggplot() +
  geom_polygon(data = world_map, aes(x = long, y = lat, group = group)) +
  theme(
    panel.background = element_rect(fill = 'white', color = 'black'),
    axis.line = element_line(color = 'black'),
    axis.title = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank()
  ) +
  geom_point(
    data = data,
    aes(x = as.numeric(location_longitude), y = as.numeric(location_latitude)),
    color = 'Deep Pink',
    fill = 'Pink',
    pch = 21,
    size = 2,
    alpha = I(0.5)
  ) +
  labs(
    title = 'Orte der Teilnahmen',
    caption = 'Ein Marker entspricht eine Teilnahme.',
  )

Welche Regionen sind am meisten vertreten?

library(treemapify)

submissions_per_region <- data %>%
  group_by(location_country, location_city) %>%
  summarize(region_count = n())

top_countries <- submissions_per_region %>%
  filter(!is.na(location_country)) %>%
  group_by(location_country) %>%
  summarize(country_count = sum(region_count)) %>%
  arrange(desc(country_count)) %>%
  top_n(5) %>%
  select(location_country)

country_city_distrubition <- function(region_counts, country) {
  country_regions <- region_counts %>%
    filter(location_country == country, !is.na(location_city))

  top_region_counts <- country_regions %>%
    arrange(desc(region_count)) %>%
    top_n(5)

  other_region_combined_count <- country_regions %>%
    filter(!(location_city %in% top_region_counts$location_city)) %>%
    summarize(region_count = sum(region_count), location_city = 'Other')

  bind_rows(top_region_counts, other_region_combined_count)
}

top_regions_per_top_country <- bind_rows(
  top_countries$location_country %>% map_df(\(x) country_city_distrubition(submissions_per_region, x)),
  data %>%
    filter(!(location_country %in% top_countries$location_country)) %>%
    summarize(region_count = n(), location_city = 'Other', location_country = 'Other')
)

ggplot(
  top_regions_per_top_country,
  aes(area = region_count, fill = location_country, subgroup = location_country, label = location_city)
) +
  geom_treemap() +
  geom_treemap_text(colour = 'white', place = 'centre', grow = FALSE) +
  labs(
    title = 'Regionen mit den meisten Teilnahmen',
    caption = 'Die Flächen der Teile entspricht der Anzahl der Teilnahmen.',
    fill = 'Land'
  )

6. Unstimmigkeiten in den Daten

Da wie genannt das Formular der Umfrage keine hinreichende Validierung durchführt, treten Widersprüche in den Daten auf. Um widerspruchslose Aussagen treffen zu können, werden die problematischen Daten bei der Auswertung ausgeschlossen.

Zu welchem Anteil sind Fahrräder als gestohlen angenommen worden, ohne gestohlen zu sein?

stolen_never_stolen <- function(data, stated_condition, frequency) {
  frequency <- deparse(substitute(frequency))

  data %>%
    mutate(frequency = map_chr(data[[frequency]], \(x) if_else(x == 'Never', 'No', 'Yes'))) %>%
    filter(stated_condition) %>%
    group_by(frequency) %>%
    summarize(submission_count = n())
}

bike_stolen_never_stolen <- function(data, stated_condition, case) {
  data %>%
    stolen_never_stolen(
      stated_condition = stated_condition,
      frequency = bike_stolen_frequency
    ) %>%
    summarize(frequency, submission_count, case = case)
}

bike_theft_counts <- bind_rows(
  data %>% bike_stolen_never_stolen(data$bike_retrieved == 'Yes', 'Bike retrieved'),
  data %>% bike_stolen_never_stolen(data$bike_retrieved == 'No', 'Bike not retrieved'),
  data %>% bike_stolen_never_stolen(data$police_report == 'Yes', 'Bike theft reported to police')
)

total_bike_theft_counts <- bike_theft_counts %>%
  group_by(case) %>%
  summarize(submission_count = sum(submission_count))

bike_theft_counts %>% ggplot(aes(x = case, y = submission_count, fill = frequency)) +
  geom_bar(stat = 'identity') +
  geom_text(aes(label = submission_count), position = position_stack(vjust = 0.5), color = 'white') +
  geom_text(data = total_bike_theft_counts, aes(label = submission_count, fill = NULL), hjust = -0.5, color = 'black') +
  ylim(c(0, 3750)) +
  theme(
    axis.ticks = element_blank(),
    axis.title = element_blank(),
    axis.text.x = element_blank(),
    panel.background = element_rect(fill = 'white', color = 'white')
  ) +
  coord_flip() +
  labs(
    title = 'Anzahl der als gestohlen angegebenen Fahrräder je Sachverhalten',
    fill = 'Fahrrad gestohlen',
  )

In wie vielen Fällen wurden Komponenten als gestohlen angegeben, ohne gestohlen worden zu sein?

stolen_component_counts <- data %>%
  stolen_never_stolen(
    stated_condition = !is.na(data$components_stolen),
    frequency = components_stolen_frequency
  )

stolen_component_counts %>%
  donut_diagram(
    values = stolen_component_counts$submission_count,
    fill = stolen_component_counts$frequency,
    annotation = stolen_component_counts %>% summarize(submission_count = sum(submission_count))
  ) +
  labs(
    title = 'Anzahl der Teilnahmen mit als geklaut angegebene Komponenten',
    fill = 'Komponente gestohlen',
    caption = 'Anzahl der Teilnahmen welche als mindestens eine Komponente als gestohlen angeben.'
  )

7. Ausmaß der Diebstähle

Wie häufig treten Diebstähle auf?

heat_map_design <- function(plot) {
  plot +
    geom_tile(color = 'white', lwd = 1.5, linetype = 1) +
    coord_fixed() +
    scale_fill_gradient(low = "grey", high = "Deep Pink") +
    theme(
      plot.title = element_text(hjust = 0.5),
      plot.caption = element_text(hjust = 0.5),
      panel.background = element_rect(fill = 'white', color = 'white'),
      axis.line = element_line(color = 'white'),
      axis.ticks = element_blank(),
      axis.title.y = element_text(margin = margin(r = 10)),
      axis.title.x = element_text(margin = margin(t = 10)),
      axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
      legend.position = 'none'
    )
}

data %>%
  group_by(bike_stolen_frequency, components_stolen_frequency) %>%
  summarize(
    submission_count = n(),
    bike_frequency_order = if_else(bike_stolen_frequency == 'Never', '0', bike_stolen_frequency),
    components_frequency_order = if_else(
      components_stolen_frequency == 'Never',
      '0',
      components_stolen_frequency
    )
  ) %>%
  ggplot(aes(x = bike_frequency_order, y = components_frequency_order, fill = submission_count)) %>%
  heat_map_design() +
  geom_text(aes(label = submission_count), color = 'white', size = 4) +
  labs(
    title = 'Anzahl der Teilnahmen pro Anzahl der erlebte Diebstähle',
    y = 'Anzahl der erlebten Komponentendiebstähle',
    x = 'Anzahl der erlebten Fahrraddiebstähle'
  )

Da gerade weniger als ein Fünftel der Teilnahmen keine Diebstähle angeben, lässt sich darüber hinaus ein Selection-Bias vermuten. Bei einer öffentlichen Onlineumfrage handelt es sich nicht immer um eine randomisierte Stichprobe. Es ist denkbar, dass Teilnehmer, die Diebstahl erlebt haben, ein größeres Interesse aufweisen und dadurch überproportional vertreten sind.

In welchen Ländern wird am wahrscheinlichsten mindestens ein Fahrrad gestohlen?

Die Frage wird mittels der bedingten Diebstahlwahrscheinlichkeit beantwortet. Da häufig Länder zu wenige Teilnahmen haben, um eine treffende Aussage machen zu können, sind diese unter “Other” zusammengefasst.

theft_per_country <- data %>%
  filter(!is.na(location_country)) %>%
  mutate(
    bike_stolen = if_else(bike_stolen_frequency == 'Never', 'No', 'Yes'),
    location_country = if_else(location_country %in% top_countries$location_country, location_country, 'Other')
  ) %>%
  group_by(location_country, bike_stolen) %>%
  summarize(submission_count = n())

theft_totals_per_country <- theft_per_country %>%
  group_by(location_country) %>%
  summarize(total_submission_per_country = sum(submission_count))

merge(theft_per_country, theft_totals_per_country) %>%
  filter(bike_stolen == "Yes") %>%
  mutate(theft_likelihood = submission_count / total_submission_per_country) %>%
  arrange(desc(theft_likelihood)) %>%
  ggplot(aes(x = location_country, y = theft_likelihood, fill = location_country)) +
  coord_cartesian(ylim = c(0.65, 0.85)) +
  geom_bar(stat = 'identity') +
  geom_text(aes(label = scales::percent(theft_likelihood)), vjust = -1, color = 'black') +
  theme(
    legend.position = 'none',
    axis.title.x = element_blank(),
    axis.ticks.x = element_blank(),
    axis.title.y = element_text(margin(r = 20))
  ) +
  labs(
    title = 'Fahrraddiebstahlswahrscheinlichkeit für die Länder mit den meisten Teilnahmen',
    y = 'Diebstahlwahrscheinlichkeit',
    caption = 'Wahrscheinlichkeiten, dass mindestens ein Fahrrad gestohlen wird.'
  )

Auch hier lässt sich wie oben erklärt ein Selection-Bias vermuten. Es fällt jedoch auf, dass die Diebstahlwahrscheinlichkeit in Kanada und den Vereinigten Staaten mit über 80 % am höchsten liegt. Eine mögliche Begründung könnte die hohe Abhängigkeit vom Auto in den Ländern sein. Ein Fahrrad ist für die Mehrheit der Bevölkerung in den Ländern ein Sportgerät, nicht ein alltägliches Transportmittel. Dies könnte zu einem Diebstahl durch wertvollere Fahrräder attraktiver machen und zum anderen soziale Hemmungen reduzieren, da ein Diebstahl nicht einen Mobilitätsverlust verursacht.

Welche Komponenten werden am meisten gestohlen?

stolen_components <- data %>%
  filter(components_stolen_frequency != 'Never')

count_stolen <- function(data, name, column) {
  column <- deparse(substitute(column))

  data %>%
    filter(data[[column]] == "Yes") %>%
    summarize(submission_count = n(), component = name) %>%
    summarize(component, theft_frequency = submission_count / nrow(data))
}

bind_rows(
  stolen_components %>% count_stolen('Wheels', wheels_stolen),
  stolen_components %>% count_stolen('Seats', seats_stolen),
  stolen_components %>% count_stolen('Handlebars', handlebars_stolen),
  stolen_components %>% count_stolen('Headsets', headset_stolen),
  stolen_components %>% count_stolen('Forks', forks_stolen),
  stolen_components %>% count_stolen('Brakes', brakes_stolen),
  stolen_components %>% count_stolen('Gears', gears_stolen),
  stolen_components %>% count_stolen('Lights', lights_stolen),
  stolen_components %>% count_stolen('Other', other_components_stolen),
) %>%
  ggplot(aes(x = component, y = theft_frequency, fill = '')) +
  geom_bar(stat = 'identity') +
  geom_text(aes(label = scales::percent(theft_frequency)), vjust = -1, color = 'black') +
  theme(
    legend.position = 'none',
    axis.ticks = element_blank(),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
  ) +
  ylim(c(0, 0.5)) +
  labs(
    title = 'Häufigkeit der Diebstähle je Komponente unter den Komponentendiebstählen',
  )

Es fällt auf, das Komponenten, die ohne Werkzeuge entfernt werden können, auch deutlich häufiger gestohlen werden als die, die Werkzeug benötigen.

8. Effektivität der Maßnahmen zur Fahrraddiebstahlaufklärung

Eine Aussage zur Effektivität einer Maßnahme lässt sich durch das Vergleichen der bedingten Wahrscheinlichkeit treffen.

Werden Fälle mit bekannter Rahmennummer öfters Äufgeklärt?

library(kableExtra)
library(knitr)
library(tibble)
library(tidyr)

stolen_bikes <- data %>%
  filter(bike_stolen_frequency != 'Never')

two_conditions <- function(data, condition_x, condition_y) {
  condition_x <- deparse(substitute(condition_x))
  condition_y <- deparse(substitute(condition_y))

  data %>%
    filter(!is.na(data[condition_x]), !is.na(data[[condition_y]])) %>%
    group_by(.data[[condition_x]], .data[[condition_y]]) %>%
    summarize(submission_count = n())
}

yes_no_label <- function(value, yes, no) {
  case_when(
    value == "Yes" ~ yes,
    value == "No" ~ no,
    .default = value
  )
}

contingency_table <- function(data, condition_x, condition_y, x_lables, y_lables) {
  condition_x <- deparse(substitute(condition_x))
  condition_y <- deparse(substitute(condition_y))

  sum_label <- 'Summe'
  sum_color <- '#f3f3f3'

  frame <- data %>%
    mutate(
      '{condition_x}' := x_lables(.data[[condition_x]]),
      '{condition_y}' := y_lables(.data[[condition_y]]),
    ) %>%
    pivot_wider(names_from = condition_x, values_from = submission_count) %>%
    column_to_rownames(var = condition_y) %>%
    as.matrix() %>%
    addmargins() %>%
    as.data.frame()

  colnames(frame)[3] <- sum_label
  row.names(frame)[3] <- sum_label

  frame %>%
    kable(format = 'html') %>%
    kable_styling() %>%
    row_spec(0, extra_css = 'border-bottom: 1px solid;') %>%
    row_spec(2, extra_css = 'border-bottom: 1px solid;') %>%
    column_spec(1, bold = TRUE, border_right = TRUE, include_thead = TRUE) %>%
    column_spec(4, background = sum_color, include_thead = TRUE, border_left = TRUE) %>%
    row_spec(3, background = sum_color) %>%
    print()

  data
}

two_conditions_plot <- function(data, condition_x, condition_y) {
  condition_x <- deparse(substitute(condition_x))
  condition_y <- deparse(substitute(condition_y))

  data %>%
    mutate(likelihood = submission_count / nrow(data)) %>%
    ggplot(aes(x = .data[[condition_x]], y = .data[[condition_y]], fill = likelihood)) %>%
    heat_map_design() +
    geom_text(aes(label = scales::percent(likelihood)), color = 'white', size = 4)
}

retrieve_to_frame_number <- stolen_bikes %>% two_conditions(bike_retrieved, frame_number_record)

retrieve_to_frame_number %>%
  contingency_table(
    bike_retrieved,
    frame_number_record,
    \(x) yes_no_label(x, "Fahrrad zurückerhalten", "Fahrrad nicht zurückerhalten"),
    \(y) yes_no_label(y, "Rahmennummer bekannt", "Rahmennummer nicht bekannt")
  ) %>%
  two_conditions_plot(bike_retrieved, frame_number_record) +
  labs(
    title = 'Aufklärungsquotenverteilung der Fahrraddiebstähle in Abhängikeit zur Rahmennummer',
    x = 'Fahrrad zurückerhalten',
    y = 'Rahmennummer bekannt',
    caption = 'Die Randhäufigkeiten entsprechen der Summe einer einzeler Zeile beziehungsweiße Spalte.'
  )

	Fahrrad nicht zurückerhalten	Fahrrad zurückerhalten	Summe
Rahmennummer nicht bekannt	2393	357	2750
Rahmennummer bekannt	719	356	1075
Summe	3112	713	3825

improvement_plot <- function(data, fixed_condition, changing_condition) {
  fixed_condition <- deparse(substitute(fixed_condition))
  changing_condition <- deparse(substitute(changing_condition))

  totals <- data %>%
    group_by(.data[[changing_condition]]) %>%
    summarize(total = sum(submission_count))

  likelihoods <- merge(data, totals, by = changing_condition) %>%
    filter(.data[[fixed_condition]] == "Yes") %>%
    mutate(likelihood = submission_count / total)

  likelihood <- function(data, condition) {
    (data %>% filter(.data[[changing_condition]] == condition))$likelihood[[1]]
  }

  improvement <- ((likelihoods %>% likelihood("Yes")) / (likelihoods %>% likelihood("No"))) - 1

  ggplot() +
    annotate('text', x = 0, y = 0, size = 14, label = paste(scales::percent(improvement), 'more likely')) +
    theme_void()
}

retrieve_to_frame_number %>%
  improvement_plot(bike_retrieved, frame_number_record)

Werden Fälle mit polizeilicher Meldung öfters Äufgeklärt?

retrieve_to_report <- stolen_bikes %>%
  two_conditions(bike_retrieved, police_report)

retrieve_to_report %>%
  contingency_table(
    bike_retrieved,
    police_report,
    \(x) yes_no_label(x, "Fahrrad zurückerhalten", "Fahrrad nicht zurückerhalten"),
    \(x) yes_no_label(x, "Polizeilich gemeldet", "Polizeilich nicht gemeldet")
  ) %>%
  two_conditions_plot(bike_retrieved, police_report) +
  labs(
    title = 'Aufklärungsquotenverteilung der Fahrraddiebstähle in Abhängikeit zur polizeilicher Behörde',
    x = 'Fahrrad zurückerhalten',
    y = 'Polizeilich gemeldet',
    caption = 'Die Randhäufigkeiten entsprechen der Summe einer einzeler Zeile beziehungsweiße Spalte.'
  )

	Fahrrad nicht zurückerhalten	Fahrrad zurückerhalten	Summe
Polizeilich nicht gemeldet	1675	362	2037
Polizeilich gemeldet	1435	348	1783
Summe	3110	710	3820

retrieve_to_report %>% improvement_plot(bike_retrieved, police_report)

Werden Fälle mit Rahmennummer öfters polizeilich gemeldet?

report_to_frame_number <- stolen_bikes %>%
  two_conditions(police_report, frame_number_record)

report_to_frame_number %>%
  contingency_table(
    police_report,
    frame_number_record,
    \(x) yes_no_label(x, "Polizeilich gemeldet", "Polizeilich nicht gemeldet"),
    \(y) yes_no_label(y, "Rahmennummer bekannt", "Rahmennummer nicht bekannt")
  ) %>%
  two_conditions_plot(police_report, frame_number_record) +
  labs(
    title = 'Polizeiliche Fahrraddiebstahlmeldequotenverteilung in Abhängikeit zur Rahmennummer',
    x = 'Polizeilich gemeldet',
    y = 'Rahmennummer bekannt',
    caption = 'Die Randhäufigkeiten entsprechen der Summe einer einzeler Zeile beziehungsweiße Spalte.'
  )

	Polizeilich nicht gemeldet	Polizeilich gemeldet	Summe
Rahmennummer nicht bekannt	1717	1036	2753
Rahmennummer bekannt	324	749	1073
Summe	2041	1785	3826

report_to_frame_number %>% improvement_plot(police_report, frame_number_record)