1. Daten herunterladen und einlesen

Folgender Code lädt die benötigten Dateien herunter, falls sie nicht bereits existieren.

fb_file <- "CIAWorldFactbook2013.xlsx"
if (!file.exists(fb_file))
  download.file("http://gsociology.icaap.org/data/CIAWorldFactbook2013.xlsx",
                fb_file, mode = "wb")
wp_file <- "WorldPopulation.xlsx"
if (!file.exists(wp_file))
  download.file("http://gsociology.icaap.org/data/WorldPopulation.xlsx",
                wp_file, mode = "wb")

Dateien einlesen. Die geeigneten Spaltentitel befinden sich jeweils in der zweiten Zeile. Deshalb wird skip = 1 verwendet, um die erste Zeile zu ignorieren.

fb_raw <- read_excel("CIAWorldFactbook2013.xlsx", sheet = "data", skip = 1)
## New names:
## • `` -> `...1`
wp_raw <- read_excel("WorldPopulation.xlsx", sheet = "Population", skip = 1)
## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`

2. Daten bereinigen (data cleaning)

Bereinigen der Spaltenbezeichnungen in fb_raw: Die Spalte mit den Ländern hat keinen Titel und wurde deshalb von read_excel() mit ...1 bezeichnet. Daneben gibt es noch zwei Spaltenüberschriften mit Leerzeichen. Alle diese Spalten werden umbenannt und anschliessend alle Spaltentitel in Kleinbuchstaben konvertiert:

fb <- fb_raw %>%
  rename(Country = "...1",
         GDP_PPP = "GDP PPP",
         Percent_Urban = "Percent Urban")
names(fb) <- tolower(names(fb))

In wp_raw gibt es vier Spalten ohne Titel, die hier mit einem geeigneten Titel versehen werden. Die vierte Spalte (...4) ist leer und wird entfernt:

wp <- wp_raw %>%
  rename(Un_Stat = "...1",
         Country_Area = "...2",
         Abb = "...3") %>%
  select(-"...4")
names(wp) <- tolower(names(wp))

Es gibt in beiden Tabellen Zeilen, die keine Länderbezeichnung enthalten:

sum(is.na(fb$country))
## [1] 22
sum(is.na(wp$country))
## [1] 1

Diese Zeilen werden nicht benötigt:

fb <- fb %>% filter(!is.na(country))
wp <- wp %>% drop_na(country)

Prüfe, ob es für gewisse Länder doppelte Einträge gibt:

fb$country[duplicated(fb$country)]
## [1] "Falkland Islands (Islas Malvinas)" "Holy See (Vatican City)"          
## [3] "Kosovo"
wp$country[duplicated(wp$country)]
## character(0)

Dies ist nur in der Tabelle fb der Fall. Die Duplikate sollen eliminiert werden.

Einfache Lösung: Verwende distinct() um von den Zeilen mit identischem Land jeweils nur die erste zu behalten:

fb1 <- fb %>% distinct(country, .keep_all = TRUE)

Schwierigere Lösung (Zusatzaufgabe): Bei den duplizierten Ländern steht in manchen Spalten nur in einer der beiden Zeilen ein Wert. Beispiel:

filter(fb, country == "Holy See (Vatican City)")[, 1:5]
## # A tibble: 2 × 5
##   country                 pop2013 area_sqkm popgrowthrate birthrate
##   <chr>                     <dbl>     <dbl>         <dbl>     <dbl>
## 1 Holy See (Vatican City)      NA        NA            NA        NA
## 2 Holy See (Vatican City)     839         0             0        NA

Obige Lösung verliert hier sämtliche Werte, weil nur die erste der beiden Zeilen behalten wird:

filter(fb1, country == "Holy See (Vatican City)")[, 1:5]
## # A tibble: 1 × 5
##   country                 pop2013 area_sqkm popgrowthrate birthrate
##   <chr>                     <dbl>     <dbl>         <dbl>     <dbl>
## 1 Holy See (Vatican City)      NA        NA            NA        NA

Eine bessere, aber kompliziertere, Lösung behält in jeder Spalte jeweils die Zeile, die einen Wert enthält:

fb <- fb %>%
  group_by(country) %>%
  summarise(across(everything(), function(x) na.omit(x)[1]))
filter(fb, country == "Holy See (Vatican City)")[, 1:5]
## # A tibble: 1 × 5
##   country                 pop2013 area_sqkm popgrowthrate birthrate
##   <chr>                     <dbl>     <dbl>         <dbl>     <dbl>
## 1 Holy See (Vatican City)     839         0             0        NA

3. Regionen

Die Region ist nur in der Tabelle wp enthalten. Der Name “Latin America and the Caribbean” ist sehr lang. Verwende einen kürzeren Namen:

wp$region[wp$region == "Latin America and the Caribbean"] <- "Latin America"

Mittels eines Joins wird die Region auch in die Tabelle fb übernommen:

fb <- fb %>%
  left_join(select(wp, country, region),
            by = "country")

Für einige Länder wurde keine Region gefunden. Folgende Tabelle zeigt diese Länder absteigend nach Fläche sortiert:

fb %>%
  filter(is.na(region)) %>%
  select(country, pop2013, area_sqkm) %>%
  arrange(desc(area_sqkm)) %>%
  knitr::kable()
country pop2013 area_sqkm
Congo, Democratic Republic of the 75507308 2344858
Congo, Republic of the 4492689 342000
Svalbard 1921 62045
British Indian Ocean Territory 0 54400
Falkland Islands (Islas Malvinas) 3140 12173
South Georgia and South Sandwich Islands 0 3903
Virgin Islands 104737 1910
Heard Island and McDonald Islands 0 412
Jan Mayen 0 377
Saint Helena, Ascension, and Tristan da Cunha 7754 308
Niue 1229 260
British Virgin Islands 31912 151
Christmas Island 1513 135
Dhekelia 15700 131
Akrotiri 15700 123
French Southern and Antarctic Lands 0 55
Bouvet Island 0 49
Pitcairn Islands 48 47
Norfolk Island 2196 36
United States Pacific Island Wildlife Refuges 0 22
Cocos (Keeling) Islands 596 14
Tokelau 1353 12
Wake Island 0 7
Clipperton Island 0 6
Ashmore and Cartier Islands 0 5
Navassa Island 0 5
Spratly Islands 0 5
Coral Sea Islands 0 3
Howland Island 0 2
Holy See (Vatican City) 839 0
European Union NA NA

Die beiden grössten Länder sind “Congo, Democratic Republic of the” und “Congo, Republic of the”. Suche nach “Congo” in der Tabelle wp:

wp %>%
  filter(str_detect(country, "Congo")) %>%
  select(un_stat:country) %>%
  knitr::kable()
un_stat country_area abb region country
178 Congo COG Africa Congo (Brazzaville)
180 Democratic Republic of the Congo COD Africa Congo (Kinshasa)

Der Grund ist also, dass die beiden Länder in der Tabelle wp mit einem anderen Namen gelistet werden, so dass das Join sie nicht finden kann. Die Länder ohne Region werden nun entfernt:

fb <- fb %>% drop_na(region)

Anzahl Länder pro Region:

fb %>% 
  count(region) %>%
  knitr::kable()
region n
Africa 53
Asia 52
Europe 49
Latin America 43
Northern America 5
Oceania 21

Stelle die gleiche Information als Säulendiagramm dar:

fb %>%
  ggplot(aes(x = region)) +
    geom_bar() +
    labs(title = "Anzahl Länder pro Region",
         x = "Region", y = "Anzahl Länder")

4. Fläche und Bevölkerung

Definiere eine neue Tabelle mit der Bevölkerung in Millionen und der Fläche in 1000 km2:

fb_pa <- fb %>%
  transmute(country, region,
            pop = pop2013/1e6,
            area = area_sqkm/1000)

Länder mit der grössten bzw. kleinsten Bevölkerung:

fb_pa %>%
  arrange(desc(pop)) %>%
  head(n = 5) %>%
  knitr::kable()
country region pop area
China Asia 1349.5858 9596.961
India Asia 1220.8004 3287.263
United States Northern America 316.6686 9826.675
Indonesia Asia 251.1601 1904.569
Brazil Latin America 201.0096 8514.877 
fb_pa %>%
  arrange(pop) %>%
  head(n = 5) %>%
  knitr::kable()
country region pop area
Montserrat Latin America 0.005189 0.102
Saint Pierre and Miquelon Northern America 0.005774 0.242
Saint Barthelemy Latin America 0.007298 0.021
Nauru Oceania 0.009434 0.021
Cook Islands Oceania 0.010447 0.236

Länder mit der grössten bzw. kleinsten Fläche:

fb_pa %>%
  slice_max(area, n = 5) %>%
  knitr::kable()
country region pop area
Russia Europe 142.50048 17098.242
Canada Northern America 34.56821 9984.670
United States Northern America 316.66857 9826.675
China Asia 1349.58584 9596.961
Brazil Latin America 201.00962 8514.877 
fb_pa %>%
  slice_min(area, n = 5) %>%
  knitr::kable()
country region pop area
Monaco Europe 0.030500 0.002
Gibraltar Europe 0.029111 0.007
Nauru Oceania 0.009434 0.021
Saint Barthelemy Latin America 0.007298 0.021
Tuvalu Oceania 0.010698 0.026

Tabelle der Bevölkerung und Fläche pro Region:

pa_by_region <- fb_pa %>%
  group_by(region) %>%
  summarise(pop  = sum(pop, na.rm = TRUE),
            area = sum(area, na.rm = TRUE))
pa_tot <- pa_by_region %>%
  summarise(pop = sum(pop),
            area = sum(area)) %>%
  mutate(region = "Total")
pa <- bind_rows(pa_by_region, pa_tot) 
knitr::kable(pa)
region pop area
Africa 1019.17295 27625.385
Asia 4265.25084 31903.579
Europe 740.79379 23092.720
Latin America 602.21551 20454.145
Northern America 351.36973 21977.727
Oceania 36.27076 8561.234
Total 7015.07358 133614.790

Speichere die Tabelle in einer csv-Datei:

write_excel_csv(pa, "pop_area_summary.csv", delim = ";")

Plot der Fläche und Bevölkerung für alle Länder der Erde. Weil die Werte über einen sehr grossen Bereich variieren, werden logarithmische Achsen verwendet.

fb_pa %>%
  ggplot(aes(x = area, y = pop, colour = region)) +
  geom_point() +
  scale_x_log10(labels = scales::label_comma(big.mark = "'")) + 
  scale_y_log10(labels = scales::label_comma(big.mark = "'")) +
  scale_colour_brewer(palette = "Set1") +
  labs(title = "Fläche und Bevölkerung für die Staaten der Erde nach Regionen",
       subtitle = "Daten aus dem CIA World Factbook 2013",
       x = expression(paste("Fläche in 1000 ", km^2)),
       y = "Bevölkerung in Millionen",
       colour = "Region")

5. Bevölkerungsentwicklung

Wähle nur die für die Bevölkerungsentwicklung relevanten Spalten aus:

fb_pop <- fb %>%
  select(country:pop2013, popgrowthrate:netmigrationrate) %>%
  mutate(pop2013 = pop2013/1000) %>%
  rename(pop = pop2013)

Das Bevölkerungswachstum lässt sich aus der Geburtenrate, Sterberate und Migrationsrate berechnen:

fb_pop <- fb_pop %>%
  mutate(growth_comp = (birthrate - deathrate + netmigrationrate) / 1000 * 100)

Die Wachstumsrate aus dem Factbook wird nun mit der berechneten Rate verglichen. Die Zeilen mit der grössten relativen Differenz sind:

fb_pop %>% 
  mutate(
    diff_abs = abs(growth_comp - popgrowthrate),
    diff_rel = diff_abs / popgrowthrate
  ) %>%
  select(country, popgrowthrate, growth_comp:diff_rel) %>%
  filter(diff_rel > 0.02) %>%
  knitr::kable()
country popgrowthrate growth_comp diff_abs diff_rel
Belgium 0.05 0.052 0.002 0.0400000
Finland 0.06 0.056 0.004 0.0666667
Greece 0.04 0.036 0.004 0.1000000
Greenland 0.03 0.029 0.001 0.0333333
Monaco 0.00 -0.003 0.003 Inf
Northern Mariana Islands 0.09 0.086 0.004 0.0444444
Slovakia 0.09 0.087 0.003 0.0333333
Sweden 0.18 0.175 0.005 0.0277778
Syria 0.15 0.145 0.005 0.0333333

In all diesen Fällen ist die absolute Differenz klein. Es handelt sich offenbar um Rundungsdifferenzen, die daher rühren, dass popgrowthrate nur auf zwei Stellen genau angegeben wird. Weil die Wachstumsraten bei den betroffenen Ländern sehr klein sind, werden die Rundungsdifferenzen im relativen Fehler aufgebläht.

Die Differenzen können eliminiert werden, indem auch die berechnete Rate auf zwei Stellen nach dem Komma gerundet wird:

fb_pop %>% 
  mutate(
    growth_comp_r = round(growth_comp, 2),
    diff_abs = abs(growth_comp_r - popgrowthrate),
    diff_rel = diff_abs / popgrowthrate
  ) %>%
  select(country, popgrowthrate, growth_comp_r, growth_comp:diff_rel) %>%
  filter(diff_rel > 0.02) %>%
  knitr::kable()
country popgrowthrate growth_comp_r growth_comp diff_abs diff_rel
Sweden 0.18 0.17 0.175 0.01 0.0555556

Ein einziger Fall mit einer Differenz grösser 2% bleibt übrig. Die Ursache ist hier, dass es sich bei der dritten Stelle um eine 5 handelt, so dass kleinste Unterschiede die Richtung der Rundung verändern können.

6. Lebenserwartung

Wähle nur die für die Lebenserwartung relevanten Spalten aus:

le <- fb %>% select(country, region, lifeexpectancy)

Vergleiche die Verteilung der Lebenserwartung in einem Histogramm und einem Boxplot:

le %>%
  ggplot(aes(x = lifeexpectancy, fill = region)) +
  geom_histogram(binwidth = 1) +
  facet_grid(region ~ .) +
  scale_fill_discrete(guide = "none") +
  scale_x_continuous(breaks = seq(0, 100, by = 5)) +
  labs(title = "Verteilung der Lebenserwartung pro Region",
       x = "Lebenserwartung in Jahren",
       y = "Anzahl Länder")

le %>%
  ggplot(aes(x = region, y = lifeexpectancy, fill = region)) +
  geom_boxplot() +
  scale_fill_discrete(guide = "none") +
  scale_y_continuous(breaks = seq(0, 100, by = 5)) +
  labs(title = "Verteilung der Lebenserwartung pro Region",
       x = "Region",
       y = "Lebenserwartung in Jahren") +
  coord_flip()

Im folgenden Boxplot werden die Ausreisser beschriftet. Die Lösung basiert auf einer Antwort von JasonAizkalns auf StackOverflow.

is_outlier <- function(x) {
  qs <- quantile(x, c(0.25, 0.75), na.rm = TRUE)
  whisk <- 1.5 * diff(qs)
  return(x < qs[1] - whisk | x > qs[2] + whisk)
}
le_ol <- group_by(le, region) %>%
          mutate(outlier = if_else(is_outlier(lifeexpectancy), country, ""))

le_ol %>%
  ggplot(aes(x = region, y = lifeexpectancy, fill = region)) +
  geom_boxplot() +
  scale_fill_discrete(guide = "none") +
  scale_y_continuous(breaks = seq(0, 100, by = 5),
                     expand = expansion(mult = c(0.12, 0.1))) +
  labs(title = "Verteilung der Lebenserwartung pro Region",
       x = "Region",
       y = "Lebenserwartung in Jahren") +
  coord_flip() +
  geom_text(aes(label = outlier), nudge_x = 0.3)

7. Bevölkerungswachstum

Erstelle ein tidy dataset der wesentlichen Daten:

pop <- wp %>%
  select(country, region, starts_with("pop")) %>%
  pivot_longer(cols = c(-country, -region),
               names_to = "year",
               values_to = "pop") %>%
  mutate(year = as.numeric(str_extract(year, "[0-9]+")))

Summiere die Bevölkerung pro Region:

pop_by_region <- pop %>%
  summarise(pop = sum(pop)/1e6,
            .by = c(region, year))

Erstelle einen Plot der Bevölkerungsentwicklung:

this_year <- lubridate::year(lubridate::today())
pop_by_region %>%
  ggplot(aes(x = year, y = pop, colour = region)) +
  geom_line() +
  scale_x_continuous(breaks = seq(1950, 2030, by = 10)) +
  geom_vline(xintercept = this_year, col = "red") +
  annotate("text", x = this_year, y = Inf, label = "heute",
           hjust = 1.2, vjust = 1.5, colour = "red") +
  labs(title = "Bevölkerungsentwicklung nach Region",
          x = "Jahr", y = "Bevölkerung in Millionen")

8. Bevölkerung aller Länder über die Zeit

Für jede Region und jedes Jahr soll ein Säulendiagramm der Bevölkerung aller Länder erstellt werden. Erzeuge dafür zuerst ein Gitter aller Kombinationen von Jahr und Region:

regions <- unique(pop$region)
years <- unique(pop$year)
ry <- expand.grid(region = regions, year = years)

Erstelle nun in einer Schleife für jede Kombination von Jahr und Region ein Säulendiagramm. Alle Plots werden in der gleichen pdf-Datei gespeichert. Dieser Teil des Codes wird nur dann ausgeführt, wenn die pdf-Datei noch nicht existiert.

pdf_file <- "pop_per_region_year.pdf"

if (!file.exists(pdf_file)) {
  pdf(pdf_file, paper = "a4r",
      width = 29.7/2.54, height = 21/2.54 )
  
  for (i in 1:nrow(ry)) {
    data <- pop %>% filter(region == ry$region[i], year == ry$year[i])
    plot <- data %>%
      ggplot(aes(x = country, y = pop/1e6)) +
      geom_col() +
      labs(title = paste("Bevölkerung der Länder in", ry$region[i],
                         "im Jahr", ry$year[i]),
           x = "Land",
           y = "Bevölkerung in Millionen") +
      theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
    print(plot)
  }
  dev.off()
}