# Löschen aller offenen "Container"
rm(list = ls()) # loescht alle geladenen Datensaetze, objects, lists, etc. (siehe rechts oben: environment)
dev.off() # loescht graphical parameters von alten plots.
cat("\014") # loescht alte commands in der console
#Bibliotheken
library(dplyr)
library(car)
library(foreign)
library(plotly)
library(ggplot2)
library(sp)
library(geojson)
library(geojsonio)
library(leaflet)
library(rgdal)
library(plyr)
library(data.table)
library(shiny)
library(htmlwidgets)
library(webshot)
#____________________________________________________________________________________________________________________________________________
#TEIL 1. - DATENSÄTZE ERSTELLEN
#____________________________________________________________________________________________________________________________________________
#--------------------------------------------------------------------------------------------------------------------------------------------
##DATEN EINLESEN UND SINGLES DEFINIEREN
#--------------------------------------------------------------------------------------------------------------------------------------------
#Daten einlesen
setwd("C:\\Users\\mauro\\Documents\\Daten Stadt Zürich")
zuzug <- read.csv("zuzug.csv", header = T)
bev <- read.csv("bevoelkerung.csv", header = T)
#Datensätze mergen
data.z <- merge(bev, zuzug, by = c("PersNum", "StichtagDatJahr"), all.x = T)
#Datensatz ab 2013 um Bewegung der Singles zu analysieren
data.zh <- data.z %>% filter(StichtagDatJahr>=2013)
#Neue Variable Singles
data.zh$singles <- NA
data.zh$singles = case_when(data.zh$Ziv2Lang == 'Ledig' & data.zh$HHtypLang == 'Einpersonenhaushalt' &
(data.zh$ AlterV05Kurz=="25-29"|
data.zh$ AlterV05Kurz=="30-34"|
data.zh$AlterV05Kurz=="35-39"|
data.zh$AlterV05Kurz=="40-44"|
data.zh$AlterV05Kurz=="45-49"|
data.zh$AlterV05Kurz=="50-54") ~ 1, TRUE ~ 0)
length(unique(data.zh$PersNum[data.zh$singles==1]))
#--------------------------------------------------------------------------------------------------------------------------------------------
###VERTEILUNG DER SINGLES 2016 PRO QUARTIER
#--------------------------------------------------------------------------------------------------------------------------------------------
# Neuer Datensatz nur Jahr 2016 für anzahl Singles pro Quartier:
data.2016 <- data.zh %>% group_by(PersNum) %>% filter(StichtagDatJahr==2016) %>% select(PersNum, singles, SexCd, QuarLang, AlterV05Kurz)
#--------------------------------------------------------------------------------------------------------------------------------------------
##SINGLES PRO QUARTIER (KARTE)
##Karte1
#Enthält Daten zu:
#Anteil Singles an Quartierbevölkerung 2016
#Anteil männliche Singles an Quartierbevölkerung 2016
Karte1 <- expand.grid(Quartier =unique(data.2016$QuarLang), Singles = unique(data.2016$singles))
Karte1$proz <- NA
Karte1$total <- NA
Karte1$singles <- NA
Karte1$prozMänner <- NA
Karte1$Männer <- NA
Karte1$Frauen <- NA
Quartier.k <- sort(unique(Karte1$Quartier))
##Loop für Ka1.2
#PROBLEM
length(unique(data.2016$PersNum[data.2016$QuarLang=="Affoltern"]))==nrow(subset(data.2016,QuarLang=="Affoltern"))
for (i in Quartier.k){
z <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1]))
z1 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i]))
Karte1$proz[Karte1$Quartier==i & Karte1$Singles==1] <- round(100*z/(z1), digits = 2)
Karte1$total[Karte1$Quartier==i] <- z1
Karte1$singles[Karte1$Quartier==i] <- z
z2 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 & data.2016$SexCd==1]))
z3 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 ]))
Karte1$prozMänner[Karte1$Quartier==i & Karte1$Singles==1] <- round(100*z2/(z3), digits = 2)
Karte1$Männer[Karte1$Quartier==i] <- z2
Karte1$Frauen[Karte1$Quartier==i] <- z-z2
}
#Alle Beobachtungen entfernen die Wert= bei singles haben
Karte1 <- Karte1[Karte1$Singles>0,]
Karte1
#Für Rang muss Datensatz sortiert werden
Karte1$Quartier <- as.character(Karte1$Quartier)
Karte1 <- arrange(Karte1, desc(Karte1$proz))
Karte1$Quartier <- factor(Karte1$Quartier, levels=unique(Karte1$Quartier))
Karte1
#--------------------------------------------------------------------------------------------------------------------------------------------
###ALTER UND GESCHLECHT DER SINGLES PRO QUARTIER 2016
#--------------------------------------------------------------------------------------------------------------------------------------------
##AltSex
#Enthält Daten zu:
#Anteil Singles an Altersklasse pro Quartierbevölkerung 2016
#Anteil geschlecht pro Sex an Quartierbevölkerung 2016
AltSex <- expand.grid(Quartier =unique(data.2016$QuarLang), Singles = unique(data.2016$singles),
Geschlecht = unique(data.2016$SexCd), Alter = as.character(c("25-29", "30-34", "35-39", "40-44", "45-49", "50-54")))
AltSex$Anzahl <- NA
AltSex$Population <- NA
AltSex <- AltSex[AltSex$Singles>0,]
Alter.a <- sort(unique(AltSex$Alter))
Quartier.a <- sort(unique(AltSex$Quartier))
for (i in Quartier.a){
for (j in Alter.a){
a <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 & data.2016$SexCd==1 & data.2016$AlterV05Kurz==j]))
a1 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 & data.2016$SexCd==2 & data.2016$AlterV05Kurz==j]))
a2 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 & data.2016$AlterV05Kurz==j]))
a3 <- length(unique(data.2016$PersNum[data.2016$QuarLang==i & data.2016$singles==1 ]))
AltSex$Anzahl[AltSex$Quartier==i & AltSex$Alter==j & AltSex$Geschlecht==1] <- a
AltSex$Anzahl[AltSex$Quartier==i & AltSex$Alter==j & AltSex$Geschlecht==2] <- a1
AltSex$Population[AltSex$Quartier==i] <- a3
}
}
AltSex
#--------------------------------------------------------------------------------------------------------------------------------------------
###ZUGEZOGENE SINGLES AB 2013
#--------------------------------------------------------------------------------------------------------------------------------------------
##Zwei neue Datensätze AB 2013
data.land <- data.zh %>% filter(StichtagDatJahr>=2013 & !is.na(ZuzLandHistLang) & !ZuzLandHistLang %in% c("Schweiz","Europa", "Unzuteilbar"))
data.kanton <- data.zh %>% filter(StichtagDatJahr>=2013 & !is.na(ZuzKtHistLang) & !ZuzKtHistLang %in% c("Ausland", "Schweiz Unbekannt","Unbekannt"))
#--------------------------------------------------------------------------------------------------------------------------------------------
#Ausländische Zuzüger
##ZuLand
#Enthält Daten zu:
#Anteil Singles pro Zuzugsland seit 2013
#Geschlecht der Singles pro Zuzugsland seit 2013
#Wie viele Zuzüger?
length(unique(data.kanton$PersNum[data.kanton$singles==1 ]))/length(unique(data.kanton$PersNum))*100
length(unique(data.kanton$PersNum[data.kanton$singles==1]))
length(unique(data.land$PersNum[data.land$singles==1]))/length(unique(data.land$PersNum))*100
length(unique(data.land$PersNum[data.land$singles==1]))
#Durchschnittsalter der Zuzüger?
Land.alter <- data.land %>% filter(singles==1 & AlterV05Kurz%in%c("25-29","30-34","35-39","40-44","45-49","50-54"))
Kanton.alter <- data.kanton %>% filter(singles==1 & AlterV05Kurz%in%c("25-29","30-34","35-39","40-44","45-49","50-54"))
4626+3031+1353+606+338+189
ak <- as.data.table(table(Kanton.alter$AlterV05Kurz))
ak <- ak[ak$N > 0]
ak$proz <- 100*ak$N/sum(ak$N)
ak
lk <- as.data.table(table(Land.alter$AlterV05Kurz))
lk <- lk[lk$N > 0]
lk$proz <- 100*lk$N/sum(lk$N)
lk
ZuzAlter <- merge(lk, ak, by = "V1")
ZuzAlter <- setNames(ZuzAlter, c("Alter", "nLand", "pLand", "nKanton", "pKanton"))
#
ZuLand1 <- expand.grid(Land =unique(data.land$ZuzLandHistLang), Geschlecht = unique(data.land$SexCd))
ZuLand1$proz <- NA
ZuLand1$total <- NA
ZuLand1$singles <- NA
Land.z <- sort(unique(data.land$ZuzLandHistLang))
##Loop Zu1.2
#rechnet Anteil an Singles der zuzüger: Bsp. vieviele % der deutschen zuzüger sind Singles?
for (i in Land.z){
l <- length(unique(data.land$PersNum[data.land$ZuzLandHistLang==i & data.land$singles==1 & data.land$SexCd==1]))
l1 <- length(unique(data.land$PersNum[data.land$ZuzLandHistLang==i & data.land$SexCd==1]))
l2 <- length(unique(data.land$PersNum[data.land$ZuzLandHistLang==i & data.land$singles==1 & data.land$SexCd==2]))
l3 <- length(unique(data.land$PersNum[data.land$ZuzLandHistLang==i & data.land$SexCd==2]))
ZuLand1$proz[ZuLand1$Land==i & ZuLand1$Geschlecht==1] <- round(100*l/(l1), digits = 2)
ZuLand1$proz[ZuLand1$Land==i & ZuLand1$Geschlecht==2] <- round(100*l2/(l3), digits = 2)
ZuLand1$total[ZuLand1$Land==i & ZuLand1$Geschlecht==1] <- l1
ZuLand1$total[ZuLand1$Land==i & ZuLand1$Geschlecht==2] <- l3
ZuLand1$singles[ZuLand1$Land==i & ZuLand1$Geschlecht==1] <- l
ZuLand1$singles[ZuLand1$Land==i & ZuLand1$Geschlecht==2] <- l2
}
ZuLand1
#Alle Beobachtungen entfernen die unter Schwellenwert sind:
#Bosnien und Herzegowina, Mazedonien, Kroatien, Sri Lanka
ZuLand2 <- ZuLand1[ZuLand1$total>250,]
#Für Rang muss Datensatz sortiert werden
ZuLand2$Land <- as.character(ZuLand2$Land)
ZuLand2 <- arrange(ZuLand2, desc(ZuLand2$total))
ZuLand2$Land <- factor(ZuLand2$Land, levels=unique(ZuLand2$Land))
ZuLand2
#--------------------------------------------
#Beliebteste Quartiere bei ausländischen Zuzügern
ZuLandQuart <- as.data.frame(table(data.land$QuarLang, data.land$singles))
#Für Rang muss Datensatz sortiert werden
ZuLandQuart$Var1 <- as.character(ZuLandQuart$Var1)
ZuLandQuart <- arrange(ZuLandQuart, desc(ZuLandQuart$Freq))
ZuLandQuart$Var1 <- factor(ZuLandQuart$Var1, levels=unique(ZuLandQuart$Var1))
#Rangliste ausländische Zuzüger
#Singles
head(ZuLandQuart[ZuLandQuart$Var2==1,], 3)
#Nicht Singles
head(ZuLandQuart[ZuLandQuart$Var2==0,], 3)
#--------------------------------------------------------------------------------------------------------------------------------------------
#Schweizer Zuzüger
##ZuKant1
#Enthält Daten zu:
#Anteil Singles pro Zuzugskanton seit 2013
ZuKant1 <- expand.grid(Kanton =unique(data.kanton$ZuzKtHistLang), Geschlecht = unique(data.kanton$SexCd), Jahr = unique(data.kanton$StichtagDatJahr))
ZuKant1$proz <- NA
ZuKant1$total <- NA
ZuKant1$singles <- NA
Kanton.k <- sort(unique(data.kanton$ZuzKtHistLang))
Jahr.k <- unique(data.kanton$StichtagDatJahr)
##Loop Zu1.2
#rechnet Anteil an Singles der zuzüger: Bsp. vieviele % der deutschen zuzüger sind Singles?
for (i in Kanton.k){
for (j in Jahr.k){
l <- length(unique(data.kanton$PersNum[data.kanton$ZuzKtHistLang==i & data.kanton$StichtagDatJahr==j & data.kanton$singles==1 & data.kanton$SexCd==1]))
l1 <- length(unique(data.kanton$PersNum[data.kanton$ZuzKtHistLang==i & data.kanton$StichtagDatJahr==j & data.kanton$SexCd==1]))
l2 <- length(unique(data.kanton$PersNum[data.kanton$ZuzKtHistLang==i & data.kanton$StichtagDatJahr==j & data.kanton$singles==1 & data.kanton$SexCd==2]))
l3 <- length(unique(data.kanton$PersNum[data.kanton$ZuzKtHistLang==i& data.kanton$StichtagDatJahr==j & data.kanton$SexCd==2]))
ZuKant1$proz[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==1] <- round(100*l/(l1), digits = 2)
ZuKant1$proz[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==2] <- round(100*l2/(l3), digits = 2)
ZuKant1$total[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==1] <- l1
ZuKant1$total[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==2] <- l3
ZuKant1$singles[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==1] <- l
ZuKant1$singles[ZuKant1$Kanton==i & ZuKant1$Jahr==j & ZuKant1$Geschlecht==2] <- l2
}
}
#Alle Beobachtungen entfernen die unter Schwellenwert sind
#Appenzell Innerrhoden,Appenzell Ausserrhoden, Glarus, Jura, Uri, Nidwalden, Obwalden, Neuchâtel
ZuKant2 <- ZuKant1 %>% filter(!Kanton %in% c("Appenzell Innerrhoden","Appenzell Ausserrhoden", "Glarus", "Jura", "Uri", "Nidwalden", "Obwalden", "Neuchâtel" ))
#Für Rang muss Datensatz sortiert werden
ZuKant2$Kanton <- as.character(ZuKant2$Kanton)
ZuKant2 <- arrange(ZuKant2, desc(ZuKant2$proz))
ZuKant2$Kanton <- factor(ZuKant2$Kanton, levels=unique(ZuKant2$Kanton))
ZuKant2
#--------------------------------------------
#Beliebteste Quartiere bei schweizer Zuzügern
ZuKantQuart <- as.data.frame(table(data.kanton$QuarLang, data.kanton$singles))
#Für Rang muss Datensatz sortiert werden
ZuKantQuart$Var1 <- as.character(ZuKantQuart$Var1)
ZuKantQuart <- arrange(ZuKantQuart, desc(ZuKantQuart$Freq))
ZuKantQuart$Var1 <- factor(ZuKantQuart$Var1, levels=unique(ZuKantQuart$Var1))
#Rangliste ausländische Zuzüger
#Singles
head(ZuKantQuart[ZuKantQuart$Var2==1,], 3)
#Nicht Singles
head(ZuKantQuart[ZuKantQuart$Var2==0,], 3)
#--------------------------------------------------------------------------------------------------------------------------------------------
###SINGLES 2013- VERHEIRATET 2016?
##HAUSHALTSTYP
#--------------------------------------------------------------------------------------------------------------------------------------------
#Datensatz mit allen, die 2013 Single waren
data.Singles.2013 <- data.zh %>% filter((StichtagDatJahr==2013 & singles==1)) %>% select(PersNum)
#Datensatz alle Personen von 3013-2016
data.Singles.2016 <- data.zh %>% filter(StichtagDatJahr>=2013) %>% select(PersNum, AlterV05Kurz, SexCd, StichtagDatJahr, Ziv2Lang, AufArt2Lang, QuarLang, HHtypLang)
#mergen der Datensätze, so dass nur die Personen übrig bleiben, die 2013 Single waren
data.Singles <- merge(data.Singles.2013, data.Singles.2016, by = "PersNum", incomparables = NULL)
#Leere Werte bei Haushaltstyp entfernen
data.Singles.hh <- data.Singles %>% filter(HHtypLang !="")
#--------------------------------------------------------------------------------------------------------------------------------------------
##Wohntyp1
#Enthält Daten zu:
#Anteil Singles pro Wohnungstyp ab 2013
Wohntyp1 <- expand.grid(Haushaltstyp =unique(data.Singles.hh$HHtypLang),Jahr = as.character(c(2013, 2014, 2015, 2016)))
Wohntyp1$proz <- NA
Wohntyp1$total <- NA
Jahr.w<- sort(unique(Wohntyp1$Jahr))
Haushalt.w <- sort(unique(Wohntyp1$Haushaltstyp))
##Loop für Wh1.2
for (i in Haushalt.w){
for (j in Jahr.w){
z <- length(unique(data.Singles.hh$PersNum[data.Singles.hh$StichtagDatJahr==j]))
z1 <- length(unique(data.Singles.hh$PersNum[data.Singles.hh$HHtypLang==i & data.Singles.hh$StichtagDatJahr==j]))
Wohntyp1$proz[Wohntyp1$Haushaltstyp==i & Wohntyp1$Jahr==j] <- round(100*z1/(z), digits = 1)
Wohntyp1$total[Wohntyp1$Haushaltstyp==i & Wohntyp1$Jahr==j] <- z1
}
}
Wohntyp1
#____________________________________________________________________________________________________________________________________________
#TEIL 2. - KARTE
#____________________________________________________________________________________________________________________________________________
#--------------------------------------------------------------------------------------------------------------------------------------------
### KARTE MIT SINGLES PRO QUARTIER
##Datensatz Karte1
#--------------------------------------------------------------------------------------------------------------------------------------------
# Singels in % Karte der zürcher Stadquartiere
#Geojson Dokument herunterladen und Encoding Problem lösen
url <- "https://data.stadt-zuerich.ch/dataset/statistisches_quartier/resource/c837926e-035d-48b9-8656-03f1b13c323b/download/statistischequartiere.json"
download.file(url, destfile = "temp.geojson")
utf8 <- readr::read_lines('temp.geojson')
native <- enc2native(utf8)
writeLines(native, 'native.geojson')
#Geojson einlesen
Quart1 <- geojsonio::geojson_read(x = "native.geojson", what = "sp", stringsAsFactors = F)
str(Quart1@data$qnr)
table(Quart1@data$qname)
# Prozentzahlen den entsprechenden Quartieren zuordnen
Karte2 <- Karte1 %>% mutate(überzahl = ifelse(prozMänner>50.00, "Männer", "Frauen"), prozMänner = round(prozMänner, digits=1),
proz = round(proz, digits = 1)) %>% select(Quartier, proz , überzahl, prozMänner)
Karte2$qname <- as.factor(Karte2$Quartier)
Karte2$Quartier <- NULL
Karte3 <- sp::merge(Quart1@data, Karte2, by = "qname", duplicateGeoms = FALSE)
Karte3$qnr <-as.character(Karte3$qnr)
Karte3
Karte4 <- Karte3 %>% select(qnr, proz, überzahl, prozMänner)
Karte4
#Prozent Zahlen auf Geojson Datei übertragen
Quart1@data <- plyr::join(Quart1@data, Karte4, by = "qnr")
str(Quart1@data$proz)
#Karte der Singles
#Farbpalette vorgeben
b <- rev(heat.colors(18, alpha = 1))
pal <- colorNumeric(b, NULL, domain = c(0, 20))
#Karte erstellen
map1 <- leaflet::leaflet(data = Quart1, options = leafletOptions(minZoom = 11, maxZoom = 15)) %>%
addPolygons(stroke = T, color = "black", smoothFactor = 0.2, fillOpacity = 0.8, weight =1, fillColor = ~pal(Quart1@data$proz),
label = ~paste0(Quart1@data$qname, ": Singles: ", formatC(Quart1@data$proz, big.mark = ",")," % davon Männer: ", formatC(Quart1@data$prozMänner, big.mark = ","), "%")
) %>%
addLegend(pal = pal, values = ~Quart1@data$proz, opacity = 1.0, title = "Anteil Singles (in %)",
labFormat = labelFormat(transform = function(x) round(x, digits = 2))) %>%
addMiniMap(position = "bottomleft", zoomLevelFixed = 8)
map1
#Koordinaten der Quartiere für ICONS herausfiltern
centroids <- as.data.frame(coordinates(Quart1), Quart1@data$qname)
setDT(centroids, keep.rownames = TRUE)[]
centroids <-setNames(centroids,c("qname", "lng", "lat"))
centroids <- merge(centroids, Karte3, by="qname")
df <- sp::SpatialPointsDataFrame(
cbind(centroids$lng,
centroids$lat
),
data.frame(type = factor(
ifelse(centroids$überzahl=="Männer", "male", "female"),
c("male", "female")
), centroids$qnr)
)
#Koordinaten als Daten ins JSON einfügen
Quart1@data <- merge(Quart1@data, df, by.x = "qnr", by.y= "centroids.qnr")
str(Quart1@data)
#ICONS herunterladen
leafIcons <- icons(
iconUrl = ifelse(Quart1@data$type=="female",
"http://icons.iconarchive.com/icons/iconka/buddy/128/devil-female-icon.png",
"http://icons.iconarchive.com/icons/iconka/buddy/128/dandy-man-icon.png"
),
iconWidth = 24, iconHeight = 24,
iconAnchorX = 24, iconAnchorY = 24)
#Legende für ICONS
html_legend <- ("weibliche Singles > 50%
männliche Singles > 50%")
map2 <- map1 %>%
addMarkers(lat=~Quart1@data$coords.x2, lng=~Quart1@data$coords.x1, icon = ~leafIcons[Quart1@data$type]) %>%
addControl(html = html_legend, position = "bottomright")
map2
map2 %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE))
#In Blog integrieren
saveWidget(map2, "SinglesKarteV1.html")
#http://stla.github.io/stlapblog/posts/rsm3Dshiny.html
# Karte als JPEG speichern
#webshot::install_phantomjs()
saveWidget(map2, "SinglesKarteV2.html", selfcontained = TRUE, background = "white")
webshot("SinglesKarteV2.html", file = "SinglesKarteV1.png", cliprect = "viewport", vwidth = 880, vheight = 500,zoom = 1)
#------------------------------------------------------------------------------------------------------
library(leaflet)
library(shiny)
?actionButton
ui <- fluidPage(
leafletOutput("mymap",width = "900", height = "600"),
p()
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
map2 %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE))
})
}
shinyApp(ui, server)
runApp("app.r")
#------------------------------------------------------------------------------------------------------
#____________________________________________________________________________________________________________________________________________
#TEIL 3. - PLOTS
#____________________________________________________________________________________________________________________________________________
#--------------------------------------------------------------------------------------------------------------------------------------------
### Verteilung Alter und Geschlecht der Singles pro Quartier
##Datensatz: AltSex
#--------------------------------------------------------------------------------------------------------------------------------------------
#Daten ordnen für ggplot
AltSex1 <- AltSex
AltSex1$Geschlecht <- recode(AltSex1$Geschlecht, "'1'='Männer'; '2'='Frauen'")
AltSex1$Alter <- factor(AltSex1$Alter,
levels = c('25-29','30-34', '35-39', '40-44', '45-49', '50-54'),ordered = TRUE)
#mean pro Quartier und geschlecht
AltSex2 <- AltSex1 %>%
group_by(Quartier, Geschlecht) %>%
summarise(Mean=round(mean(Anzahl), digits = 0))
#ACHTUNG plyr deakrivieren
AltSex3 <- merge(AltSex1, AltSex2, by = c("Quartier", "Geschlecht"))
#Aufteilen in grosse und kleine Quartiere
Quartier.gross <- unique(AltSex3$Quartier[AltSex3$Population>1000])
AltSex3$QuartierG <- ifelse(AltSex3$Quartier %in% Quartier.gross, 1,0)
#drei Quartiere müssen entfernt werden (unter 250 Singles)
AltSex4 <- AltSex3 %>% filter(!Quartier %in% c("City", "Lindenhof", "Hochschulen"))
AltSex.G <- AltSex4 %>% filter(QuartierG==1)
AltSex.K <- AltSex4 %>% filter(QuartierG==0 )
#Interval festlegen
start1<- -300
end1 <- 300
intervals1 <- c(100, 100, 100, 100, 100, 100)
breaksy1 <- c(start1 + cumsum(c(0, intervals1)), end1)
#Plot für grosse Quartiere
P.alter.G <-ggplot(data = AltSex.G, mapping = aes(x = Alter, fill = as.character(Geschlecht), y = ifelse(test = Geschlecht=="Männer", yes = -Anzahl, no = Anzahl))) +
geom_bar(stat = "identity") +
geom_hline(aes(yintercept= ifelse(test = Geschlecht=="Männer", yes = -Mean, no = Mean)), color = "red") +
scale_y_continuous(labels = abs, limits = max(AltSex.G$Anzahl) * c(-1,1), breaks= breaksy1) +
scale_fill_manual(values=c('Männer'='gold', 'Frauen'='darkorange1'), name ="Geschlecht")+
coord_flip() + labs(y=NULL)+
facet_wrap(~Quartier, scales='free') +
theme_classic()+
theme(legend.position=(c(0.8, 0.1)),
legend.text = element_text(size = 13,face='bold'),
panel.grid.major.x = element_line(colour="gray", size=0.5, linetype ="dotdash"),
axis.title.y = element_text(size=13, face='bold'),
axis.text.x = element_text(),
axis.text.y = element_text(),
axis.ticks.y = element_blank(),
axis.line.y=element_blank(),
legend.title=element_blank(),
strip.text=element_text(size = 13,face='bold'),
strip.background = element_rect(fill="orange"))
P.alter.G
#Plot für kleine Quartiere
P.alter.K <- ggplot(data = AltSex.K, mapping = aes(x = Alter, fill = as.character(Geschlecht), y = ifelse(test = Geschlecht=="Männer", yes = -Anzahl, no = Anzahl))) +
geom_bar(stat = "identity") +
geom_hline(aes(yintercept= ifelse(test = Geschlecht=="Männer", yes = -Mean, no = Mean)), color = "red") +
scale_y_continuous(labels = abs, limits = max(AltSex.K$Anzahl) * c(-1,1), breaks = breaksy1/2) +
scale_fill_manual(values=c('Männer'='gold', 'Frauen'='darkorange1'), name ="Geschlecht")+
coord_flip() + labs(y=NULL)+
facet_wrap(~Quartier, scales='free') +
theme_classic()+
theme(legend.position=(c(0.8, 0.1)),
legend.text = element_text(size = 13,face='bold'),
panel.grid.major.x = element_line(colour="gray", size=0.5, linetype ="dotdash"),
axis.title.y = element_text(size=13, face='bold'),
axis.text.x = element_text(),
axis.text.y = element_text(),
axis.ticks.y = element_blank(),
axis.line.y=element_blank(),
legend.title=element_blank(),
strip.text=element_text(size = 13,face='bold'),
strip.background = element_rect(fill="orange"))
P.alter.K
#Plot als Bild
ggsave("1P.Alter.K.png",plot= P.alter.K, width = 35, height = 25, units = "cm")
ggsave("1P.Alter.G.png",plot= P.alter.G, width = 35, height = 25, units = "cm")
#--------------------------------------------------------------------------------------------------------------------------------------------
### Herkunft der Singles 1
##Datensatz: ZuLand2
#--------------------------------------------------------------------------------------------------------------------------------------------
#kleine Länder müssen entfernt werden (zu wenig singles)
ZuLand3 <- ZuLand2 %>% filter(!Land %in% c("Türkei", "Serbien", "Portugal", "Brasilien", "Ozeanien", "Afrika"))
ZuLand3$Geschlecht <- recode(ZuLand3$Geschlecht, "'1'='Männer'; '2'='Frauen'")
#Intervall für y-Achse
start<- 0
end <- 6000
intervals <- c(400,400,400,400,400,400,400,400,400,400,400,400,400,400)
breaksy <- c(start + cumsum(c(0, intervals)), end)
#Normaler ggplot: Barchart
p11 <- ggplot(data=ZuLand3, aes(x=Land, y=total, fill= Geschlecht)) +
geom_bar(stat="identity", position="dodge") +
geom_text(aes(label = sprintf('%0.1f %%', as.numeric(proz)), y= total*0.1), position = position_dodge(width = 1)) +
scale_y_continuous(limits=c(0, 8000), breaks = seq(0, 9000, 2000), minor_breaks = breaksy)+
scale_x_discrete(expand=c(0, 1))+
scale_fill_manual(values = c('Männer'='gold','Frauen'='darkorange1'))+
labs(x=NULL)
#Änderung Hintergrund und Schrift
P.Zuzug.Land <- p11 + theme_classic() + theme(legend.position=(c(0.5, 0.8)),
legend.text = element_text(size=13, face='bold'),
legend.title = element_blank(),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.25, size=13, face = 'bold'),
axis.text.y = element_text(size=13, face='bold'),
axis.line.y=element_blank(),
axis.title.y = element_blank(),
strip.text=element_text(size = 13,face='bold'),
strip.background=element_rect(fill='#eeeeee', color=NA),
panel.grid.minor = element_line(colour = "gray",size=0.5),
panel.grid.major = element_line(color=NA))
#Resultat
P.Zuzug.Land
ggsave("1P.Zuzug.Land.png",plot= P.Zuzug.Land, width = 40, height = 30, units = "cm")
#--------------------------------------------------------------------------------------------------------------------------------------------
### Herkunft der Singles 2
##Datensatz: ZuKant2
#--------------------------------------------------------------------------------------------------------------------------------------------
ZuKant2$Jahr <- as.numeric(ZuKant2$Jahr)
ZuKant2$Geschlecht <- recode(ZuKant2$Geschlecht, "'1'='Männer'; '2'='Frauen'")
ZuKant.F <- ZuKant2 %>% filter(Geschlecht==2)
ZuKant.M <- ZuKant2 %>% filter(Geschlecht==1)
#Plot Kantone
P.Kantone <- ggplot2::ggplot(data = ZuKant2, aes(x = Jahr, shape = Geschlecht)) +
geom_line(aes(x=Jahr, y=proz, group=Geschlecht,color=Geschlecht),lwd=1) +
scale_color_manual(values=c("Männer"="#FFB600FF", "Frauen"="#FF8000FF"))+
geom_point(aes(y = proz)) +
facet_wrap(facets = ~Kanton)+
scale_y_continuous(limits=c(0, 24), expand=c(+0.2, 0)) +
scale_x_continuous(breaks = unique(ZuKant2$Jahr), expand=c(0.12, 0.5)) +
labs(x=NULL, y="Prozent") +
theme_classic() + theme(legend.position=c(0.8, 0.1),
legend.text = element_text(size=13, face='bold'),
legend.title = element_blank(),
axis.line.y=element_blank(),
axis.ticks.y=element_line(),
axis.text.y=element_text(size=13, face='bold'),
axis.title.y = element_text(size=13, face='bold'),
axis.text.x=element_text(angle = 90, vjust = 0.25, size=12, face='bold'),
strip.text=element_text(size=13, face='bold'),
strip.background=element_rect(fill="orange"),
panel.grid.major.y = element_line(colour = "gray",size=0.5),
panel.spacing.x = unit(0.25, 'in'),
panel.spacing.y = unit(0.25, 'in')
)
P.Kantone
ggsave("1P.Kantone2.png",plot= P.Kantone, width = 40, height = 30, units = "cm")
#--------------------------------------------------------------------------------------------------------------------------------------------
### Wie Alt sind die Zuzüger im Schnitt
##Datensatz: ZuzAlter
#--------------------------------------------------------------------------------------------------------------------------------------------
ZuzAlter
ggplot(ZuzAlter, aes(x=Alter, y=pLand, fill=pKanton))+
geom_bar(stat = "identity", position="dodge")
ggplot(ZuzAlter, aes(x=Alter, y=pLand, fill=pLand))+
geom_bar(stat = "identity", position="dodge")
#--------------------------------------------------------------------------------------------------------------------------------------------
### Was passiert mit den Singles?
##Datensatz: Wohntyp1 und Zivilstand1
#--------------------------------------------------------------------------------------------------------------------------------------------
#Für Rang muss Datensatz sortiert werden
Wohntyp1$Haushaltstyp <- as.character(Wohntyp1$Haushaltstyp)
Wohntyp1 <- arrange(Wohntyp1, desc(Wohntyp1$proz))
Wohntyp1$Haushaltstyp <- factor(Wohntyp1$Haushaltstyp, levels=unique(Wohntyp1$Haushaltstyp))
Wohntyp1
Wohntyp2 <- Wohntyp1
Wohntyp2$rang <- as.numeric(recode(Wohntyp2$Jahr, "2013=1 ; 2014=2 ; 2015=3 ; 2016=4"))
#Plot Kantone Männer
P.Wohnen <- ggplot2::ggplot(Wohntyp2, aes(x = reorder(Jahr, -rang), y = proz, fill=Haushaltstyp, width=0.8)) +
geom_bar(stat="identity", position = position_dodge(width = 1))+
geom_text(aes(label = paste0(ifelse(proz>0, proz, ""), ifelse(proz>0, "%", "")), y=0),
check_overlap = TRUE, position = position_dodge(width = 1), hjust = 1.5, size = 4)+
scale_fill_manual(values =c("#FFDB0099","#FF000099", "#FF140099", "#FF270099", "#FF3B0099",
"#FF4E0099", "#FF620099", "#FF760099", "#FF890099", "#FF9D0099", "#FFB10099"))+
scale_y_continuous(expand = c(0.05,0))+
coord_flip()+
labs(x=NULL, y=NULL) + guides(fill = guide_legend(reverse=TRUE)) +
theme_classic() + theme(legend.position=c(0.9, 0.15),
legend.text = element_text(size=13),
legend.title = element_text(size=13, face='bold'),
axis.line.y=element_blank(),
axis.ticks.y=element_blank(),
axis.text.y=element_text(size=13, angle = 90, hjust = 3.3, face='bold'),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.line.x = element_blank(),
strip.text=element_text(face='bold'),
strip.background=element_rect(fill='#eeeeee', color=NA),
panel.spacing.x = unit(0.25, 'in'),
panel.spacing.y = unit(0.25, 'in')
)
P.Wohnen
ggsave("1P.Wohnen2.png",plot= P.Wohnen, width = 40, height = 30, units = "cm")