main.Rmd

---
title: "Explorative Datenanalyse von Fahrraddiebstähle"
---


# 1. Herkunft der Daten

Die zugrunde liegenden Daten wurden in einer [Online-Umfrage](https://thebestbikelock.com/win-free-bike-competition/)
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.

<!-- @formatter:off -->

------------------------------------------------------------------------------------------------------------------------
Frage                                               Antwort-Möglichkeiten                  Mehrfachauswahl Verpflichtend
--------------------------------------------------- -------------------------------------- --------------- -------------
How many times has your bike been stolen since you  Never<br>                              Nein            Ja
started cycling?                                    1<br>
                                                    2<br>
                                                    3<br>
                                                    4<br>
                                                    5<br>
                                                    6 times or more

Where was the last bike stolen from?                Street<br>                             Nein            Nein
                                                    Front garden / yard<br>
                                                    Back garden / yard<br>
                                                    Shed<br>
                                                    Garage<br>
                                                    Inside home<br>
                                                    Work or Public Authority
                                                    bike<br>
                                                    parking

What was the bike secured with?                     It wasn’t locked<br>                   Ja              Nein
                                                    Cable lock<br>
                                                    U-lock / D-lock<br>
                                                    Chain lock<br>
                                                    Folding lock

What security rating did the primary lock have?     Don't know<br>                         Nein            Nein
                                                    None<br>
                                                    Sold Secure Bronze<br>
                                                    Sold Secure Silver<br>
                                                    Sold Secure Gold<br>
                                                    Sold Secure Diamond<br>
                                                    Other

How much did you spend on your locks?               Less than 20<br>                       Nein            Nein
                                                    20 - 40<br>
                                                    41 - 60<br>
                                                    61 - 100<br>
                                                    More than 100

What was the approximate value of the bike?         Less than 100<br>                      Nein            Nein
                                                    100 - 400<br>
                                                    401 - 700<br>
                                                    701 - 1000<br>
                                                    Over 1000

Did you have a record of the frame number of the    Yes<br>                                Nein            Nein
bike?                                               No

Did you report the stolen bike to the police?       Yes<br>                                Nein            Nein
                                                    No

Did you get the stolen bike back?                   Yes<br>                                Nein            Nein
                                                    No

How many times have components (wheels, seats,      Never<br>                              Nein            Ja
brakes etc) been stolen from your bike?             1<br>
                                                    2<br>
                                                    3<br>
                                                    4<br>
                                                    5<br>
                                                    6 times or more<br>

Which components have been stolen?                  Wheels<br>                             Ja              Nein
                                                    Seats<br>
                                                    Handlebars<br>
                                                    Headset<br>
                                                    Forks<br>
                                                    Brakes<br>
                                                    Gears<br>
                                                    Lights<br>
                                                    Others

What was the last stolen component attached /       Quick release clamp only<br>           Nein            Nein
secured with?                                       Quick release clamp plus
                                                    cable<br>
                                                    Hex bolt or Standard nut only<br>
                                                    Hex bolt or Standard nut plus
                                                    cable<br>
                                                    Security skewers / nuts (Pinhead,
                                                    Pitlock, Hexlox etc)<br>
                                                    Any other type of secondary bike
                                                    lock
------------------------------------------------------------------------------------------------------------------------

<!-- @formatter:on -->

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.

```{r}
library(rmarkdown)

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

library(readxl)
library(dplyr)

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.

```{r}
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?

```{r, fig.width=10}
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?

```{r, fig.width = 10, fig.height = 2}
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?

```{r, fig.width=10,fig.height=6.25}
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?

```{r, fig.width=10,fig.height=5}
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?

```{r, fig.width=10, fig.height = 3}
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?

```{r, fig.width = 10}
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?

```{r, fig.width = 10, fig.height = 8}
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.

```{r, fig.width = 10}
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?

```{r, fig.width = 10}
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?

```{r, fig.width = 11, results='asis'}
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.'
  )
```
```{r, fig.width = 10, fig.height = 2}
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?

```{r, fig.width = 11, results='asis'}
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.'
  )
```
```{r, fig.width = 10, fig.height = 2}
retrieve_to_report %>% improvement_plot(bike_retrieved, police_report)
```


> Werden Fälle mit Rahmennummer öfters polizeilich gemeldet?

```{r, fig.width = 11, results='asis'}
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.'
  )
```

```{r, fig.width = 10, fig.height = 2}
report_to_frame_number %>% improvement_plot(police_report, frame_number_record)
```