++Hausaufgabe vom 19.06.13 (Bevölkerungswandel im Bundesgebiet) Grafik Überarbeitet_Final

### load the necessary package
library(sp)
library(latticeExtra)
library(gridExtra)

### load the German federal state polygons
load("H:/.ntdesktop/spezielle/codes/schlandkarte.RData")

## einlesen der daten

datgross <- read.csv2("H:/.ntdesktop/spezielle/datensatz/Dat.csv", 
na.string = c(".", "-"), skip = 5)

names(datgross) <- c("jahr", "code", "ort", "bevoelkerungsdichte", "aenderung", 
    "anteil auslaender", "Lebendgeborene_10000", "Gestorbene_10000",
 "geb_gest_saldo 10000", "Wanderung_10000")
datgross$ort <- gsub("Freistaat ", "", datgross$ort)

## die ü nun durch ue ersetzen, dafür wird VEktor kriiert
enamessp <- gsub("ü", "ue", gadm@data$NAME_1)

## anschließend die neuen Daten wieder in gadm@data$NAME_1 einlesen lassen
## bzw. wieder reinschreiben
gadm@data$NAME_1 <- enamessp

## kleinerer Datensatz, nur jahr und nur die zahl 16 (Bundesländer mit der
## Codenummer 1-16)
jahr1995 <- subset(datgross, code <= 16 & jahr == "1995")

jahr2011 <- subset(datgross, code <= 16 & jahr == "2011")

### datensatz nach Bundesland und Namen ordnen
jahr1995 <- jahr1995[order(jahr1995$ort), ]
jahr2011 <- jahr2011[order(jahr2011$ort), ]

## calculate global minima and maxima to standardise the colors in each
## plot. We need to add a little offset at the upper end!  die [1] steht
## für das minimum und die [2] für das maximum- +10 ist hierbei für den
## Farbbereich

aend95 <- jahr1995[c("aenderung")]
aend11 <- jahr2011[c("aenderung")]

## Hier beide Datensätze zusammen um somit die skala einzuteilen
aend.min <- range(aend95, aend11)[1]
aend.max <- range(aend95, aend11)[2] + 10

##
ext.aender.95 <- (max(abs(aend95)) + 10)
ext.aender.11 <- (max(abs(aend11)) + 10)

gadm$aenderung1995 <- jahr1995$aenderung

gadm$aenderung2011 <- jahr2011$aenderung

gadm$wanderung1995 <- jahr1995$Wanderung_10000

gadm$wanderung2011 <- jahr2011$Wanderung_10000


## Farbe erstellen
clr3 <- colorRampPalette(brewer.pal(9, "RdBu"))
clr4 <- colorRampPalette(brewer.pal(9, "RdBu"))

## Erstellen der Graphen

plot1995 <- spplot(gadm, zcol = "aenderung1995", col.regions = clr3(15),
 main = "Zu- / Abnahme der Bevölkerung im Bundesgebiet
1995 (links) und 2011 (rechts) im Vergleich je 10.000 Einwohner", 
    at = seq(-ext.aender.95, ext.aender.95, length.out = 10))

plot2011 <- spplot(gadm, zcol = "aenderung2011", col.regions = clr3(15),
 main = "Zu- / Abnahme der Bevölkerung im Bundesgebiet 2011", 
    at = seq(-ext.aender.11, ext.aender.11, length.out = 10))

## Graphen zusammenlegen
vergleich <- c(plot1995, plot2011)

## Auführen der Funktion
vergleich

plot of chunk unnamed-chunk-3

## nun erstellen des Barcharts für den Vergleich von Lebendgeborenen und
## Gestorbenen von 1995 und 2011

## Datensatz für Bundeslaender 1995, 2011
daten <- datgross[c(1, 17, 18, 70, 73, 134, 164, 204, 253, 357, 365, 366, 385, 
    410, 459, 501, 4193, 4209, 4210, 4262, 4265, 4326, 4356, 4396, 4445, 4549, 
    4557, 4558, 4577, 4602, 4651, 4693), ]

daten.small <- daten[c("ort", "Lebendgeborene_10000", "Gestorbene_10000", "jahr")]

## Daten für Visualisierung umbenennen
daten.small$ort <- gsub("Nordrhein-Westfalen", "NRW", daten.small$ort)
daten.small$ort <- gsub("Mecklenburg-Vorpommern", "MeckPomm", daten.small$ort)
daten.small$ort <- gsub("Schleswig-Holstein", "Schleswig-H", daten.small$ort)
daten.small$ort <- gsub("Sachsen-Anhalt", "Sachsen-A", daten.small$ort)
daten.small$ort <- gsub("Rheinland-Pfalz", "RP", daten.small$ort)
daten.small$ort <- gsub("Baden-Wuerttemberg", "BW", daten.small$ort)
daten.small$ort <- gsub("Niedersachsen", "Nsachsen", daten.small$ort)

## Daten nach Bundeländern und Namen sortieren, wird hier nicht benötigt
jahr1995 <- jahr1995[order(jahr1995$ort), ]
jahr2011 <- jahr2011[order(jahr2011$ort), ]

clr <- brewer.pal(3, "PuBu")
clr2 <- brewer.pal(3, "OrRd")
## hierfür wird der Datensatz daten.small verwendet, da dieser die Länder
## von den jahren '95 und '11 enthält

lebegestor1195 <- barchart(as.character(jahr) ~ 
Lebendgeborene_10000 + Gestorbene_10000 | 
    ort, data = daten.small, xlab = "Anzahl Neugeborenen und Gestorbene je 10000", 
    ylab = "Jahr", 
main = "Lebendgeborene und Gestorbene\n je  10000 Einwohner\n\nim Jahresvergleich", 
    col = c(clr[1], clr[3]))

lebegestor1195

plot of chunk unnamed-chunk-5


## Problem: Die Legende hat nicht die richtige Farbe

##nun die wanderung visualisieren

Wanderung visualisiern

## kleinerer Datensatz, nur Bundesländer und das Jahr
jahr1995 <- subset(datgross, code <= 16 & jahr == "1995")

jahr2011 <- subset(datgross, code <= 16 & jahr == "2011")

## Daten nach Bundeländern und Namen sortieren
jahr1995 <- jahr1995[order(jahr1995$ort), ]

jahr2011 <- jahr2011[order(jahr2011$ort), ]
gadm$wanderung1995 <- jahr1995$Wanderung_10000

gadm$wanderung2011 <- jahr2011$Wanderung_10000

## Definierung der Skala
wand95 <- jahr1995[c("Wanderung_10000")]
wand11 <- jahr2011[c("Wanderung_10000")]

ext.95 <- (max(abs(wand95)) + 10)
ext.11 <- (max(abs(wand11)) + 10)

## Plotten mit Farbe#

plot1995_2 <- spplot(gadm, zcol = "wanderung1995", col.regions = clr4(15),
 main = "Wanderung je 10.000 im Bundesgebiet im Jahr 1995", 
    at = seq(-ext.95, ext.95, length.out = 10))
plot2011_2 <- spplot(gadm, zcol = "wanderung2011", col.regions = clr4(15),
 main = "Wanderung je 10.000 im Bundesgebiet im Jahr 2011", 
    at = seq(-ext.11, ext.11, length.out = 10))

plot1995_2

plot of chunk unnamed-chunk-8


plot2011_2

plot of chunk unnamed-chunk-8

### clear plot area
grid.newpage()
### oben
vp1 <- viewport(x = 0, y = 1, height = 0.55, width = 1, just = c("left", "top"), 
    name = "upper left")

pushViewport(vp1)

### show the plotting region (viewport extent)

print(vergleich, newpage = FALSE)

upViewport(1)

### unten rechts

vp3 <- viewport(x = 1, y = 0, height = 0.45, width = 0.35, just = c("right", 
    "bottom"), name = "rechts unten")

pushViewport(vp3)
print(plot2011_2, newpage = FALSE)

upViewport(1)

### unten links
vp5 <- viewport(x = 0, y = 0, height = 0.45, width = 0.35, just = c("left", 
    "bottom"), name = "links unten")

pushViewport(vp5)

print(plot1995_2, newpage = FALSE)

upViewport(1)

### unten mitte

vp4 <- viewport(x = 0.65, y = 0, height = 0.45, width = 0.3, just = c("right", 
    "bottom"), name = "mitte unten")

pushViewport(vp4)
print(lebegestor1195, newpage = FALSE)

downViewport(trellis.vpname(name = "figure"))

vp4.1 <- viewport(x = 1, y = 1, height = 0.33, width = 0.33, just = c("right", 
    "top"), name = "mitte Legende")

pushViewport(vp4.1)

grid.rect(x = 0.2, y = 0.6, height = 0.15, width = 0.3, just = "centre",
 gp = gpar(fill = clr[3]))

grid.text("Gestorbene", x = 0.58, y = 0.6, just = "centre")

grid.rect(x = 0.2, y = 0.3, height = 0.15, width = 0.3, just = "centre",
 gp = gpar(fill = clr[1]))

grid.text("Geborene", x = 0.56, y = 0.3, just = "centre")

upViewport(1)

grafik_ueberarbeitet


Leave a Reply