Monthly Archives: June 2013

20.06: Verbesserte Grafik zum Auslaenderanteil an deutschen Schulen

Hier der Quelltext der Grafik:

library(latticeExtra)
library(sp)
dat <- read.csv2("H:/R/win-library/2.15/codes/datensatz_schulen_all.csv", skip = 8)

names(dat) <- c("Jahr", "Zahl_Bundesland", "Bundesland", "Schulform", "Anzahl_Schulen", 
    "Anzahl_Schueluelerinsg", "Anzahl_Schueler_weibl", "Auslaender", "klasse_7", 
    "Klasse_11")
aus <- dat$Auslaender

head(aus)
## [1]  496 6513    0 3747    0 1994
ges <- dat$Anzahl_Schueluelerinsg

head(ges)
## [1]   5861 114696      0  39363      0  51359
x <- c(1:272)  # da wir 272*12 daten im ursprünglichen datensatz

auslinsg <- aus[12 * x]  # nur die ausländer aus den insgesamtzeilen
gesinsg <- ges[12 * x]  # nur gesamtschülerzahl von allen schulen  (immer 12te zeile)
ausinsgrel <- auslinsg * 100/gesinsg  # ins verhältnis gesetzt in %

head(ausinsgrel)
## [1]  5.265 19.084  7.227 16.938 13.587 15.405
jahre_stat <- c(rep("1995", 16), rep("1996", 16), rep("1997", 16), rep("1998", 
    16), rep("1999", 16), rep("2000", 16), rep("2001", 16), rep("2002", 16), 
    rep("2003", 16), rep("2004", 16), rep("2005", 16), rep("2006", 16), rep("2007", 
        16), rep("2008", 16), rep("2009", 16), rep("2010", 16), rep("2011", 
        16))  # erstellt die var der jahre für unseren datensatz

bl <- rep(unique(dat$Bundesland), length(unique(jahre_stat)))
bl <- gsub("Freistaat Sachsen", "Sachsen", bl)
# jedes bundesland nur einmal wdhl über die länge der jahre

y <- c(0:271)
gymaus <- aus[7 + 12 * y]  # vektor mit auslaendern auf gym

head(gymaus)
## [1]  1570  4606  4476  1241 28307 12548
gymins <- ges[7 + 12 * y]
gymrel <- gymaus * 100/gymins  # auslaender in gymnasien in % pro bundesland

head(gymrel)
## [1]  2.464 10.351  2.977  8.627  5.668  7.781
hauptaus <- aus[4 + 12 * y]  # vektor mit auslaendern auf haupt

head(hauptaus)
## [1]  3747  4702 10296  1526 70208 11737
hauptins <- ges[4 + 12 * y]
hauptrel <- hauptaus * 100/hauptins  # auslaender in hauptschuelen in % pro bundesland

head(hauptrel)
## [1]  9.519 33.512 11.885 28.593 24.858 30.089
# unser 'eigener' datensatz
plottstatistik <- data.frame(ausinsgrel, jahre_stat, bl, gymrel, hauptrel)
clr <- c("#ECE7F2", "#A6BDDB", "#2B8CBE")  # farben def

p <- xyplot(ausinsgrel ~ jahre_stat | bl, xlim = c(1995:2011), type = "l", main = "Auslaenderanteil in % der Bundeslaender von 95 bis 11", 
    xlab = "Jahre", ylab = "Auslaenderanteil an Schulen in %", panel = panel.xyarea, 
    col = c(clr[0], clr[3]))

p

plot of chunk unnamed-chunk-11

load("H:/R/win-library/2.15/codes/DEU_adm1.RData")
gadm@data$NAME_1
##  [1] "Baden-Württemberg"      "Bayern"                
##  [3] "Berlin"                 "Brandenburg"           
##  [5] "Bremen"                 "Hamburg"               
##  [7] "Hessen"                 "Mecklenburg-Vorpommern"
##  [9] "Niedersachsen"          "Nordrhein-Westfalen"   
## [11] "Rheinland-Pfalz"        "Saarland"              
## [13] "Sachsen-Anhalt"         "Sachsen"               
## [15] "Schleswig-Holstein"     "Thüringen"
ausinsgrelkurz <- subset(plottstatistik, jahre_stat == "2010")
# reduziere datzensatz auf länge 16

daten <- gsub("ü", "ue", gadm@data$NAME_1)
# ersetzte ü durch ue der variable Name_1
gadm@data$NAME_1 <- daten

gadm@data <- data.frame(gadm@data, ausinsgrelkurz[match(gadm@data[, "NAME_1"], 
    ausinsgrelkurz[, "bl"]), ])

clrs <- colorRampPalette(brewer.pal(7, "PuBu"))  # farben definieren
clrs1 <- colorRampPalette(brewer.pal(7, "YlOrRd"))  # farben definieren
clrs2 <- colorRampPalette(brewer.pal(7, "Greens"))  # farben definieren

alle <- spplot(gadm, zcol = "ausinsgrel", col.regions = clrs(16), main = list("Relativer Ausleanderanteil (in %)\nan Schulen pro Bundesland 2010", 
    cex = 0.9), at = seq(0, 35, 3), par.settings = list(axis.line = list(col = 0)), 
    colorkey = list(space = "left", width = 1, height = 1))
# plottet auf die karte, die gewählte var (zcol) in geg farbe

gymdeutschland <- spplot(gadm, zcol = "gymrel", col.regions = clrs2(16), main = list("Relativer Ausleanderanteil (in %)\nan Gymnasien pro Bundesland 2010", 
    cex = 0.9), at = seq(0, 35, 3), par.settings = list(axis.line = list(col = 0)), 
    colorkey = list(width = 1, height = 1))

hauptdeutschland <- spplot(gadm, zcol = "hauptrel", col.regions = clrs2(16), 
    main = list("Relativer Ausleanderanteil (in %)\nan Hauptschulen pro Bundesland 2010 (*)", 
        cex = 0.9), at = seq(0, 35, 3), par.settings = list(axis.line = list(col = 0)), 
    colorkey = list(space = "left", width = 1, height = 1))

hessengym <- subset(plottstatistik$gymrel, bl == "Hessen")

hessenhaupt <- subset(plottstatistik$hauptrel, bl == "Hessen")

hessen <- data.frame(hessengym, hessenhaupt, 1995:2011)

berlingym <- subset(plottstatistik$gymrel, bl == "Berlin")

berlinhaupt <- subset(plottstatistik$hauptrel, bl == "Berlin")

berlin <- data.frame(berlingym, berlinhaupt, 1995:2011)

jahr <- c(1995:2011)

vergleich <- c(hessengym[1], hessengym[17], hessenhaupt[1], hessenhaupt[17], 
    berlingym[1], berlingym[17], berlinhaupt[1], berlinhaupt[17])

namen_balken <- c("Gym 95_H", "Gym 11_H", "Haupt 95_H", "Haupt 11_H", "Gym 95_B", 
    "Gym 11_B", "Haupt 95_B", "Haupt 11_B")

# namen_balken <-c('Gym 95_H', 'Gym 11_H', 'Haupt 95_H','Haupt 11_H','Gym
# 95_B', 'Gym 11_B', 'Haupt 95_B','Haupt 11_B')

namen_balken <- ordered(namen_balken, levels = c("Gym 95_H", "Gym 11_H", "Haupt 95_H", 
    "Haupt 11_H", "Gym 95_B", "Gym 11_B", "Haupt 95_B", "Haupt 11_B"))

color <- c("chartreuse4", "chartreuse2", "chartreuse4", "chartreuse2", "darkorange3", 
    "darkorange2", "darkorange3", "darkorange2")

library(ggplot2)

balken <- barchart(vergleich ~ namen_balken, cex.names = 0.8, col = color, main = list("Vergleich ausgewählter Bundeslaender", 
    cex = 0.9), ylab = "Auslaenderanteil in Hessen und Berlin (in %)", scales = list(x = list(rot = 35)))

library(gridExtra)

grid.newpage()

vp1 <- viewport(x = 0.33, y = 1, height = 0.5, width = 0.33, just = c("left", 
    "top"), name = "upper left")
pushViewport(vp1)
print(hauptdeutschland, newpage = FALSE)

upViewport(1)

vp2 <- viewport(x = 0.66, y = 1, height = 0.5, width = 0.33, just = c("left", 
    "top"), name = "lower left")
pushViewport(vp2)
print(gymdeutschland, newpage = FALSE)

upViewport(1)

vp3 <- viewport(x = 0.312, y = 1, height = 0.5, width = 0.33, just = c("right", 
    "top"), name = "lower right")
pushViewport(vp3)
print(alle, newpage = FALSE)

upViewport(1)

vp4 <- viewport(x = 0, y = 0, height = 0.5, width = 0.66, just = c("left", "bottom"), 
    name = "upper right")
pushViewport(vp4)
print(balken, newpage = FALSE)

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

grid.rect(x = 0.08, y = 0.6, height = 0.1, width = 0.05, just = c("left", "bottom"), 
    gp = gpar(fill = color[1]))
grid.rect(x = 0.13, y = 0.6, height = 0.1, width = 0.05, just = c("left", "bottom"), 
    gp = gpar(fill = color[2]))

grid.text("Hessen", x = 0.08, y = 0.75, rot = 360, just = c("left", "bottom"))

grid.rect(x = 0.58, y = 0.6, height = 0.1, width = 0.05, just = c("left", "bottom"), 
    gp = gpar(fill = color[5]))
grid.rect(x = 0.63, y = 0.6, height = 0.1, width = 0.05, just = c("left", "bottom"), 
    gp = gpar(fill = color[6]))

grid.text("Berlin", x = 0.58, y = 0.75, rot = 360, just = c("left", "bottom"))

upViewport(0)

vp5 <- viewport(x = 0.67, y = 0, height = 0.5, width = 0.33, just = c("left", 
    "bottom"), name = "text")

pushViewport(vp5)

grid.text("*: in den neuen Bundeslaendern \n keine Daten vorhanden \n Grafik von Luise, Sebastian und \n Korbinian Datum: 19.06.13", 
    x = 0, y = 0.7, rot = 360, just = c("left", "top"))

plot of chunk unnamed-chunk-15

Auslaenderanteil an dt Schulen

Hausaufgabe 19.06.13 (Bevölkerungswandel im Bundesgebiet) ++Verbessert

### 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

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(16),
 main = "Zu- / Abnahme der Bevölkerung im Bundesgebiet
1995 (links) und 2011 (rechts) im Vergleich", 
    at = seq(aend.min, aend.max, 16))

plot2011 <- spplot(gadm, zcol = "aenderung2011", col.regions = clr3(16),
 main = "Zu- / Abnahme der Bevölkerung im Bundesgebiet 2011", 
    at = seq(aend.min, aend.max, 16))

## 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 im 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")]

wand.min <- range(wand95, wand11)[1]
wand.max <- range(wand95, wand11)[2] + 10

## Plotten mit Farbe#
plot1995_2 <- spplot(gadm, zcol = "wanderung1995", col.regions = clr4(16),
 main = "Wanderung je 10.000 im Bundesgebiet im Jahr 1995", 
    at = seq(wand.min, wand.max, 16))

plot2000_2 <- spplot(gadm, zcol = "wanderung2011", col.regions = clr4(16),
 main = "Wanderung je 10.000 im Bundesgebiet im Jahr 2011", 
    at = seq(wand.min, wand.max, 16))

plot1995_2

plot of chunk unnamed-chunk-8


plot2000_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(plot2000_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)

plot_zoom_png_gutfarbe