VHK/vhk.Rmd

---
title: "Vorhofkatheter-Statistik"
author: "Daniel Kraus"
date: '2018-12-29'
output:
  slidy_presentation: default
  ioslides_presentation: default
  beamer_presentation: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
library(tidyverse)
library(lubridate)

raw_data = read_csv('vhk.csv') %>% mutate(ImplYear = year(Date)) %>% mutate(ExplYear = year(RemovalDate))

first_year = min(raw_data$ImplYear)
last_year = max(raw_data$ImplYear)
max_y_break = ((max((raw_data %>% count(ImplYear))$n) %/% 10) + 1) * 10

reference_year = year(today()) - (today() < make_date(year(today()), 1, 31))

```

## Katheterimplantationen pro Jahr
```{r cath_by_year }
raw_data %>%
  count(ImplYear) %>%
  ggplot(aes(x = ImplYear, y = n)) +
  geom_col() +
  scale_y_continuous(breaks = seq(from = 0, to = max_y_break, by = 10)) +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  labs(x = NULL, y = "Anzahl Katheter")
```

## Katheterimplantationen pro Operateur im Jahr `r reference_year`
```{r}
raw_data %>% filter(Year == reference_year) %>%
  count(Surgeon) %>%
  arrange(n) %>%
  mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
  ggplot(aes(x = Surgeon, y = n)) +
  geom_col() +
  coord_flip() +
  labs(x = NULL, y = stringr::str_c("Anzahl Katheter im Jahr ", reference_year))
```



<!--
## Katheterimplantationen im Jahresverlauf
```{r cath_by_month}
raw_data %>% mutate(Month = month(Date)) %>%
  group_by(Year) %>%
  count(Month) %>%
  ggplot(aes(x = Month, y = n, group = Year, alpha = Year)) +
  geom_point() +
  geom_line()
  
```
-->

## Katheterexplantationen pro Jahr
```{r expl_by_year}
raw_data %>%
  # group_by(InsertionSite, Side) %>%
  count(ExplYear) %>%
  ggplot(aes(x = ExplYear, y = n)) +
  geom_col() +
  # facet_grid(rows = vars(InsertionSite), cols = vars(Side)) +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  labs(x = NULL, y = "Explantationen")
```

## Explantationen pro Implantation pro Jahr
```{r expl_by_cath_by_year}
raw_data %>%
  group_by(ImplYear) %>%
  summarise(ExplByImpl = sum(!is.na(ExplYear)) / n()) %>%
  ggplot(aes(x = ImplYear, y = ExplByImpl)) +
  geom_col() +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  labs(x = NULL, y = "Explantationen pro Implantation")
```

## Verweildauern der Katheter
```{r durations, message=FALSE}
raw_data %>% mutate(Duration = RemovalDate - Date) %>%
  group_by(ImplYear) %>%
  summarize(MedianDuration = median(Duration, na.rm = TRUE)) %>%
  ggplot(aes(x = ImplYear, y = MedianDuration)) +
  geom_col() +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  labs(x = NULL, y = "Mediane Katheter-Verweildauer [Tage]")
```

## Gründe der Katheterexplantation
### Variante A: Absolute Zahlen
```{r removal_reasons, message=FALSE}
raw_data %>% filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
  mutate(ImplYear = ImplYear %% 100) %>%
  group_by(ImplYear) %>%
  count(RemovalReason) %>%
  ggplot(aes(x = ImplYear, y = n)) +
  geom_point() + geom_line() +
  scale_x_continuous(breaks = scales::pretty_breaks()) +
  scale_y_continuous(breaks = scales::pretty_breaks()) +
  facet_wrap(vars(RemovalReason)) +
  labs(x = "Implantationsjahr", y = "Anzahl entfernter Katheter")
```

### Variante B: auf die Zahl der in dem Jahr gelegten Katheter bezogen
```{r removal_reasons_normalized, message=FALSE}
raw_data %>% 
  select(ImplYear, RemovalDate, RemovalReason) %>%
  mutate(ImplYear = ImplYear %% 100) %>%
  group_by(ImplYear) %>%
  add_count(ImplYear) %>%
  add_count(RemovalReason) %>%
  mutate(i = nn/n) %>%
  filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
  ggplot(aes(x = ImplYear, y = i)) +
  geom_point() + geom_line() +
  scale_x_continuous(breaks = scales::pretty_breaks()) +
  scale_y_continuous(breaks = scales::pretty_breaks()) +
  facet_wrap(vars(RemovalReason)) +
  labs(x = "Implantationsjahr", y = "Anzahl entfernter Katheter / gelegter Katheter")
```

## Wann treten Infektionen auf?
```{r infections, message=FALSE}
raw_data %>% filter(!is.na(RemovalDate), RemovalReason == "Infektion") %>%
  mutate(Duration = RemovalDate - Date, Week = as.integer(Duration) %/% 7 + 1) %>%
  filter(Week <= 56) %>%
  ggplot(aes(x = Week)) +
  geom_bar(width = 0.9) +
  # raw_data %>% filter(!is.na(RemovalDate), RemovalReason == "Infektion") %>%
  scale_x_continuous(breaks = seq(from = 0, to = 56, by = 4)) +
  scale_y_continuous(breaks = seq(from = 0, to = 10, by = 1)) +
  facet_grid(rows = vars(ImplYear)) +
  labs(x = "Woche nach Implantation", y = "Anzahl wg. Infektion entfernter Katheter",
       title = "Liegedauer infizierter Katheter nach Implantationsjahr",
       subtitle = "Die Graphik berücksichtigt nur Infektionen im ersten Jahr")
```


<!--
## Explantationsgründe je Implanteur
```{r removal_reasons_by_surgeon, message=FALSE}
raw_data %>% filter(!is.na(RemovalDate)) %>%
  mutate(ExplYear = year(RemovalDate)) %>%
  filter(ExplYear > year(today()) - 4) %>%
  group_by(ExplYear, Surgeon) %>%
  count(RemovalReason) %>%
  ggplot(aes(x = ExplYear, y = n)) +
  geom_point() + geom_line() +
  facet_grid(rows = vars(Surgeon), cols = vars(RemovalReason)) +
  labs(x = NULL, y = "Anzahl expl. Katheter")
```
-->


## Alter der Patienten bei Implantation
```{r patient_age}
raw_data %>%
  ggplot(aes(group = ImplYear, x = ImplYear, y = Age)) +
  geom_boxplot() +
  coord_cartesian(ylim = c(20, 100)) +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  scale_y_continuous(breaks = seq(from = 20, to = 100, by = 10))  +
  labs(x = NULL, y = "Jahre")
```

## Geschlecht der Patienten bei Implantation
```{r patient_sex}
raw_data %>% group_by(ImplYear) %>%
  summarise(PercentFemale = sum(Sex == "weiblich") / n()) %>%
  ggplot(aes(x = ImplYear, y = PercentFemale)) +
  geom_col() +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  coord_cartesian(ylim = c(0, 1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(x = NULL, y = "Anteil Frauen")
```

## Katheterlokalisation
Ist da ein Trend hin zu immer mehr Kathetern von links?!

```{r insertion_site}
raw_data %>% mutate(Side = factor(Side, levels = c("rechts", "links"))) %>%
  ggplot(aes(x = ImplYear)) +
  facet_grid(InsertionSite ~ Side) +
  geom_bar() +
  labs(x = NULL, y = "Anzahl Katheter")
```

## Anteil der Arztrollen
Um 2014 herum haben einige die Facharztprüfung abgelegt, ist das der Grund für die Auffälligkeit 2015/2016?

```{r percent_residents}
raw_data %>% group_by(ImplYear) %>% 
  summarize(Assistenzarzt = sum(SurgeonRole == "Assistenzarzt") / n(),
            Facharzt = sum(SurgeonRole == "Facharzt") / n(),
            Oberarzt = sum(SurgeonRole == "Oberarzt") / n()) %>%
  gather(key = Role, value = Percent, Assistenzarzt, Facharzt, Oberarzt) %>%
  ggplot(aes(x = ImplYear, y = Percent)) +
  scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  facet_grid(Role ~ .) +
  geom_col() +
  labs(x = NULL, y = "Anteil in den gelegten Kathetern")
```

## Hitparade der Durchleuchtungsdauern
```{r greatest_fluoroscopy}
raw_data %>%
  group_by(Surgeon) %>%
  summarize(FluoroscopyIndex = median(InsertionFluoroscopyDuration, na.rm = TRUE)) %>%
  arrange(desc(FluoroscopyIndex)) %>%
  top_n(-10, FluoroscopyIndex) %>%
  mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
  ggplot(aes(x = Surgeon, y = FluoroscopyIndex)) +
  geom_col() +
  coord_flip() +
  labs(x = NULL, y = "Median der Durchleuchtungsdauer [s]")
```

## Individuelle Durchleuchtungsdauern
Nur Operateure der letzten 4 Jahre

```{r individual_fluoroscopy, message=FALSE}
to_year = year(today()) %% 100
from_year = to_year - 3
raw_data %>%
  mutate(ImplYear = ImplYear %% 100) %>%
  filter(ImplYear >= from_year, !is.na(InsertionFluoroscopyDuration)) %>%
  group_by(Surgeon, ImplYear) %>%
  summarize(FluoroscopyIndex = median(InsertionFluoroscopyDuration, na.rm = TRUE)) %>%
  ungroup() %>%
  # mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
  ggplot(aes(x = ImplYear, y = FluoroscopyIndex)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(from = from_year, to = to_year, by = 1 )) +
  facet_wrap(vars(Surgeon)) +
  labs(x = NULL, y = "Median der Durchleuchtungsdauer [s]")
```

## Hitparade der Implanteure
```{r greatest_surgeons}
raw_data %>% count(Surgeon) %>% arrange(n) %>% top_n(10, n) %>% mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
  ggplot(aes(x = Surgeon, y = n)) +
  geom_col() +
  coord_flip() +
  labs(x = NULL, y = "Gesamtzahl Katheter")
```

## Hitparade der Assistenten
Einsame Spitze... Romana Ziegler!

```{r greatest_assistants}
raw_data %>% count(Assistant) %>% arrange(n) %>% top_n(10, n) %>% mutate(Assistant = factor(Assistant, levels = Assistant)) %>%
  ggplot(aes(x = Assistant, y = n)) +
  geom_col() +
  coord_flip() +
  labs(x = NULL, y = "Gesamtzahl Katheter")
```

## Ende
Das R-Skript, mit dem diese Präsentation erstellt wurde, befindet sich hier:

<https://git.bovender.de/daniel/VHK>