--- 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)) ``` ## 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") ``` ## 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: