analyse-aussagen.Rmd

---
title: "DB Aufzüge - Analyse"
author: "BR Data"
date: "`r format(Sys.time(), '%d %B %Y')`"
output: html_document
---



```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F, echo=F, warning=F, message=F)
```

```{r load-data, eval = T}
require(DT)
require(lubridate)
require(tidyverse)
require(stringr)

theme_set(theme_bw())

load(file = "./output/dat-status-per-day-2-cleaned.RData")
load(file = "./output/facilities.RData")

dat.status.per.day <- dat.status.per.day %>% mutate(equipmentnumber = as.numeric(equipmentnumber)) %>% 
  gather("state", "n", ACTIVE:UNKNOWN)

# merge data and metadata 

dat.status.per.day <- dat.status.per.day %>% 
  left_join(facilities %>% select(-createdAt))

totaltime <- dat.status.per.day %>% summarise(n_distinct(createdAt)) %>% pull() # 365

# 24h = 24 * 60 / 5 = 288 units, 6:00-22:00 = 16h = 16 * 60 / 5 = 192 units
timeunits.per.day <- 192

summarise.by.group <- function(dd = dat.status.per.day %>% filter(!state == "NODATA"), gr, time = totaltime) {

  dd %>% 
    group_by_(.dots = gr) %>%
    mutate(n.elevators = n_distinct(equipmentnumber)) %>% 
    group_by_(.dots = c(gr, "state")) %>% 
    summarise(n.elevators = n.elevators[1],
              n = sum(n, na.rm = T)) %>% 
    group_by_(.dots = gr) %>% 
    mutate(perc = n / sum(n),
         label = scales::percent(perc)) %>%
    ungroup()
}

```

## These

Defekte Aufzüge an Haltestationen der Deutschen Bahn sind keine Einzelphänomene, sondern ein <strong>wiederkehrendes und flächendeckendes Problem für barrierefreies Reisen</strong>.

```{r general}
dd <- summarise.by.group(gr = NULL)
```

### Anhand der Daten kommen wir auf eine durchschnittliche Verfügbarkeit von höchstens <strong>`r (1 - filter(dd, state=="INACTIVE") %>% .$perc) %>% scales::percent()`</strong>

Dabei waren nur <strong>`r filter(dd, state=="ACTIVE") %>% .$label`</strong> der empfangenen Zustände <strong>ACTIVE</strong>. Weitere <strong>`r filter(dd, state=="UNKNOWN") %>% .$label`</strong> der empfangenen Zustände waren <strong>UNKNOWN</strong>. In der Summe ergibt das eine maximale Verfügbarkeit von <strong>`r (filter(dd, state=="ACTIVE") %>% .$perc + filter(dd, state=="UNKNOWN") %>% .$perc) %>% scales::percent()`</strong>.
<br>

<div class="infobox">
Insgesamt betrachten wir `r dat.status.per.day$equipmentnumber %>% unique() %>% length()` Aufzüge in der Analyse.

</div>

<div class="infobox">Wir berücksichtigen in der gesamten Analyse nur Daten der Tageszeit von 6:00 bis 22:00.  
Leere Messungen (<strong>NODATA</strong>) fließen nicht in die Berechnung ein.
</div>

```{r plot.general}
dd %>% 
  select(state, n , perc = label) %>% 
  mutate(perc = paste0("<strong>", perc, "</strong>")) %>% 
  datatable(rownames = F, options = list(dom = "t"), escape = F)
```

```{r}
dd <- summarise.by.group(gr = "equipmentnumber") %>% 
  select(-n.elevators) %>% 
  complete(equipmentnumber, state, fill = list(n = 0, perc = 0))

```

<div class="infobox">
<strong>1%</strong> Verfügbarkeit mehr oder weniger pro Jahr macht einen Unterschied von <strong>3.65 Tage</strong> verfügbar oder nicht.
<br>
<strong>1%</strong> Verfügbarkeit am Tag (6:00 - 22:00) sind <strong>9.6 Minuten</strong>.
</div>

Wertet man jeden Aufzug einzeln aus, ergibt sich <strong>bei der Hälfte der betrachteten Aufzüge</strong> eine <strong>maximale Verfügbarkeit von höchstens `r dd %>% filter(state == "INACTIVE") %>% mutate(perc = 1 - perc) %>% pull(perc) %>% median() %>% scales::percent(accuracy = 0.1)`</strong>. Konkret heißt das:

### Die Hälfte der Aufzüge (n = `r (dd %>% filter(state == "INACTIVE") %>% nrow() / 2 ) %>% floor()`) war im Zeitraum <strong>von `r totaltime` Tagen in der Summe jeweils mindestens `r (dd %>% filter(state == "INACTIVE") %>% pull(n) %>% median() / 192) %>% round(1)` Tage oder mehr</strong> inaktiv

wobei wir an dieser Stelle den Median der _INACTIVE_-Messungen betrachten. (Die Hälfte der Aufzüge hat insgesamt `r dd %>% filter(state == "INACTIVE") %>% pull(n) %>% median()` mal _INACTIV_ gesendet).


```{r}
min.inactive.per.year <- rbind(
  dd %>%
    filter(state == "INACTIVE") %>%
    count(t = n >= 7 * 16 * 12) %>% 
    mutate(perc = n / sum(n)) %>% 
    filter(t == T) %>% 
    mutate(t = ">= 1 Woche / Jahr"),
  dd %>%
    filter(state == "INACTIVE") %>%
    count(t = n >= 14 * 16 * 12) %>% 
    mutate(perc = n / sum(n)) %>% 
    filter(t == T) %>% 
    mutate(t = ">= 2 Wochen / Jahr"),
  dd %>%
    filter(state == "INACTIVE") %>%
    count(t = n >= 21 * 16 * 12) %>% 
    mutate(perc = n / sum(n)) %>% 
    filter(t == T) %>% 
    mutate(t = ">= 3 Wochen / Jahr"),
  dd %>%
    filter(state == "INACTIVE") %>%
    count(t = n >= 28 * 16 * 12) %>% 
    mutate(perc = n / sum(n)) %>% 
    filter(t == T) %>% 
    mutate(t = ">= 4 Wochen / Jahr")
) %>% mutate(perc = scales::percent(perc))

min.inactive.per.year %>% 
  datatable(rownames = F)

```

### `r min.inactive.per.year$n[4]` Aufzüge, also fast `r min.inactive.per.year$perc[4]` waren mindestens 4 Wochen im Jahr inaktiv (, wenn man jeweils ihre Inaktiv-Zeiten summiert)


```{r}
summarise.n.inactives.per.timeunit <-  function(dd = dat.status.per.day, timeunit = "%y-%m-%d") { 
  dd %>%
    group_by(createdAt = format(createdAt, timeunit)) %>% 
    mutate(n.all = n_distinct(equipmentnumber)) %>%
    filter(state == "INACTIVE", n > 0) %>% 
    summarise(n.inactive = n_distinct(equipmentnumber), n.all = n.all[1]) %>%
    ungroup() %>%
    summarise(timeunit,
              n = n.all[1], 
              min = min(n.inactive),
              median(n.inactive),
              mean = round(mean(n.inactive)),
              "mean_%" = scales::percent(mean(n.inactive) / n),
              max = max(n.inactive),
              "max_%" = scales::percent(max(n.inactive) / n),
              max.reached.at = as.character(createdAt[n.inactive == max(n.inactive)]))
}

n.inactives.per.timeunit <- rbind(
  summarise.n.inactives.per.timeunit(timeunit = "%Y-%m-%d"),
  summarise.n.inactives.per.timeunit(timeunit = "%Y-%W"),
  summarise.n.inactives.per.timeunit(timeunit = "%Y-%m")
)

```

### Von den betrachteten Aufzügen meldeten sich im Schnitt `r n.inactives.per.timeunit[1, 5]` unterschiedliche (also `r n.inactives.per.timeunit[1, 6]`) pro Tag mindestens ein mal inaktiv.

```{r}
n.inactives.per.timeunit %>% datatable(rownames = F, options = list(dom = "t"))
rm(n.inactives.per.timeunit)
```

### Aufzüge in der Einzelbetrachtung

```{r}
dd %>%
  group_by(equipmentnumber) %>% 
  mutate(`messdauer (tage)` = paste0(">", round(sum(n) / timeunits.per.day, 1))) %>% 
  filter(state == "INACTIVE") %>%
  arrange(perc) %>% 
  left_join(facilities) %>% 
  mutate(`maximal.verfuegbar (%)` = round((1 - perc) * 100, 1),
         INACTIVE = round(perc, 2),
         tage.INACTIVE = round(n / timeunits.per.day, 1)) %>%
  arrange(-perc) %>%
  rename(n.INACTIVE = n) %>%
  select(equipmentnumber,
         `maximal.verfuegbar (%)`,
         INACTIVE,
         n.INACTIVE,
         tage.INACTIVE,
         #`Techn. Platz (Bhf)`,
         bezeichnung.bhf,
         bezeichnung.aufzug,
         hersteller,
         baujahr,
         `S-Bahnnetz`,
         bundesland
         ) %>%
  datatable(rownames = F, options = list(dom = "ltip", pageLength = 10), filter = "top", escape = F)
```

## Weitere Infos

### Die Anzahl der meldenden Aufzüge war nicht konstant
Manche Aufzüge haben nicht von Anfang an gemeldet, manche haben im betrachteten Zeitraum aufgehört zu melden. Insgesamt haben wir Daten von <strong>`r dat.status.per.day %>% distinct(equipmentnumber) %>% nrow()`</strong> Aufzügen ausgewertet <strong>Das ist nicht die Anzahl der aktiven Aufzüge der DB</strong>.

### Die Hälfte der betrachteten Aufzüge sind / waren `r 2019 - facilities$baujahr %>% quantile(na.rm = T) %>% .["50%"] %>% round()` Jahre oder älter

```{r age}
count.older.than <- function(nn) {
  facilities %>% 
    count(older.than = Sys.Date() %>% year() - baujahr >= nn) %>% 
    mutate(perc = scales::percent(n / sum(n))) %>%
    filter(older.than == T)
}
```

`r count.older.than(10)["n"]` Aufzüge (`r count.older.than(10)["perc"]`) sind 10 Jahre oder älter.  
`r count.older.than(15)["n"]` Aufzüge (`r count.older.than(15)["perc"]`) sind 15 Jahre oder älter.  
`r count.older.than(20)["n"]` Aufzüge (`r count.older.than(20)["perc"]`) sind 20 Jahre oder älter.  

<div class="infobox">
### Über die Daten
Die Daten zu den Betriebszuständen der Aufzüge kommen per API vom Open-Data-Portal der Deutschen Bahn:  
- [Station Facilities Status API](https://data.deutschebahn.com/dataset/fasta-station-facilities-status)    
Zusätzliche Informationen von der Deutschen Bahn:  
- [Aufzugsdaten](https://data.deutschebahn.com/dataset/data-aufzug)  
- [Stationsdaten](https://data.deutschebahn.com/dataset/data-stationsdaten)  
Die Daten zu den Betriebszuständen haben wir alle fünf Minuten mit einem Node.js-Skript via Jenkins abgefragt und in einer (PostgreSQL) abgelegt
</div>