Illustration der Temperaturen in München
Das Diagramm nach der Vorlage von Grafikguru Edward Tufte transportiert eine ganze Menge Informationen. Es zeigt am Beispiel von München für jeden Tag eines Jahres die mittlere Tagestemperatur, das Intervall, in dem 95 Prozent der Temperaturen liegen, und die höchsten und tiefsten mittleren Tagestemperaturen seit 1995, die Mittelwerte und die durchschnittlichen Monatstemperaturen. Das Diagramm lässt sich leicht für jede beliebige Stadt anpassen.
Dieser Blog-Beitrag basiert zu großen Teilen auf der Arbeit anderer. Edward Tufte hat die Illustration am 4. Januar 2004 in der New York Times veröffenlicht, nachzulesen unter http://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=00014g. Brad Boehmke hat 2015 ein R-Skript erstellt, um das Wetter in Dayton, Ohio, zu visualisieren, siehe https://rpubs.com/bradleyboehmke/weather_graphic. Die Daten kommen vom University of Dayton Average Daily Temperature Archive mit Temperaturdaten zu 326 Städten weltweit – zu finden unter http://academic.udayton.edu/kissock/http/Weather/.
So sieht das Endergebnis aus:
Packages laden und Daten einlesen
Nachfolgend wird die Grafik Schritt für Schritt konstruiert. Es werden nur drei Packages benötigt. dplyr und tidyr, um die Daten bequem verarbeiten zu können, und ggplot2 um die Grafik zu erstellen. Achtung: Das Skript funktioniert mit dplyr 0.5.0 und neuer nicht ohne Anpassungen. Das Beispiel verwendet dplyr 0.4.1.
library(dplyr) library(tidyr) library(ggplot2)
Als Nächstes wird mit read.table() die Datenquelle eingelesen, in diesem Fall die Daten für München, und in der Variablen „DAY“ vom Typ „tbl_df“ abgelegt. Die folgenden Zeilen benennen die Spalten, wandeln Fahrenheit in Celsius um und entfernen die 29. Februare.
heuer <- 2016
"http://academic.udayton.edu/kissock/http/Weather/gsod95-current/DLMUNICH.txt" %>%
read.table() %>% data.frame %>% tbl_df -> DAY
names(DAY) <- c("Month", "Day", "Year", "Temp")
DAY$Temp <- (DAY$Temp - 32) * 5 / 9
DAY <- DAY %>% filter(Month != 2 | Day != 29)
Daten bearbeiten
Die übrigen Berechnungen einzeln zu erklären, würde den Rahmen sprengen. Sie sind aber gut kommentiert. Die Kommentare basieren weitgehend auf den Kommentaren aus dem Skript von Brad Boehmke.
# create dataframe that represents historical data
Past <- DAY %>%
group_by(Year, Month) %>%
arrange(Day) %>%
ungroup() %>%
group_by(Year) %>%
mutate(newDay = seq(1, length(Day))) %>% # label days as 1:365 (will represent x-axis)
ungroup() %>%
filter(Temp > -70 & Year < heuer) %>% # filter out missing data
group_by(newDay) %>%
mutate(upper = max(Temp), # identify max value for each day
lower = min(Temp), # identify min value for each day
avg = mean(Temp), # calculate mean value for each day
se = sd(Temp)/sqrt(length(Temp))) %>% # calculate standard error of mean
mutate(avg_upper = avg+(2.101*se), # calculate 95% CI for mean
avg_lower = avg-(2.101*se)) %>% # calculate 95% CI for mean
ungroup()
# create dataframe that represents current year data
Present <- DAY %>%
group_by(Year, Month) %>%
arrange(Day) %>%
ungroup() %>%
group_by(Year) %>%
mutate(newDay = seq(1, length(Day))) %>% # create matching x-axis as historical data
ungroup() %>%
filter(Temp > -70 & Year == heuer) # filter out missing data & select current year data
# create dataframe that represents the lowest temp for each day for the historical data
PastLows <- Past %>%
group_by(newDay) %>%
summarise(Pastlow = min(Temp)) # identify lowest temp for each day
# create dataframe that identifies the days in 2014 in which the temps were lower than all previous years
PresentLows <- Present %>%
left_join(PastLows) %>% # merge historical lows to current year low data
mutate(record = ifelse(Temp<Pastlow, "Y", "N")) %>% # identifies if current year was record low
filter(record == "Y") # filter for days that represent current year record lows
# create dataframe that represents the highest temp for each day for the historical data
PastHighs <- Past %>%
group_by(newDay) %>%
summarise(Pasthigh = max(Temp)) # identify highest temp for each day from 1995
# create dataframe that identifies the days in which the temps were higher than all previous years
PresentHighs <- Present %>%
left_join(PastHighs) %>% # merge historical highs to current year low data
mutate(record = ifelse(Temp>Pasthigh, "Y", "N")) %>% # identifies if current year was record high
filter(record == "Y") # filter for days that represent current year record highs
# create dataframe that represents mean temperature for each month
PastMeans <- Past %>%
group_by(newDay) %>%
summarise(Pastmean = mean(Temp)) # identify lowest temp for each day from 1995
# function to turn y-axis labels into degree formatted values
dgr_fmt <- function(x, ...) {
parse(text = paste(x, "*degree", sep = ""))
}
# create y-axis variable
a <- dgr_fmt(seq(-20,40, by = 5))
# some calculations
blue_dots <- nrow(PresentLows)
red_dots <- nrow(PresentHighs)
dtemp <- round(mean(Present$Temp), digits = 2)
DAY <- DAY %>% filter(Temp > -70)
gruppe <- group_by(DAY, Month)
s <- summarize(gruppe, Temp = mean(Temp))
s$rTemp <- round(s$Temp, digits = 2)
gruppe <- group_by(DAY, Year)
y <- summarize(gruppe, Temp = mean(Temp))
gruppe <- group_by(Present, Month)
t <- summarize(gruppe, Temp = mean(Temp))
t$rTemp <- round(t$Temp, digits = 2)
v <- merge(s, t, by = "rTemp", all = TRUE)
v <- v[order(v$Month.y),]
rownames(v) <- NULL
v$Temp.y <- round(v$Temp.y, digits = 2)
Grafik erstellen Teil 1
Das erste ist, das Theme festzulegen, das eine weitgehend leere Fläche ist, ohne Rahmen, ohne Achsen und ohne Gitterlinien, die erst später eingefügt werden, damit sie über der Grafik liegen. Als erste Schicht werden mit geom_linerange() ockerfarben die durchschnittlichen Temperaturen seit 1995 aufgetragen.
p <- ggplot(Past, aes(newDay, Temp)) +
theme(plot.background = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank()) +
geom_linerange(Past, mapping = aes(x = newDay, ymin = lower, ymax = upper), colour = "wheat2", alpha = .1)
Grafik erstellen Teil 2
Die nächste Schicht fügt das 95%-Intervall um die Mittelwerte der Tagestemperaturen seit 1995 ein. Sprich, die meisten Temperaturen sollten in diesem Intervall liegen. Die Farbe ist ein dunkleres Braun.
p <- p + geom_linerange(Past, mapping = aes(x = newDay, ymin = avg_lower, ymax = avg_upper), colour = "wheat4")
Grafik erstellen Teil 3
Nun kommen die Messwerte des Jahres an die Reihe, das die Grafik darstellen soll. Sie werden mit geom_line() als schwarze Linie eingezeichnet. Bei dieser Gelegenheit fügen wir auch die Y-Achse hinzu. Abweichend vom Original von Tufte wird eine weiter Linie eingezeichnet, die den Mittelwert der durchschnittlichen Tagestemperaturen seit 1995 kennzeichnet. Die Farbe ist Rot. So ist auf einen Blick erkennbar, ob aktuelle Temperaturen über oder unter dem langjährigen Mittel liegen.
p <- p + geom_line(Present, mapping = aes(x = newDay, y = Temp, group = 1)) + geom_vline(xintercept = 0, colour = "wheat4", linetype = 1, size = 1) + geom_line(data=PastMeans, aes(x = newDay, y = Pastmean), size = 0.2, colour = "red")
Grafik erstellen Teil 4
Als nächste Schicht zeichnen wir die grid lines, also Gitternetzlinien, ein. Die horizontalen weißen Linien erscheinen im 5-Grad-Abstand. Sie senkrechten schwarzen gestrichelten Linien markieren die Monatsgrenzen. Zusammen erleichtern sie die Orientierung im Diagramm. ggplot2 stellt dafür geom_hline() und geom_vline() bereit.
p <- p + geom_hline(yintercept = -20, colour = "white", linetype = 1) + geom_hline(yintercept = -15, colour = "white", linetype = 1) + geom_hline(yintercept = -10, colour = "white", linetype = 1) + geom_hline(yintercept = -5, colour = "white", linetype = 1) + geom_hline(yintercept = 0, colour = "white", linetype = 1) + geom_hline(yintercept = 5, colour = "white", linetype = 1) + geom_hline(yintercept = 10, colour = "white", linetype = 1) + geom_hline(yintercept = 15, colour = "white", linetype = 1) + geom_hline(yintercept = 20, colour = "white", linetype = 1) + geom_hline(yintercept = 25, colour = "white", linetype = 1) + geom_hline(yintercept = 30, colour = "white", linetype = 1) + geom_hline(yintercept = 35, colour = "white", linetype = 1) + geom_hline(yintercept = 40, colour = "white", linetype = 1) p <- p + geom_vline(xintercept = 31, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 59, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 90, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 120, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 151, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 181, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 212, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 243, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 273, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 304, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 334, colour = "wheat4", linetype = 3, size = .5) + geom_vline(xintercept = 365, colour = "wheat4", linetype = 3, size = .5)
Grafik erstellen Teil 5
Der nächste Schritt beschriftet die Achsen. Der Bereich der Y-Achse wird auf -20 Grad bis +40 Grad festgelegt, um auch für Städte mit extremerem Klima tauglich zu sein. Anders als bei Tufte ist die Einheit Grad Celsius. Die X-Achse wird mit den Monatsnamen beschriftet. In der Grafik überschneiden sich die Monatsnamen ein wenig. Das liegt an der limitierten Breite des Themes von 676 Pixel.
p <- p +
coord_cartesian(ylim = c(-20,40)) +
scale_y_continuous(breaks = seq(-20,40, by = 5), labels = a) +
scale_x_continuous(expand = c(0, 0),
breaks = c(15,45,75,105,135,165,195,228,258,288,320,350),
labels = c("January", "February", "March", "April",
"May", "June", "July", "August", "September",
"October", "November", "December"))
Grafik erstellen Teil 6
Dieser Schritt unterscheidet sich von der Grafik von Tufte. Es werden rote Punkte eingefügt für Tage, an denen die durchschnittliche Tagestemperatur höher war als in all den Jahren davor seit 1995. Blaue Punkte zeigen durchschnittliche Tagestemperaturen, die niedriger sind als in den Jahren seit 1995. Dieses Element hat Brad Boehmke eingeführt. Man kann gut erkennen, dass es 2016 Ende April ungewöhnlich kalt war und im September an mehreren Tagen wärmer als in den 20 Septembern davor.
p <- p + geom_point(data = PresentLows, aes(x = newDay, y = Temp), colour = "blue3") + geom_point(data = PresentHighs, aes(x = newDay, y = Temp), colour = "firebrick3")
Grafik erstellen Teil 7
Die Daten sind jetzt fast vollständig. Es fehlen aber noch die Beschriftungen. Zunächst Titel und Untertitel. hjust = 0 sorgt dafür, dass sich die Beschriftungen rechtsbündig an den angegebenen Koordinaten ausrichten.
ggtitle(paste("Munich Weather", heuer)) +
theme(plot.title = element_text(face = "bold",hjust = 0,vjust = 0.8,colour = "#3C3C3C",size = 20)) +
annotate("text", x = 1, y = 40 , label = "Temperature", size = 4, fontface = "bold", hjust= 0)
annotate("text", x = 2, y = 38,
label = "Data represents average daily temperatures back to January 1, 1995",
size = 3, colour = "gray30", hjust = 0)
annotate("text", x = 2, y = 36,
label = paste("Average temperature for the year was", dtemp, "degrees celsius"),
size = 3, colour = "gray30", hjust = 0)
Grafik erstellen Teil 8
8. und letzter Schritt. Es werden noch weitere Beschriftungen vorgenommen. Anders als bei Tufte werden über der X-Achse noch die historischen und die aktuellen mittleren Monatstemperaturen dargestellt. Herausgekommen ist eine schöne, informative und leicht für andere Städte und Jahre modifizierbare Grafik!
p <- p +
annotate("text", x = 33, y = -15, label = paste("We had", toString(blue_dots), "days that were the"),
size = 3, colour = "blue3", hjust = 0) +
annotate("text", x = 33, y = -17, label = "coldest since 1995", size = 3, colour = "blue3", hjust = 0) +
annotate("text", x = 290, y = 36, label = paste("We had", toString(red_dots), "days that were the"),
size = 3, colour = "firebrick3", hjust = 0) +
annotate("text", x = 290, y = 34, label = "hottest since 1995", size = 3, colour = "firebrick3", hjust = 0)
annotate("segment", x = 181, xend = 181, y = -15, yend = -5, colour = "wheat2", size = 3) +
annotate("segment", x = 181, xend = 181, y = -9, yend = -11, colour = "wheat4", size = 3) +
annotate("text", x = 198, y = -10, label = "NORMAL RANGE", size = 2, colour = "gray30") +
annotate("text", x = 197, y = -5, label = "RECORD HIGH", size = 2, colour = "gray30") +
annotate("text", x = 197, y = -14, label = "RECORD LOW", size = 2, colour = "gray30") +
annotate("text", x = 15, y = -22, label = toString(s$rTemp[1]), size = 2.5, colour = "gray30") +
annotate("text", x = 45, y = -22, label = toString(s$rTemp[2]), size = 2.5, colour = "gray30") +
annotate("text", x = 75, y = -22, label = toString(s$rTemp[3]), size = 2.5, colour = "gray30") +
annotate("text", x = 105, y = -22, label = toString(s$rTemp[4]), size = 2.5, colour = "gray30") +
annotate("text", x = 135, y = -22, label = toString(s$rTemp[5]), size = 2.5, colour = "gray30") +
annotate("text", x = 165, y = -22, label = toString(s$rTemp[6]), size = 2.5, colour = "gray30") +
annotate("text", x = 195, y = -22, label = toString(s$rTemp[7]), size = 2.5, colour = "gray30") +
annotate("text", x = 228, y = -22, label = toString(s$rTemp[8]), size = 2.5, colour = "gray30") +
annotate("text", x = 258, y = -22, label = toString(s$rTemp[9]), size = 2.5, colour = "gray30") +
annotate("text", x = 288, y = -22, label = toString(s$rTemp[10]), size = 2.5, colour = "gray30") +
annotate("text", x = 320, y = -22, label = toString(s$rTemp[11]), size = 2.5, colour = "gray30") +
annotate("text", x = 350, y = -22, label = toString(s$rTemp[12]), size = 2.5, colour = "gray30") +
annotate("text", x = 15, y = -20, label = toString(v$Temp.y[1]), size = 2.5, colour = "red") +
annotate("text", x = 45, y = -20, label = toString(v$Temp.y[2]), size = 2.5, colour = "red") +
annotate("text", x = 75, y = -20, label = toString(v$Temp.y[3]), size = 2.5, colour = "red") +
annotate("text", x = 105, y = -20, label = toString(v$Temp.y[4]), size = 2.5, colour = "red") +
annotate("text", x = 135, y = -20, label = toString(v$Temp.y[5]), size = 2.5, colour = "red") +
annotate("text", x = 165, y = -20, label = toString(v$Temp.y[6]), size = 2.5, colour = "red") +
annotate("text", x = 195, y = -20, label = toString(v$Temp.y[7]), size = 2.5, colour = "red") +
annotate("text", x = 228, y = -20, label = toString(v$Temp.y[8]), size = 2.5, colour = "red") +
annotate("text", x = 258, y = -20, label = toString(v$Temp.y[9]), size = 2.5, colour = "red") +
annotate("text", x = 288, y = -20, label = toString(v$Temp.y[10]), size = 2.5, colour = "red") +
annotate("text", x = 320, y = -20, label = toString(v$Temp.y[11]), size = 2.5, colour = "red") +
annotate("text", x = 350, y = -20, label = toString(v$Temp.y[12]), size = 2.5, colour = "red") +
annotate("text", x = 280, y = -15, label = "present monthly average", size = 3, colour = "red", hjust = 0) +
annotate("text", x = 280, y = -17, label = "historical monthly average", size = 3, colour = "gray30", hjust = 0)
Schreibe einen Kommentar