Kapitel 4. Fallstudie: Verletzungen in der Notaufnahme
Diese Arbeit wurde mithilfe von KI übersetzt. Wir freuen uns über dein Feedback und deine Kommentare: translation-feedback@oreilly.com
Einführung
In den letzten drei Kapiteln habe ich dir eine Reihe neuer Konzepte vorgestellt. Damit du sie besser verinnerlichen kannst, gehen wir jetzt durch eine umfangreichere Shiny-App, die einen lustigen Datensatz erforscht und viele der Ideen, die du bisher kennengelernt hast, zusammenführt. Wir beginnen mit einer kleinen Datenanalyse außerhalb von Shiny und setzen sie dann in eine App um. Wir fangen einfach an und gehen dann nach und nach ins Detail.
In diesem Kapitel ergänzen wir Shiny mit vroom (zum schnellen Lesen von Dateien) und tidyverse (für die allgemeine Datenanalyse):
library(shiny)library(vroom)library(tidyverse)
Die Daten
Unter werden wir Daten aus dem National Electronic Injury Surveillance System (NEISS) untersuchen, die von der Consumer Product Safety Commission erhoben werden. Dabei handelt es sich um eine Langzeitstudie, die alle Unfälle in einer repräsentativen Stichprobe von Krankenhäusern in den Vereinigten Staaten erfasst. Es ist ein interessanter Datensatz, weil jeder mit dem Bereich bereits vertraut ist und jede Beobachtung von einer kurzen Erzählung begleitet wird, die erklärt, wie der Unfall passiert ist. Du kannst mehr über diesen Datensatz auf GitHub erfahren.
In diesem Kapitel konzentriere ich mich nur auf die Daten von 2017. Dadurch bleiben die Daten klein genug (~10 MB), um sie einfach in Git zu speichern (zusammen mit dem Rest des Buches). Das bedeutet, dass wir nicht über ausgeklügelte Strategien für den schnellen Import der Daten nachdenken müssen (wir werden später im Buch darauf zurückkommen). Du kannst den Code, mit dem ich den Auszug für dieses Kapitel erstellt habe , auf GitHub sehen.
Wenn du die Daten auf deinen eigenen Computer übertragen willst, führe diesen Code aus:
dir.create("neiss")#> Warning in dir.create("neiss"): 'neiss' already existsdownload<-function(name){url<-"https://github.com/hadley/mastering-shiny/raw/master/neiss/"download.file(paste0(url,name),paste0("neiss/",name),quiet=TRUE)}download("injuries.tsv.gz")download("population.tsv")download("products.tsv")
Der Hauptdatensatz, den wir verwenden werden, ist injuries, der rund 250.000 Beobachtungen enthält:
injuries<-vroom::vroom("neiss/injuries.tsv.gz")injuries#> # A tibble: 255,064 x 10#> trmt_date age sex race body_part diag location prod_code weight#> <date> <dbl> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>#> 1 2017-01-01 71 male white Upper Tru… Contusion… Other Publ… 1807 77.7#> 2 2017-01-01 16 male white Lower Arm Burns, Th… Home 676 77.7#> 3 2017-01-01 58 male white Upper Tru… Contusion… Home 649 77.7#> 4 2017-01-01 21 male white Lower Tru… Strain, S… Home 4076 77.7#> 5 2017-01-01 54 male white Head Inter Org… Other Publ… 1807 77.7#> 6 2017-01-01 21 male white Hand Fracture Home 1884 77.7#> # … with 255,058 more rows, and 1 more variable: narrative <chr>
Jede Zeile steht für einen einzelnen Unfall mit 10 Variablen:
trmt_date-
Das Datum, an dem die Person im Krankenhaus gesehen wurde (nicht das Datum, an dem sich der Unfall ereignet hat).
age,sex, undrace-
Demografische Informationen über die Person, die den Unfall hatte.
body_part-
Der Ort der Verletzung am Körper (z. B. Knöchel oder Ohr);
locationist der Ort, an dem sich der Unfall ereignet hat (z. B. zu Hause oder in der Schule). diag-
Die grundlegende Diagnose der Verletzung (z. B. Fraktur oder Riss).
prod_code-
Das Hauptprodukt, das mit der Verletzung in Verbindung gebracht wird.
weight-
Das statistische Gewicht gibt die geschätzte Anzahl der Menschen an, die diese Verletzung erleiden würden, wenn dieser Datensatz auf die gesamte Bevölkerung der USA skaliert würde.
narrative-
Eine kurze Geschichte darüber, wie der Unfall passiert ist.
Wir kombinieren sie mit zwei anderen Datenrahmen, um zusätzlichen Kontext zu erhalten: products ermöglicht es uns, den Produktnamen anhand des Produktcodes zu ermitteln, und population zeigt uns die Gesamtbevölkerung der USA im Jahr 2017 für jede Kombination von Alter und Geschlecht:
products<-vroom::vroom("neiss/products.tsv")products#> # A tibble: 38 x 2#> prod_code title#> <dbl> <chr>#> 1 464 knives, not elsewhere classified#> 2 474 tableware and accessories#> 3 604 desks, chests, bureaus or buffets#> 4 611 bathtubs or showers#> 5 649 toilets#> 6 676 rugs or carpets, not specified#> # … with 32 more rowspopulation<-vroom::vroom("neiss/population.tsv")population#> # A tibble: 170 x 3#> age sex population#> <dbl> <chr> <dbl>#> 1 0 female 1924145#> 2 0 male 2015150#> 3 1 female 1943534#> 4 1 male 2031718#> 5 2 female 1965150#> 6 2 male 2056625#> # … with 164 more rows
Erkundung
Bevor wir die App erstellen, wollen wir die Daten ein wenig untersuchen. Zuerst schauen wir uns ein Produkt mit einer interessanten Geschichte an: 649, "Toiletten". Zuerst suchen wir die Verletzungen heraus, die mit diesem Produkt verbunden sind:
selected<-injuries%>%filter(prod_code==649)nrow(selected)#> [1] 2993
Als Nächstes führen wir einige grundlegende Zusammenfassungen durch, die sich mit dem Ort, dem Körperteil und der Diagnose von Verletzungen durch Toilettengänge befassen. Beachte, dass ich mit der Variable weight gewichtet habe, damit die Zahlen als geschätzte Gesamtzahl der Verletzungen in den gesamten USA interpretiert werden können:
selected%>%count(location,wt=weight,sort=TRUE)#> # A tibble: 6 x 2#> location n#> <chr> <dbl>#> 1 Home 99603.#> 2 Other Public Property 18663.#> 3 Unknown 16267.#> 4 School 659.#> 5 Street Or Highway 16.2#> 6 Sports Or Recreation Place 14.8selected%>%count(body_part,wt=weight,sort=TRUE)#> # A tibble: 24 x 2#> body_part n#> <chr> <dbl>#> 1 Head 31370.#> 2 Lower Trunk 26855.#> 3 Face 13016.#> 4 Upper Trunk 12508.#> 5 Knee 6968.#> 6 N.S./Unk 6741.#> # … with 18 more rowsselected%>%count(diag,wt=weight,sort=TRUE)#> # A tibble: 20 x 2#> diag n#> <chr> <dbl>#> 1 Other Or Not Stated 32897.#> 2 Contusion Or Abrasion 22493.#> 3 Inter Organ Injury 21525.#> 4 Fracture 21497.#> 5 Laceration 18734.#> 6 Strain, Sprain 7609.#> # … with 14 more rows
Wie zu erwarten, ereignen sich die meisten Verletzungen im Zusammenhang mit der Toilette zu Hause. Die am häufigsten betroffenen Körperteile lassen vermuten, dass es sich um Stürze handelt (da Kopf und Gesicht bei der routinemäßigen Toilettenbenutzung normalerweise nicht betroffen sind), und die Diagnosen scheinen recht unterschiedlich zu sein.
Wir können auch das Muster nach Alter und Geschlecht untersuchen. Wir haben hier so viele Daten, dass eine Tabelle nicht sehr nützlich ist. Deshalb mache ich eine Grafik, wie in Abbildung 4-1 zu sehen, die die Muster deutlicher macht:
summary<-selected%>%count(age,sex,wt=weight)summary#> # A tibble: 208 x 3#> age sex n#> <dbl> <chr> <dbl>#> 1 0 female 4.76#> 2 0 male 14.3#> 3 1 female 253.#> 4 1 male 231.#> 5 2 female 438.#> 6 2 male 632.#> # … with 202 more rowssummary%>%ggplot(aes(age,n,colour=sex))+geom_line()+labs(y="Estimated number of injuries")
Abbildung 4-1. Geschätzte Anzahl der durch Toiletten verursachten Verletzungen, aufgeschlüsselt nach Alter und Geschlecht.
Wir sehen einen Spitzenwert bei Jungen, der im Alter von 3 Jahren seinen Höhepunkt erreicht, dann einen Anstieg (vor allem bei Frauen) ab dem mittleren Alter und einen allmählichen Rückgang nach 80 Jahren. Ich vermute, dass der Spitzenwert darauf zurückzuführen ist, dass Jungen die Toilette in der Regel im Stehen benutzen, und dass der Anstieg bei Frauen auf Osteoporose zurückzuführen ist (d.h. ich vermute, dass sich Frauen und Männer gleich häufig verletzen, aber mehr Frauen in der Notaufnahme landen, weil sie ein höheres Risiko für Knochenbrüche haben).
Ein Problem bei der Interpretation dieses Musters ist, dass wir wissen, dass es weniger ältere als jüngere Menschen gibt, sodass die Bevölkerung, die verletzt werden kann, kleiner ist. Wir können dies berücksichtigen, indem wir die Anzahl der verletzten Personen mit der Gesamtbevölkerung vergleichen und eine Verletzungsrate berechnen. Hier verwende ich eine Rate pro 10.000:
summary<-selected%>%count(age,sex,wt=weight)%>%left_join(population,by=c("age","sex"))%>%mutate(rate=n/population*1e4)summary#> # A tibble: 208 x 5#> age sex n population rate#> <dbl> <chr> <dbl> <dbl> <dbl>#> 1 0 female 4.76 1924145 0.0247#> 2 0 male 14.3 2015150 0.0708#> 3 1 female 253. 1943534 1.30#> 4 1 male 231. 2031718 1.14#> 5 2 female 438. 1965150 2.23#> 6 2 male 632. 2056625 3.07#> # … with 202 more rows
Wenn man die Rate wie in Abbildung 4-2 darstellt, zeigt sich ein auffallend anderer Trend nach dem Alter von 50 Jahren: Der Unterschied zwischen Männern und Frauen ist viel geringer, und wir sehen keinen Rückgang mehr. Das liegt daran, dass Frauen in der Regel länger leben als Männer, so dass es in höherem Alter einfach mehr Frauen gibt, die durch Toiletten verletzt werden können:
summary%>%ggplot(aes(age,rate,colour=sex))+geom_line(na.rm=TRUE)+labs(y="Injuries per 10,000 people")
Abbildung 4-2. Geschätzte Verletzungsrate pro 10.000 Menschen, aufgeschlüsselt nach Alter und Geschlecht.
(Beachte, dass die Raten nur bis zum Alter von 80 Jahren gehen, weil ich keine Bevölkerungsdaten für die über 80-Jährigen finden konnte).
Schließlich können wir uns einige der Erzählungen ansehen. Das Durchblättern ist eine informelle Methode, um unsere Hypothesen zu überprüfen und neue Ideen für weitere Untersuchungen zu entwickeln. Hier ziehe ich eine Stichprobe von 10:
selected%>%sample_n(10)%>%pull(narrative)#> [1] "68YOF STRAINED KNEE MOVING FROM TOILET TO POWER CHAIR AT HOME. DX:...#> [2] "97YOM LWR BACK PAIN - MISSED TOILET SEAT, FELL FLOOR AT NH"#> [3] "54 YOF DX ALCOHOL INTOXICATION - PT STATES SHE FELL OFF TOILET."#> [4] "85YOF-STAFF AT NH STATES PT WAS TRANSITIONIN TO TOILET FROM WHEELCH...#> [5] "FOREHEAD LACERATION. 64 YOM FELL AND HIT HIS HEAD ON TOILET."#> [6] "70YOM-STAFF STATES PT FELL OFF TOILET ONTO CONCRETE FLOOR AT *** AR...#> [7] "40YOF WAS INTOXICATED AND FELL OFF THE TOILET STRUCK HEAD ON THE WA...#> [8] "66 Y/O F FELL FROM COMMODE ONTO FLOOR AND FRACTURED CLAVICLE"#> [9] "25YOF SYNCOPAL EPS W ON TOILET FELL HIT RS OF HEAD REPORTLY LOC UNK...#> [10] "4 YO M W/LAC TO FOREHEAD SLIPPED IN BATHROOM HIT ON TOILET FLUSH HA...
Nachdem wir diese Erkundung für ein Produkt durchgeführt haben, wäre es sehr schön, wenn wir das auch für andere Produkte tun könnten, ohne den Code neu eingeben zu müssen. Also lasst uns eine Shiny App erstellen!
Prototyp
Wenn du eine komplexe App erstellst, empfehle ich dir, so einfach wie möglich anzufangen, damit du dir sicher sein kannst, dass die grundlegenden Mechanismen funktionieren, bevor du mit etwas Komplizierterem beginnst. Hier beginne ich mit einer Eingabe (dem Produktcode), drei Tabellen und einer Darstellung.
Bei der Entwicklung eines ersten Prototyps besteht die Herausforderung darin, ihn "so einfach wie möglich" zu gestalten. Es besteht ein Spannungsfeld zwischen der schnellen Umsetzung der Grundlagen und der Planung für die Zukunft der App. Beide Extreme können schlecht sein: Wenn du zu engstirnig entwirfst, verbringst du später viel Zeit mit der Überarbeitung deiner App; wenn du zu rigoros entwirfst, verbringst du viel Zeit damit, Code zu schreiben, der später auf dem Boden des Schneideraums landet. Um das richtige Gleichgewicht zu finden, mache ich oft ein paar Skizzen mit Bleistift und Papier, um die Benutzeroberfläche und den reaktiven Graphen zu erkunden, bevor ich mich an den Code mache.
Hier habe ich mich für 1 Zeile für die Eingaben entschieden (wobei ich davon ausgehe, dass ich wahrscheinlich noch mehr Eingaben hinzufügen werde, bevor diese App fertig ist), 1 Zeile für alle drei Tabellen (so dass jede Tabelle 4 Spalten hat, 1/3 der 12-Spalten-Breite) und dann 1 Zeile für die Darstellung:
prod_codes<-setNames(products$prod_code,products$title)ui<-fluidPage(fluidRow(column(6,selectInput("code","Product",choices=prod_codes))),fluidRow(column(4,tableOutput("diag")),column(4,tableOutput("body_part")),column(4,tableOutput("location"))),fluidRow(column(12,plotOutput("age_sex"))))
Wir haben noch nicht über fluidRow() und column() gesprochen, aber du solltest aus dem Kontext heraus erraten können, was sie tun, und wir werden in "Multirow" darauf zurückkommen . Beachte auch die Verwendung von setNames() in selectInput() choices : Dies zeigt den Produktnamen in der Benutzeroberfläche an und gibt den Produktcode an den Server zurück.
Die Serverfunktion ist relativ einfach. Zunächst wandle ich die statischen Variablen selected und summary in reaktive Ausdrücke um. Das ist ein vernünftiges allgemeines Muster: Du erstellst Variablen in deiner Datenanalyse, um die Analyse in Schritte zu zerlegen und um zu vermeiden, dass Dinge mehrfach neu berechnet werden.
Oft ist es eine gute Idee, ein wenig Zeit damit zu verbringen, deinen Analysecode zu säubern, bevor du mit deiner Shiny-App beginnst, damit du über diese Probleme im normalen R-Code nachdenken kannst, bevor du die zusätzliche Komplexität der Reaktivität hinzufügst:
server<-function(input,output,session){selected<-reactive(injuries%>%filter(prod_code==input$code))output$diag<-renderTable(selected()%>%count(diag,wt=weight,sort=TRUE))output$body_part<-renderTable(selected()%>%count(body_part,wt=weight,sort=TRUE))output$location<-renderTable(selected()%>%count(location,wt=weight,sort=TRUE))summary<-reactive({selected()%>%count(age,sex,wt=weight)%>%left_join(population,by=c("age","sex"))%>%mutate(rate=n/population*1e4)})output$age_sex<-renderPlot({summary()%>%ggplot(aes(age,n,colour=sex))+geom_line()+labs(y="Estimated number of injuries")},res=96)}
Beachte, dass die Erstellung der summary reactive hier nicht unbedingt notwendig ist, da sie nur von einem einzigen reaktiven Verbraucher verwendet wird. Es ist jedoch eine gute Praxis, die Berechnung und das Plotten voneinander zu trennen, da dies den Ablauf der App verständlicher macht und die Verallgemeinerung in Zukunft erleichtert.
Ein Screenshot der entstandenen App ist in Abbildung 4-3 zu sehen. Du kannst den Quellcode auf GitHub einsehen.
Abbildung 4-3. Erster Prototyp der NEISS Exploration App. Live zu sehen unter https://hadley.shinyapps.io/ms-prototype.
Polnische Tische
Nachdem wir nun die grundlegenden Komponenten eingerichtet haben und sie funktionieren, können wir unsere App schrittweise verbessern. Das erste Problem bei dieser App ist, dass sie eine Menge Informationen in den Tabellen anzeigt, wo wir wahrscheinlich nur die Highlights haben wollen. Um das zu beheben, müssen wir zuerst herausfinden, wie wir die Tabellen kürzen können. Ich habe mich dafür entschieden, eine Kombination aus Forcats-Funktionen zu verwenden: Ich wandle die Variable in einen Faktor um, ordne sie nach der Häufigkeit der Stufen und fasse dann alle Stufen nach den ersten fünf in einer Tabelle zusammen:
injuries%>%mutate(diag=fct_lump(fct_infreq(diag),n=5))%>%group_by(diag)%>%summarise(n=as.integer(sum(weight)))#> # A tibble: 6 x 2#> diag n#> * <fct> <int>#> 1 Other Or Not Stated 1806436#> 2 Fracture 1558961#> 3 Laceration 1432407#> 4 Strain, Sprain 1432556#> 5 Contusion Or Abrasion 1451987#> 6 Other 1929147
Weil ich wusste, wie es geht, habe ich eine kleine Funktion geschrieben, die das für jede Variable automatisiert. Die Details sind hier nicht wirklich wichtig, aber wir werden in Kapitel 12 darauf zurückkommen. Du kannst das Problem auch mit Kopieren und Einfügen lösen, also mach dir keine Sorgen, wenn der Code total fremd aussieht:
count_top<-function(df,var,n=5){df%>%mutate({{var}}:=fct_lump(fct_infreq({{var}}),n=n))%>%group_by({{var}})%>%summarise(n=as.integer(sum(weight)))}
Diese verwende ich dann in der Serverfunktion:
output$diag<-renderTable(count_top(selected(),diag),width="100%")output$body_part<-renderTable(count_top(selected(),body_part),width="100%")output$location<-renderTable(count_top(selected(),location),width="100%")
Ich habe eine weitere Änderung vorgenommen, um die Ästhetik der App zu verbessern: Ich habe alle Tabellen gezwungen, die maximale Breite einzunehmen (d. h. die Spalte zu füllen, in der sie erscheinen). Das macht die Ausgabe ästhetisch ansprechender, da es weniger zufälligeAbweichungen gibt.
Ein Screenshot der entstandenen App ist in Abbildung 4-4 zu sehen. Du kannst den Quellcode auf GitHub einsehen.
Abbildung 4-4. Die zweite Iteration der App verbessert die Anzeige, indem sie nur die häufigsten Zeilen in den Übersichtstabellen anzeigt. Siehe live unter https://hadley.shinyapps.io/ms-polish-tables.
Rate versus Anzahl
Bisher zeigen wir nur ein einziges Diagramm an, aber wir möchten dem Benutzer die Wahl lassen, ob er die Anzahl der Verletzungen oder die bevölkerungsstandardisierte Rate sehen möchte. Zuerst füge ich ein Steuerelement in die Benutzeroberfläche ein. Hier habe ich mich für selectInput() entschieden, weil es beide Zustände deutlich macht und es einfach wäre, in Zukunft neue Zustände hinzuzufügen:
fluidRow(column(8,selectInput("code","Product",choices=setNames(products$prod_code,products$title),width="100%")),column(2,selectInput("y","Y axis",c("rate","count")))),
(Ich wähle rate, weil ich das für sicherer halte; du musst die Bevölkerungsverteilung nicht verstehen, um die Grafik richtig zu interpretieren).
Dann konditioniere ich diese Eingabe bei der Erstellung des Plots:
output$age_sex<-renderPlot({if(input$y=="count"){summary()%>%ggplot(aes(age,n,colour=sex))+geom_line()+labs(y="Estimated number of injuries")}else{summary()%>%ggplot(aes(age,rate,colour=sex))+geom_line(na.rm=TRUE)+labs(y="Injuries per 10,000 people")}},res=96)
Ein Screenshot der entstandenen App ist in Abbildung 4-5 zu sehen. Du kannst den Quellcode auf GitHub einsehen.
Abbildung 4-5. In dieser Iteration geben wir dem Benutzer die Möglichkeit, zwischen der Anzeige der Zählung und der standardisierten Bevölkerungsrate auf der y-Achse zu wechseln. Siehe live unter https://hadley.shinyapps.io/ms-rate-vs-count.
Erzählung
Schließlich möchte ich eine Möglichkeit bieten, auf die Erzählungen zuzugreifen, weil sie so interessant sind und eine informelle Möglichkeit bieten, die Hypothesen zu überprüfen, die du beim Betrachten der Diagramme aufstellst. Im R-Code nehme ich mehrere Erzählungen auf einmal, aber es gibt keinen Grund, das in einer App zu tun, in der du interaktiv forschen kannst.
Die Lösung besteht aus zwei Teilen. Zuerst fügen wir eine neue Zeile am unteren Rand der Benutzeroberfläche hinzu. Ich verwende eine Aktionsschaltfläche, um eine neue Geschichte auszulösen, und füge die Erzählung in eine textOutput() ein:
fluidRow(column(2,actionButton("story","Tell me a story")),column(10,textOutput("narrative")))
Ein Screenshot der entstandenen App ist in Abbildung 4-6 zu sehen. Du kannst den Quellcode auf GitHub einsehen.
Abbildung 4-6. Die letzte Iteration fügt die Möglichkeit hinzu, eine zufällige Erzählung aus den ausgewählten Zeilen herauszuziehen. Siehe live unter https://hadley.shinyapps.io/ms-narrative.
Dann verwende ich eventReactive(), um eine reaktive Funktion zu erstellen, die nur aktualisiert wird, wenn die Schaltfläche angeklickt wird oder sich die zugrunde liegenden Daten ändern:
narrative_sample<-eventReactive(list(input$story,selected()),selected()%>%pull(narrative)%>%sample(1))output$narrative<-renderText(narrative_sample())
Übungen
-
Was passiert, wenn du
fct_infreq()undfct_lump()in dem Code umdrehst, der die Übersichtstabellen reduziert? -
Füge ein Eingabefeld hinzu, mit dem du entscheiden kannst, wie viele Zeilen in den Übersichtstabellen angezeigt werden sollen.
-
Biete eine Möglichkeit, systematisch durch jede Erzählung zu gehen, mit Vorwärts- und Rückwärts-Buttons.
Fortgeschrittene: Mach die Liste der Erzählungen "kreisförmig", so dass du von der letzten Erzählung zur ersten kommst.
Zusammenfassung
Jetzt, wo du die Grundlagen von Shiny Apps kennst, bieten dir die folgenden sieben Kapitel eine Wundertüte mit wichtigen Techniken. Wenn du das nächste Kapitel über Arbeitsabläufe gelesen hast, empfehle ich dir, die restlichen Kapitel zu überfliegen, damit du einen guten Überblick über die Inhalte bekommst und dann wieder eintauchen kannst, wenn du die Techniken für eine App brauchst.
Get Glänzend meistern now with the O’Reilly learning platform.
O’Reilly members experience books, live events, courses curated by job role, and more from O’Reilly and nearly 200 top publishers.
