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