#---------------------------------------------- # Name: R Skript - Eine intuitive Einführung in R # Autor: Okan Sarioglu # GitHub: Okan2022 # E-Mail: o.sarioglu@gmx.de # LinkedIn: @osarioglu #---------------------------------------------- # Dieses R Skript gehört zum Kurs "Eine intuitive Einführung in R". # Es soll dir helfen, den Code nicht nur zu lesen, sondern auch # direkt auszuführen, um dich mit R vertraut zu machen. Dieses # Skript enthält ausschließlich den Code aus dem Kurs. #------------- # Anleitung #------------- # Arbeite dieses R Skript von Anfang bis Ende durch. Du musst # nur zwei Regeln befolgen. # Die Regeln sind einfach: # Erstens: Führe diese Zeilen aus, da sie notwendig sind # (Pakete laden und Daten simulieren): #=====================FÜHRE DIESE ZEILEN ZUERST AUS============================# # Daten simulieren source( "https://raw.githubusercontent.com/Okan2022/bookdown_aiitr_de/main/script/simulating_data_aiitr.R" ) #=====================FÜHRE DIESE ZEILEN ZUERST AUS============================# # Prüfe deine Umgebung. Wenn die Nachricht # "Die simulierten Daten wurden erfolgreich geladen!" in deiner # Konsole erscheint, ist alles in Ordnung! #====================WICHTIGE NACHRICHT!!!!!===================================# # Zweitens: Du kannst nicht einzelne Codezeilen zufällig ausführen. # Das kann zu Fehlermeldungen führen. Um sicher Erfolg zu haben, # führe immer alles zwischen zwei "#------" Trennlinien aus. # Nur dann läuft der Code fehlerfrei. # Und nun viel Spaß mit dem Kurs! #----------------- # 1. Grundlagen #----------------- #------------------------------------------------------------------------------- ### Mathematische Operationen in R # Mit dem Hashtag kannst du Kommentare schreiben 1 + 1 # Addition 1 - 1 # Subtraktion 1 * 1 # Multiplikation 1 / 1 # Division 2^(1 / 2) # Gemischter Term #------------------------------------------------------------------------------- ### Vergleichsoperatoren 1 < 3 # TRUE 5 >= 8 # FALSE 11 != 10 # TRUE 22 == 22 # TRUE 7 < 3 # FALSE 5 <= 2 + 3 # TRUE #------------------------------------------------------------------------------- ### Logische Operatoren (&, |, !) 5 & 4 < 8 # TRUE 5 | 4 < 8 # TRUE !5 > 2 # FALSE #------------------------------------------------------------------------------- ### Verwendung von Funktionen sqrt(x = 36) # Quadratwurzel exp(x = 0) # Exponentialfunktion print("Über 7 Brücken musst du gehen") # beliebigen Text ausgeben #------------------------------------------------------------------------------- ### Hilfe holen ?exp() # Fragezeichen-Methode help(exp) # help-Funktion #------------------------------------------------------------------------------- ### Objekte zuweisen und ausgeben Pizza <- 7.50 # Objekt Pizza Cola <- 3.50 # Objekt Cola Pizza + Cola # Addition der Objekte #------------------------------------------------------------------------------- Angebot <- Pizza + Cola # Summe speichern Angebot # Objekt ausgeben Angebot^2 # Term quadrieren #------------------------------------------------------------------------------- ### Vektoren essen <- c("Pizza", "Kebab", "Curry", "Fish", "Burrito") # Lebensmittel-Vektor print(essen) preise <- c(7.50, 6.00, 8.50, 3.00, 11.00) # Preis-Vektor print(preise) cola_preise <- c(3.50, 3, 4, 2.50, 3) # Cola-Preise print(cola_preise) #------------------------------------------------------------------------------- preise_kombiniert <- preise + cola_preise # Preise addieren print(preise_kombiniert) #------------------------------------------------------------------------------- ### Objekt-Klassen # Klassen überprüfen class(preise) class(essen) class(cola_preise) #------------------------------------------------------------------------------- # Klasse einer Variable ändern cola_preise_character <- as.character(cola_preise) # Überprüfen class(cola_preise_character) print(cola_preise_character) #------------------------------------------------------------------------------- ### Matrizen erstellen # Spalten zusammenfügen preis_index <- cbind(essen, preise, cola_preise) print(preis_index) # Zeilen zusammenfügen preis_index2 <- rbind(essen, preise, cola_preise) print(preis_index2) #------------------------------------------------------------------------------- # Matrix simulieren matrix_beispiel <- matrix(1:20, nrow = 4, ncol = 5, byrow = T) # Überprüfen print(matrix_beispiel) dim(matrix_beispiel) # Was passiert, wenn byrow = FALSE? matrix_beispiel2 <- matrix(1:20, nrow = 4, ncol = 5, byrow = F) print(matrix_beispiel2) dim(matrix_beispiel2) #------------------------------------------------------------------------------- ### Arbeiten mit Matrizen zeile <- 1 spalte <- 1 # Ausgeben lassen print(objekt1 <- matrix_beispiel[zeile, ]) # erste Zeile print(objekt2 <- matrix_beispiel[, spalte]) # erste Spalte print(objekt3 <- matrix_beispiel[zeile, spalte]) # Wert in erster Zeile, erster Spalte print(matrix_beispiel) #------------------------------------------------------------------------------- # Mehr Informationen nrow(matrix_beispiel) # Wie viele Zeilen ncol(matrix_beispiel) # Wie viele Spalten dim(matrix_beispiel) # Dimensionen #------------------------------------------------------------------------------- ### Data Frames # Beispiel-DataFrame erstellen df_beispiel <- data.frame( land = c("Österreich", "England", "Brasilien", "Deutschland"), hauptstadt = c("Wien", "London", "Brasilia", "Berlin"), bev = c(9.04, 55.98, 215.3, 83.8), europa = c(TRUE, FALSE, TRUE, TRUE) ) # Überprüfen print(df_beispiel) #------------------------------------------------------------------------------- # Spalten aufrufen df_beispiel$land # Einzelne Beobachtung aufrufen df_beispiel$land[3] # Bedingung auf einen DataFrame anwenden df_beispiel$land[df_beispiel$bev > 60] #------------------------------------------------------------------------------- ### If-Else-Statements mit einer Bedingung note <- 1.7 if (note < 2) { print("Gute Arbeit") } # if(Testausdruck), dann {Körperausdruck} note <- 2.5 if (note < 2) { print("Gute Arbeit") } # Da die Bedingung nicht erfüllt ist, passiert nichts #------------------------------------------------------------------------------- ### If-Anweisungen mit else-Bedingung note <- 3.3 if (note <= 2) { print("Gute Arbeit") } else { print("Das Leben geht weiter") } note <- 1.3 if (note <= 2) { print("Gute Arbeit") } else { print("Das Leben geht weiter") } #------------------------------------------------------------------------------- ### Der ifelse()-Befehl ifelse(note <= 2, "Gute Arbeit", "Leben geht weiter") #------------------------------------------------------------------------------- ### If-Else-Ketten / mehrere Bedingungen note <- 3.3 if (note == 1.0) { print("Stark") } else if (note > 1.0 & note <= 2.0) { print("Gute Arbeit") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Leben geht weiter") } else { print("Kein passender Ausdruck gefunden") } note <- 1.7 if (note == 1.0) { print("Stark") } else if (note > 1.0 & note <= 2.0) { print("Gute Arbeit") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Leben geht weiter") } else { print("Kein passender Ausdruck gefunden") } note <- 5.0 if (note == 1.0) { print("Stark") } else if (note > 1.0 & note <= 2.0) { print("Gute Arbeit") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Leben geht weiter") } else { print("Kein passender Ausdruck gefunden") } #------------------------------------------------------------------------------- ### Verschachtelte ifelse() note <- 1.7 ifelse(note == 1.0, "Amazing", ifelse(note > 1 & note <= 2, "Good Job", ifelse(note > 2 & note <= 3, "OK", ifelse(note > 3 & note <= 4, "Life goes on", "No expression found" ) ) ) ) note <- 3.3 ifelse(note == 1.0, "Amazing", ifelse(note > 1 & note <= 2, "Good Job", ifelse(note > 2 & note <= 3, "OK", ifelse(note > 3 & note <= 4, "Life goes on", "No expression found") ) ) ) # Logik: ifelse(Testausdruck, Ausdruck wenn wahr, ifelse(Testausdruck 2, ...)) #---------------------- # 2. Datenmanipulation #---------------------- #------------------------------------------------------------------------------- ### Pakete laden if (!require("pacman")) install.packages("pacman") pacman::p_load("tidyverse", "psych", "gapminder") #------------------------------------------------------------------------------- ### Die ESS-Daten # Der simulierte ESS-Datensatz ist bereits durch source() geladen. # Werfen wir einen Blick darauf: head(ess) #------------------------------------------------------------------------------- ### Pipelines / Piping # Vektor mit drei zufälligen Zahlen q <- c(6, 3, 8) # Erst Mittelwert, dann Exponent, dann Wurzel — verschachtelt sqrt(exp(mean(q))) # Mit einer Pipe q %>% mean() %>% exp() %>% sqrt() #------------------------------------------------------------------------------- ### Die filter()-Funktion: eine Bedingung # Nur Fälle aus Ungarn filtern d1 <- ess %>% filter(cntry == "HU") head(d1) # Nur Teilnehmende unter 40 behalten d2 <- ess %>% filter(agea <= 40) head(d2) #------------------------------------------------------------------------------- ### Die filter()-Funktion: mehrere Bedingungen # Fälle aus Ungarn und Frankreich filtern d1 <- ess %>% filter(cntry %in% c("HU", "FR")) head(d1) # Fälle unter 40 aus Ungarn und Frankreich filtern d2 <- ess %>% filter(cntry %in% c("HU", "FR") & agea <= 40) head(d2) #------------------------------------------------------------------------------- ### Die select()-Funktion # Relevante Variablen auswählen d1 <- ess %>% select(year, cntry, happy, agea, gndr, eisced) head(d1) # Spalten durch ein vorangestelltes Minus löschen d2 <- d1 %>% select(-agea) head(d2) #------------------------------------------------------------------------------- ### select() mit filter() kombinieren d1 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) head(d1) #------------------------------------------------------------------------------- ### Die arrange()-Funktion # Aufsteigend sortieren d1 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(agea) head(d1) # Absteigend sortieren d1 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(desc(agea)) head(d1) #------------------------------------------------------------------------------- ### rename() und relocate() # Variablen umbenennen d1 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(desc(agea)) %>% rename(land = cntry, alter = agea, bildungsstand = eisced, weiblich = gndr) head(d1) #------------------------------------------------------------------------------- # Variablen neu anordnen d1 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(desc(agea)) %>% rename(land = cntry, alter = agea, bildungsstand = eisced, weiblich = gndr) %>% relocate(bildungsstand, alter, weiblich, land, happy, year) head(d1) # Nach einer Spalte verschieben d2 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(desc(agea)) %>% rename(land = cntry, alter = agea, bildungsstand = eisced, weiblich = gndr) %>% relocate(land, .after = alter) head(d2) # Vor eine Spalte verschieben d3 <- ess %>% filter(agea < 40) %>% select(year, cntry, happy, agea, gndr, eisced) %>% arrange(desc(agea)) %>% rename(land = cntry, alter = agea, bildungsstand = eisced, weiblich = gndr) %>% relocate(land, .before = alter) head(d3) #------------------------------------------------------------------------------- ### Die mutate()-Funktion # Variablen mutieren d1 <- ess %>% mutate(happy_10 = happy * 10) head(d1) #------------------------------------------------------------------------------- # Weiteres Mutieren d2 <- ess %>% mutate(neue_variable = happy * 10 / eisced + 67, weiblich_char = as.character(gndr)) %>% select(weiblich_char, neue_variable) # Überprüfen head(d2) #------------------------------------------------------------------------------- ### Rekodieren mit mutate() und recode() # Überblick über die Variable table(ess$happy) # Variablen rekodieren d1 <- ess %>% mutate( gndr_fac = as.factor(gndr), happy_cat = dplyr::recode(happy, `1` = 0, `2` = 0, `3` = 0, `4` = 0, `5` = 1, `6` = 2, `7` = 2, `8` = 2, `9` = 2, `10` = 2, `77` = NA_real_, `88` = NA_real_, `99` = NA_real_), weiblich = dplyr::recode(gndr_fac, `1` = "männlich", `2` = "weiblich", `9` = NA_character_)) # Ergebnis prüfen table(d1$happy_cat) table(d1$weiblich) #------------------------------------------------------------------------------- ### Rekodieren mit mutate() und case_when() d1 <- ess %>% mutate( gndr_fac = as.factor(gndr), happy_cat = case_when( happy < 5 ~ 0, happy == 5 ~ 1, happy > 5 ~ 2), weiblich = case_when( gndr == 1 ~ "männlich", gndr == 2 ~ "weiblich" )) table(d1$weiblich) table(d1$happy_cat) #------------------------------------------------------------------------------- ### Rekodieren mit mutate() und ifelse() d1 <- ess %>% mutate( gndr_fac = as.factor(gndr), happy_cat = ifelse(happy < 5, 0, ifelse(happy == 5, 1, ifelse(happy > 5, 2, NA))), weiblich = ifelse(gndr_fac == 1, "männlich", ifelse(gndr_fac == 2, "weiblich", NA)) ) table(d1$happy_cat) table(d1$weiblich) #------------------------------------------------------------------------------- ### Umgang mit fehlenden Werten # Vollständiger Workflow: filter, select, arrange, rename, mutate d1 <- ess %>% filter(agea >= 40) %>% select(year, cntry, netusoft, agea, eisced, gndr, happy) %>% arrange(desc(agea)) %>% rename( internet_nutzung = netusoft, alter = agea, bildungsstand = eisced, weiblich = gndr) %>% mutate( internet_nutzung = case_when( internet_nutzung > 5 ~ NA_real_, TRUE ~ internet_nutzung), alter = case_when( alter == 999 ~ NA_real_, TRUE ~ alter), bildungsstand = case_when( bildungsstand %in% c(55, 77, 88, 99) ~ NA_real_, TRUE ~ bildungsstand), weiblich = case_when( weiblich == 1 ~ 0, weiblich == 2 ~ 1, weiblich == 9 ~ NA_real_, TRUE ~ weiblich), happy = case_when( happy %in% c(77, 88, 99) ~ NA_real_, TRUE ~ happy) ) %>% arrange(alter) head(d1) #------------------------------------------------------------------------------- # NAs entfernen (tidyverse) d2 <- d1 %>% drop_na() colSums(is.na(d2)) # NAs entfernen (Base R) d3 <- na.omit(d1) colSums(is.na(d3)) #------------------------------------------------------------------------------- ### group_by() und summarize() — eine Gruppierung d1 <- ess %>% mutate( gndr_fac = as.factor(gndr), weiblich = case_when( gndr_fac == 1 ~ "männlich", gndr_fac == 2 ~ "weiblich", gndr_fac == 9 ~ NA_character_ )) %>% drop_na() %>% group_by(weiblich) %>% dplyr::summarize(durchschnitt_happiness = mean(happy)) head(d1) #------------------------------------------------------------------------------- ### group_by() und summarize() — mehrere Gruppierungen und Kennzahlen d1 <- ess %>% mutate( land = cntry, gndr_fac = as.factor(gndr), weiblich = case_when( gndr_fac == 1 ~ "männlich", gndr_fac == 2 ~ "weiblich", gndr_fac %in% c(77, 88, 99) ~ NA_character_), alter = case_when( agea == 999 ~ NA_real_, TRUE ~ agea) ) %>% drop_na() %>% group_by(land, weiblich) %>% dplyr::summarize(durchschnitt_happiness = mean(happy), median_happiness = median(happy), durchschnitt_alter = mean(alter), median_alter = median(alter)) head(d1) #------------------------------------------------------------------------------- ### Datensätze zusammenführen — Weltbankdaten simulieren countries <- c("BE", "BG", "CH", "EE", "FR", "GB") indicator <- c("NY.GDP.PCAP.CD", "TX.VAL.FUEL.ZS.UN", "EN.ATM.CO2E.KT") # Daten simulieren (Alternative zum Weltbank-API-Aufruf) wb <- data.frame( iso2c = c("BE", "BG", "CH", "EE", "FR", "GB"), NY.GDP.PCAP.CD = c(45587.97, 10148.34, 85897.78, 23565.18, 39179.74, 40217.01), TX.VAL.FUEL.ZS.UN = c(5.021, 4.644, 0.6111, 4.863, 1.886, 7.062), EN.ATM.CO2E.KT = c(85364.10, 34138.10, 34916.10, 7097.52, 267154.70, 308650.30) ) head(wb) # Weltbankdaten bereinigen wb <- wb %>% select(iso2c, NY.GDP.PCAP.CD, TX.VAL.FUEL.ZS.UN, EN.ATM.CO2E.KT) %>% arrange(iso2c) %>% rename(bip_pro_kopf = NY.GDP.PCAP.CD, öl_exp = TX.VAL.FUEL.ZS.UN, co2 = EN.ATM.CO2E.KT) %>% mutate(öl_exp = round(öl_exp, 2)) head(wb) #------------------------------------------------------------------------------- # ESS für das Mergen vorbereiten d1 <- ess %>% filter(cntry == c("BE", "BG", "CZ", "EE", "FI")) %>% rename(iso2c = cntry) %>% group_by(iso2c, year) %>% summarise(happy_agg = round(mean(happy), 2)) head(d1) #------------------------------------------------------------------------------- ### left_join() und right_join() mit einem Identifikator merged_data <- left_join(d1, wb, by = "iso2c") head(merged_data) merged_data2 <- right_join(d1, wb, by = "iso2c") head(merged_data2) #------------------------------------------------------------------------------- ### left_join() und right_join() mit zwei Identifikatoren # Neue Weltbank-Daten mit Jahr-Variable wb <- data.frame( iso3c = c("BEL", "BEL", "BGR", "BGR"), iso2c = c("BE", "BE", "BG", "BG"), jahr = c(2019, 2020, 2019, 2020), NY.GDP.PCAP.CD = c(46641.72, 45587.97, 9874.336, 10148.34), TX.VAL.FUEL.ZS.UN = c(7.38, 5.02, 9.53, 4.64), EN.ATM.CO2E.KT = c(92989.4, 85364.10, 39159.9, 34138.10) ) # Bereinigen wb <- wb %>% select(-iso3c) %>% arrange(iso2c) %>% rename(bip_pro_kopf = NY.GDP.PCAP.CD, öl_exp = TX.VAL.FUEL.ZS.UN, co2 = EN.ATM.CO2E.KT) %>% mutate(öl_exp = round(öl_exp, 2)) head(wb) # Daten mit Jahr zum Zusammenführen d1 <- data.frame( iso2c = c("BE", "BE", "BG", "BG", "CZ", "CZ"), jahr = c(2019, 2020, 2019, 2020, 2019, 2020), happy_agg = c(5.95, 6.76, 6.56, 7.54, 6.27, 6.88) ) head(d1) # left_join() mit zwei Identifikatoren merged_data3 <- left_join(d1, wb, by = c("iso2c", "jahr")) head(merged_data3) # right_join() mit zwei Identifikatoren merged_data4 <- right_join(d1, wb, by = c("iso2c", "jahr")) head(merged_data4) #---------------------- # 3. Datenvisualisierung #---------------------- #------------------------------------------------------------------------------- pacman::p_load("tidyverse", "babynames", "sf", "ggridges", "rnaturalearth", "rnaturalearthdata", "forcats", "tmap") #------------------------------------------------------------------------------- ### Einführung in ggplot2 ggplot() # leerer Rahmen #------------------------------------------------------------------------------- ### Histogramme — einfaches Histogramm # Überblick über data1 glimpse(data1) ggplot(data1, aes(x = wert)) + geom_histogram() #------------------------------------------------------------------------------- # Histogramm mit Farbe und Füllung ggplot(data1, aes(x = wert)) + geom_histogram(color = "white", fill = "#69b3a2") #------------------------------------------------------------------------------- # Histogramm mit Achsen-Beschriftung und Skalierung ggplot(data1, aes(x = wert)) + geom_histogram(color = "white", fill = "#69b3a2") + labs( x = "Wert", y = "Anzahl", title = "Ein Histogramm") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) #------------------------------------------------------------------------------- # Histogramm mit theme_minimal() ggplot(data1, aes(x = wert)) + geom_histogram(color = "white", fill = "#69b3a2") + labs( x = "Wert", y = "Anzahl", title = "Ein Histogramm") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) + theme_minimal() #------------------------------------------------------------------------------- ### Histogramm mit binwidth # binwidth = 0.1 ggplot(data1, aes(x = wert)) + geom_histogram(color = "white", fill = "#69b3a2", binwidth = 0.1) + labs( x = "Wert", y = "Anzahl", title = "Ein Histogramm mit binwidth = 0.1") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) + theme_minimal() # binwidth = 0.6 ggplot(data1, aes(x = wert)) + geom_histogram(color = "white", fill = "#69b3a2", binwidth = 0.6) + labs( x = "Wert", y = "Anzahl", title = "Ein Histogramm mit binwidth = 0.6") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) + theme_minimal() #------------------------------------------------------------------------------- ### Mehrere Histogramme # Zwei Histogramme in einem ggplot(data2, aes(x = wert, fill = typ)) + geom_histogram(color = "#e9ecef", position = "identity") + theme_bw() # Zwei Histogramme mit Transparenz und manuellen Farben ggplot(data2, aes(x = wert, fill = typ)) + geom_histogram(color = "#e9ecef", alpha = 0.6, position = "identity") + scale_fill_manual(values = c("#8AA4D6", "#E89149")) + theme_bw() #------------------------------------------------------------------------------- ### Dichteplots # Einfacher Dichteplot ggplot(data1, aes(x = wert)) + geom_density() # Dichteplot mit Styling ggplot(data1, aes(x = wert)) + geom_density(color = "white", fill = "orange", alpha = 0.6) + labs( x = "Wert", y = "Anzahl", title = "Ein Dichteplot") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) + theme_minimal() # Mehrere Dichteplots ggplot(data2, aes(x = wert, fill = typ)) + geom_density(color = "#0a0a0a", alpha = 0.9, position = "identity") + scale_fill_manual(values = c("#FDE725FF", "#440154FF")) + theme_minimal() #------------------------------------------------------------------------------- ### Boxplots # Einfacher Boxplot ggplot(data1, aes(x = wert)) + geom_boxplot() # Boxplot ansprechend ggplot(data1, aes(x = wert)) + geom_boxplot() + labs( x = "Wert", y = "Häufigkeit", title = "Ein Boxplot") + scale_x_continuous(breaks = seq(-4, 4, 1), limits = c(-4, 4)) + theme_classic() #------------------------------------------------------------------------------- ### Mehrere Boxplots: Einkommen nach Altersgruppe # Einfacher gruppierter Boxplot ggplot(data3, aes(x = alter, y = einkommen, fill = alter)) + geom_boxplot() # Ansprechender Boxplot mit Anpassungen ggplot(data3, aes(x = alter, y = einkommen, fill = alter)) + geom_boxplot(alpha = 0.5, width = 0.5) + scale_fill_manual(values = c("#acf6c8", "#ecec53", "#D1BC8A")) + labs( title = "Vergleich der Einkommensverteilung nach Altersgruppe", x = "Alter", y = "Einkommen" ) + theme_minimal() + theme(legend.position = "none") #------------------------------------------------------------------------------- ### Rangfolge: Barplot # Einfacher Barplot ggplot(data4, aes(x = name, y = stärke)) + geom_bar(stat = "identity") # Barplot ansprechend ggplot(data4, aes(x = name, y = stärke)) + geom_bar(stat = "identity", fill = "#AE388B") + labs( x = "", y = "Stärke", title = "Stärke fiktiver Charaktere" ) + theme_test() #------------------------------------------------------------------------------- ### Barplot zum Zählen von Kategorien ggplot(data5, aes(x = held)) + geom_bar(fill = "#AE388B") + labs( x = "", y = "Häufigkeit", title = "Wer ist dein Lieblingscharakter?" ) + scale_y_continuous(breaks = seq(0, 10, 1)) + theme_test() #------------------------------------------------------------------------------- ### Barplots drehen mit coord_flip() # Plot 1 ggplot(data4, aes(x = name, y = stärke)) + geom_bar(stat = "identity", fill = "#AE388B") + labs( x = "", y = "Stärke", title = "Stärke fiktiver Charaktere" ) + theme_test() + coord_flip() # Plot 2 ggplot(data5, aes(x = held)) + geom_bar(fill = "#AE388B") + labs( x = "", y = "Häufigkeit", title = "Wer ist dein Lieblingscharakter?" ) + scale_y_continuous(breaks = seq(0, 10, 1)) + theme_test() + coord_flip() #------------------------------------------------------------------------------- ### Sortierung mit fct_reorder() # Plot 1 — sortiert ggplot(data4, aes(x = fct_reorder(name, stärke), y = stärke)) + geom_bar(stat = "identity", fill = "#AE388B") + labs( x = "", y = "Stärke", title = "Stärke fiktiver Charaktere" ) + theme_test() # Plot 2 — sortiert und gedreht ggplot(data4, aes(x = fct_reorder(name, stärke), y = stärke)) + geom_bar(stat = "identity", fill = "#AE388B") + labs( x = "", y = "Stärke", title = "Stärke fiktiver Charaktere" ) + theme_test() + coord_flip() #------------------------------------------------------------------------------- ### Gruppierte und gestapelte Barplots # Gruppierter Barplot nebeneinander (dodge) ggplot(data6, aes(x = alter, y = wert, fill = weiblich)) + geom_bar(position = "dodge", stat = "identity") # Gestapelter Barplot (stack) ggplot(data6, aes(x = alter, y = wert, fill = weiblich)) + geom_bar(position = "stack", stat = "identity") #------------------------------------------------------------------------------- ### Barplots mit Farbpaletten # Plot 1 — dodge mit scale_fill_brewer ggplot(data6, aes(x = alter, y = wert, fill = weiblich)) + geom_bar(position = "dodge", stat = "identity", width = 0.35) + scale_fill_brewer(palette = "Accent") + scale_y_continuous(breaks = seq(0, 15, 1)) + labs( x = "Altersgruppe", y = "Durchschnittlicher Wohlbefindenswert", title = "Einfluss des Alters auf das Wohlbefinden\nnach Geschlecht" ) + theme_minimal() + theme(legend.title = element_blank()) # Plot 2 — stack mit scale_fill_brewer ggplot(data6, aes(x = alter, y = wert, fill = weiblich)) + geom_bar(position = "stack", stat = "identity", width = 0.35) + scale_fill_brewer(palette = "Accent") + scale_y_continuous(breaks = seq(0, 15, 2)) + labs( x = "Altersgruppe", y = "Durchschnittlicher Wohlbefindenswert", title = "Einfluss des Alters auf das Wohlbefinden nach Geschlecht" ) + theme_minimal() + theme(legend.title = element_blank()) #------------------------------------------------------------------------------- ### Liniendiagramme # Einfaches Liniendiagramm ggplot(data7, aes(x = datum, y = y)) + geom_line() # Liniendiagramm gestrichelt mit Anpassungen ggplot(data7, aes(x = datum, y = y)) + geom_line(color = "#0F52BA", linetype = "dashed", linewidth = 1) + scale_y_continuous(breaks = seq(-1, 6, 1), limits = c(-1, 6)) + scale_x_continuous(breaks = seq(2000, 2024, 2)) + labs( y = "", x = "Jahr", title = "Ein Liniendiagramm" ) + theme_bw() #------------------------------------------------------------------------------- ### Mehrere Linien # Zwei Linien ggplot(data7) + geom_line(aes(x = datum, y = y)) + geom_line(aes(x = datum, y = y2)) # Mehrere Linien mit individuellem Styling ggplot(data7) + geom_line(aes(x = datum, y = y), linetype = "twodash", linewidth = 1, color = "#365E32") + geom_line(aes(x = datum, y = y2), linetype = "longdash", linewidth = 1, color = "#FD9B63") + scale_y_continuous(breaks = seq(-5, 6, 1), limits = c(-5, 6)) + scale_x_continuous(breaks = seq(2000, 2024, 2)) + labs( y = "", x = "Jahr", title = "Ein Liniendiagramm" ) + theme_bw() #------------------------------------------------------------------------------- ### Gruppierte Liniendiagramme — Babynamen # Datensatz betrachten head(babynames) # Auf drei Namen reduzieren babynames_cut <- babynames %>% filter(name %in% c("Emma", "Kimberly", "Ruth")) %>% filter(sex == "F") # Einfaches gruppiertes Liniendiagramm ggplot(babynames_cut, aes(x = year, y = n, group = name, color = name)) + geom_line() # Ansprechend gestaltetes Liniendiagramm ggplot(babynames_cut, aes(x = year, y = n, group = name, color = name)) + geom_line(linewidth = 1) + scale_color_brewer(palette = "Set1") + labs( x = "Jahr", y = "Anzahl der Babys mit diesem Namen", title = "Popularität von Babynamen über die Zeit", color = "Name" ) + theme_minimal() #------------------------------------------------------------------------------- ### Streudiagramme — einfaches Streudiagramm ggplot(data_streu, aes(x = marketing_budget, y = sales)) + geom_point() # Mit Styling ggplot(data_streu, aes(x = marketing_budget, y = sales)) + geom_point(color = "#99582a") + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Vollmilchschokolade: Verkäufe und Marketing" ) + theme_classic() #------------------------------------------------------------------------------- ### Streudiagramme mit mehreren Gruppen # Farbig nach Gruppe ggplot(data8, aes(x = marketing_budget, y = sales, color = name)) + geom_point() + scale_color_manual(values = c("#e71d36", "#260701")) + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Schokolade: Verkäufe und Marketing", color = "Produkt" ) + theme_classic() # Mit Formen statt Farben ggplot(data8, aes(x = marketing_budget, y = sales, shape = name)) + geom_point(size = 2.5) + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Schokolade: Verkäufe und Marketing", shape = "Produkt" ) + theme_classic() # Farbe UND Form kombiniert ggplot(data8, aes(x = marketing_budget, y = sales, shape = name, color = name)) + geom_point(size = 2.5) + scale_color_manual(values = c("#e71d36", "#260701")) + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Schokolade: Verkäufe und Marketing", shape = "", color = "" ) + theme_classic() #------------------------------------------------------------------------------- ### Plots mit facet_wrap() # Einfaches facet_wrap nach Quartal ggplot(data8, aes(x = marketing_budget, y = sales)) + geom_point() + facet_wrap(~ quartale) # Mit Styling ggplot(data8, aes(x = marketing_budget, y = sales)) + geom_point(color = "#99582a") + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Schokolade: Verkäufe und Marketing" ) + theme_classic() + facet_wrap(~ quartale) # facet_wrap kombiniert mit Form und Farbe ggplot(data8, aes(x = marketing_budget, y = sales, shape = name, color = name)) + geom_point(size = 2.5) + scale_color_manual(values = c("#e71d36", "#260701")) + scale_x_continuous(breaks = seq(0, 10000, 2000)) + labs( x = "Marketingbudget", y = "Verkäufe pro Einheit", title = "Schokolade: Verkäufe und Marketing", shape = "", color = "" ) + theme_classic() + facet_wrap(~ quartale) #------------------------------------------------------------------------------- ### facet_grid() mit Stadt × Jahr ggplot(data9, aes(x = Monate, y = Temperatur, group = Jahr, color = factor(Jahr))) + geom_line() + labs(title = "Durchschnittliche Monatstemperatur (Jan–Apr, 2018–2020)", x = "Monat", y = "Temperatur (°C)", color = "Jahr") + theme_bw() + theme(legend.position = "none") + facet_grid(Jahr ~ Stadt) #------------------------------------------------------------------------------- ### Verschiedene Graphentypen kombinieren — Dualachsen-Chart ggplot(data10, aes(x = monate)) + geom_bar(aes(y = n_tote), stat = "identity", fill = "#FF8080", alpha = 0.6) + geom_line(aes(y = durch_temp * scale_factor, group = 1), color = "#2c2c2c", linewidth = 1, linetype = "dashed") + scale_y_continuous( name = "Anzahl der Verkehrstoten", sec.axis = sec_axis(~ . / scale_factor, name = "Durchschnittstemperatur (Celsius)") ) + labs(x = "", title = "Anzahl der Verkehrstoten und Durchschnittstemperatur pro Monat") + theme_bw() + theme( axis.title.y.left = element_text(color = "#FF8080"), axis.title.y.right = element_text(color = "#2c2c2c") ) #------------------------------------------------------------------------------- ### Violin Plot ggplot(sport_data, aes(x = sport, y = größe, fill = sport)) + geom_violin(trim = FALSE) + labs( title = "Verteilung der Körpergröße von Athleten nach Sportart", x = "Sportart", y = "Größe (cm)" ) + theme_bw() + theme( legend.position = "none", plot.title = element_text(hjust = 0.5, size = 16, face = "bold"), axis.title.x = element_text(size = 14), axis.title.y = element_text(size = 14) ) + scale_fill_brewer(palette = "RdBu") #------------------------------------------------------------------------------- ### Ridgeline Plot ggplot(beispiel_data, aes(x = wert, y = verteilung, fill = verteilung)) + geom_density_ridges() + scale_fill_brewer(palette = "Dark2") + labs( x = "Werte", y = "Verteilung", title = "Ein Ridgeline Chart" ) + theme_ridges() + theme(legend.position = "none") #------------------------------------------------------------------------------- ### Lollipop Chart # Einfach ggplot(data4, aes(x = name, y = stärke)) + geom_point() + geom_segment(aes(x = name, xend = name, y = 0, yend = stärke)) # Ansprechend ggplot(data4, aes(x = name, y = stärke)) + geom_segment(aes(x = name, xend = name, y = 0, yend = stärke), color = "grey") + geom_point(size = 4, color = "#74B72E") + labs(x = "Fiktiver Charakter", y = "Stärke", title = "Stärke fiktiver Charaktere") + theme_light() + theme( panel.grid.major.x = element_blank(), panel.border = element_blank(), axis.ticks.x = element_blank() ) #------------------------------------------------------------------------------- ### Karten — Weltkarte mit Einkommensgruppen # Shapefiles auf Länderebene laden world <- ne_countries(scale = "medium", returnclass = "sf") world <- world %>% filter(gdp_year == 2019) %>% mutate(`Einkommensgruppe` = case_when( income_grp %in% c("1. High income: OECD", "2. High income: nonOECD") ~ "1. Hohe Einkommen", income_grp == "3. Upper middle income" ~ "2. Obere Mitteleinkommen", income_grp == "4. Lower middle income" ~ "3. Untere Mitteleinkommen", income_grp == "5. Low income" ~ "4. Niedrige Einkommen") ) # Mit tmap darstellen tmap_mode("view") tm_shape(world) + tm_polygons("Einkommensgruppe", title = "Einkommensgruppen", palette = "viridis", style = "cat", id = "sovereignt") # Wieder in den Plot-Modus wechseln tmap_mode("plot") #------------------------------ # 4. Explorative Datenanalyse #------------------------------ #------------------------------------------------------------------------------- pacman::p_load("summarytools", "SmartEDA", "skimr", "naniar", "gtsummary", "dlookr", "DataExplorer", "psych", "ggplot2", "palmerpenguins", "dplyr", "tidyr", "corrplot") # Der penguins-Datensatz wurde bereits per source() geladen head(penguins) #------------------------------------------------------------------------------- ### Lagemaße — Modus uniq_werte <- unique(penguins$bill_length_mm) # eindeutige Werte freq <- tabulate(match(penguins$bill_length_mm, uniq_werte)) # Häufigkeiten uniq_werte[which.max(freq)] # häufigster Wert #------------------------------------------------------------------------------- ### Lagemaße — Mittelwert und Median mean(penguins$bill_length_mm) median(penguins$bill_length_mm) #------------------------------------------------------------------------------- ### Streuungsmaße IQR(penguins$bill_length_mm) var(penguins$bill_length_mm) sd(penguins$bill_length_mm) #------------------------------------------------------------------------------- ### Kreuztabellen / Kontingenztabellen # Base R table(penguins$species, penguins$island) # summarytools summarytools::ctable(penguins$species, penguins$island) # gtsummary gtsummary::tbl_cross(data = penguins, row = species, col = island) #------------------------------------------------------------------------------- ### Korrelation — Pearson cor(penguins$bill_length_mm, penguins$body_mass_g, method = "pearson") # Spearman cor(penguins$bill_length_mm, penguins$body_mass_g, method = "spearman") # Kendall cor(penguins$bill_length_mm, penguins$body_mass_g, method = "kendall") #------------------------------------------------------------------------------- ### Korrelation grafisch — Streudiagramm ggplot(penguins, aes(x = bill_length_mm, y = body_mass_g)) + geom_point(color = "#0077b6") + labs(x = "Länge in mm", y = "Körpermasse in g", title = "Beziehung zwischen Länge (in mm) und Körpermasse (in g)") + theme_bw() #------------------------------------------------------------------------------- ### Drei Korrelationstypen visualisieren ggplot(df_cor, aes(x = x, y = y)) + geom_point(color = "steelblue", size = 2) + facet_wrap(~ relationship, nrow = 1) + labs(title = "Starke positive, negative und keine Korrelation", x = "X", y = "Y") + theme_bw(base_size = 18) #------------------------------------------------------------------------------- ### Korrelationsmatrix # Numerischer Subset penguins_numeric <- penguins %>% select(bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g) %>% drop_na() # Korrelationsmatrix berechnen corr_matrix <- cor(penguins_numeric) # Einfache Visualisierung corrplot(corr_matrix, method = "color") # Mit Koeffizienten corrplot(corr_matrix, method = "color", type = "upper", addCoef.col = "black", tl.col = "black", tl.srt = 45) # Kreismethode mit Koeffizienten corrplot(corr_matrix, method = "circle", type = "upper", addCoef.col = "black", tl.col = "black", tl.srt = 45) # Kreismethode ohne Koeffizienten corrplot(corr_matrix, method = "circle", type = "upper", tl.col = "black", tl.srt = 45) #------------------------------------------------------------------------------- ### Arbeiten mit EDA-Paketen — psych # describe() auf den gesamten Datensatz psych::describe(penguins) # Korrelationstest psych::corr.test(penguins_numeric) # pairs.panels: Korrelationen visualisieren psych::pairs.panels(penguins_numeric) #------------------------------------------------------------------------------- ### skimr skimr::skim(penguins) # Ohne Verteilungsdarstellung # skimr::skim_without_charts(penguins) #------------------------------------------------------------------------------- ### summarytools # Datensatz-Zusammenfassung dfSummary(penguins) # Mit view() für formatierte Ausgabe (in RStudio) # view(dfSummary(penguins)) # Häufigkeitstabelle für einzelne Variablen freq(penguins$species) # Deskriptivstatistiken descr(penguins) # Kreuztabellen ctable(penguins$species, penguins$island) #------------------------------------------------------------------------------- ### naniar — fehlende Werte # Tabellarisch naniar::miss_var_summary(penguins_raw) # Struktur der fehlenden Werte naniar::gg_miss_upset(penguins_raw) # Visualisierung der fehlenden Werte naniar::vis_miss(penguins_raw) #------------------------------------------------------------------------------- ### gtsummary — publikationsreife Tabellen # Übersicht gtsummary::tbl_summary(penguins) # Gruppiert nach Geschlecht penguins %>% tbl_summary(by = sex) # Kreuztabelle penguins %>% tbl_cross( row = species, col = island ) #------------------------------------------------------------------------------- ### dlookr # Diagnose diagnose(penguins) %>% print() # describe aus dlookr dlookr::describe(penguins) # EDA-Bericht erzeugen (auskommentiert; erzeugt eine HTML-Datei) # dlookr::eda_paged_report(penguins, output_format = "html") #------------------------------------------------------------------------------- ### DataExplorer # Grundinformationen introduce(penguins) # Fehlende Werte plot_missing(penguins_raw) # Korrelationen plot_correlation(penguins_numeric) # Automatischer Bericht (auskommentiert) # create_report(penguins) #------------------------------------------------------------------------------- ### SmartEDA # Struktur und fehlende Werte ExpData(penguins, type = 1) # Deskriptivstatistiken für numerische Variablen ExpNumStat(penguins) # Automatischer Bericht (auskommentiert) # ExpReport(data = penguins, Target = "species", # label = "Penguin Species", # op_file = "Samp1.html", Rc = 3) #------------------ # 5. Datenanalyse #------------------ #------------------------------------------------------------------------------- pacman::p_load("tidyverse", "ggpubr", "gapminder", "sjPlot", "GGally", "car", "margins", "plotly") #------------------------------------------------------------------------------- ### Lineare Regression — Daten visualisieren ggplot(df, aes(x, y)) + geom_point() + theme_bw() + scale_x_continuous(breaks = seq(0, 10, by = 1)) + scale_y_continuous(breaks = seq(0, 20, by = 2)) #------------------------------------------------------------------------------- ### OLS-Schätzer visuell anpassen — Linie mit Residuen ggplot(df, aes(x, y)) + geom_point() + theme_bw() + scale_x_continuous(breaks = seq(0, 10, by = 1)) + scale_y_continuous(breaks = seq(0, 30, by = 5)) + geom_smooth(method = "lm", se = FALSE) + geom_segment(aes(x = x, y = y, xend = x, yend = predict(lm(y ~ x, data = df))), linewidth = 0.5) #------------------------------------------------------------------------------- ### OLS von Hand berechnen # Zunächst Kovarianz berechnen cov <- sum((df$x - mean(df$x)) * (df$y - mean(df$y))) # Varianz von x berechnen x_sq <- sum((df$x - mean(df$x))^2) x_sq # Steigung berechnen steigung <- cov / x_sq print(steigung) # Achsenabschnitt berechnen beta_0 <- mean(df$y) - (steigung * mean(df$x)) beta_0 #------------------------------------------------------------------------------- ### Lineare Regression automatisch # Modell model1 <- lm(y ~ x, data = df) # Zusammenfassung summary(model1) #------------------------------------------------------------------------------- ### Vorhersagen mit linearer Regression # Manuelle Berechnung mit den geschätzten Koeffizienten df$y_dach <- 1.6821 + 1.5394 * df$x # Automatisch mit predict() df$auto_y_dach <- predict(model1) # Überprüfen head(df) #------------------------------------------------------------------------------- ### Standardfehler — RMSE #Getting the residuals residuen <- df$y_dach - df$y #Getting the squared residuals quadrierte_residuen <- residuen^2 #Getting the mean of the squared residuals mittelwert_qu_resid <- mean(quadrierte_residuen) #Getting the RSME rmse <- sqrt(mittelwert_qu_resid) #Or in one line #rmse <- sqrt(mean((df$y_dach - df$y)^2)) #------------------------------------------------------------------------------- ### Standardfehler des Schätzers (von Hand) #Getting the residuals residuen <- df$y - df$y_dach #getting sigma squared sigma_qu <- sum(residuen^2) / (nrow(df) - 2) #getting standard error of beta 1 sf_beta1 <- sqrt(sigma_qu / sum((df$x - mean(df$x))^2)) #print it sf_beta1 #------------------------------------------------------------------------------- ### t-Wert / t-Statistik # Aus der Regression t_wert_intercept <- -0.32773 / 0.30271 t_wert_x <- 0.67949 / 0.04813 print(t_wert_intercept) print(t_wert_x) #------------------------------------------------------------------------------- ### t-Verteilungen mit verschiedenen Freiheitsgraden ggplot(dichten, aes(x = x, y = dichte, color = verteilung)) + geom_line() + theme_minimal() + labs(x = "x", y = "Dichte", title = "t-Verteilungen mit verschiedenen Freiheitsgraden") + scale_color_manual(values = c("black", "red", "green", "blue")) + scale_x_continuous("X", seq(-5, 5, 1), limits = c(-5, 5)) #------------------------------------------------------------------------------- ### t-Statistik visuell identifizieren t_dichte <- function(x) dt(x, df = 28) ggplot(t_wert_data, aes(x = x, y = dichte)) + geom_line(lineend = "round") + stat_function(fun = t_dichte, geom = "area", fill = "gray", alpha = 0.75, xlim = c(-5, -1.701), n = 10000) + stat_function(fun = t_dichte, geom = "area", fill = "gray", alpha = 0.75, xlim = c(5, 1.701), n = 10000) + geom_vline(xintercept = -1.701, linetype = "dashed", colour = "red") + geom_vline(xintercept = 1.701, linetype = "dashed", colour = "red") + ggtitle("t-Verteilung mit 28 Freiheitsgraden", subtitle = "Der graue Bereich markiert das Intervall signifikanter Werte auf dem 95%-Niveau") + geom_segment(x = -1.082653, xend = -1.082653, yend = dt(-1.082653, df = 28), y = -1, color = "pink", linetype = "dashed", linewidth = 0.2) + annotate("point", x = -1.082653, y = dt(-1.082653, df = 28), color = "pink") + scale_x_continuous("X", seq(-5, 5, 1), limits = c(-5, 5)) + theme_classic() + theme(legend.position = "none") #------------------------------------------------------------------------------- ### p-Werte von Hand p_value_1 <- 2 * pt(-abs(t_wert_intercept), 28) p_value_2 <- 2 * pt(-abs(t_wert_x), 28) print(p_value_1) print(p_value_2) #------------------------------------------------------------------------------- ### Konfidenzintervalle — Simulation visualisieren # Plot der 100 simulierten KIs (CIs wurde im Simulationsskript erstellt) ggplot(data = CIs) + geom_pointrange( aes( x = schätzungen, xmin = unteres_ci, xmax = oberes_ci, y = id, color = missed ) ) + geom_vline( aes(xintercept = wahrer_mittelwert) ) + scale_color_manual(values = c("red", "azure4")) + theme_minimal() + labs( title = "Konfidenzintervall für den Mittelwert", subtitle = "Wahrer Populationsparameter = 24", x = "Schätzungen", y = "Stichprobe", color = "Ist der wahre Populationsparameter im KI enthalten?" ) + theme(legend.position = "top") + scale_x_continuous(breaks = c(seq(15, 30, by = 1))) #------------------------------------------------------------------------------- ### Konfidenzintervalle der Regressionskoeffizienten # Automatisch confint(model1) # Von Hand: Achsenabschnitt ci_unteres_int <- model1$coefficients[1] - 1.96 * summary(model1)$coef[, "Std. Error"][1] ci_oberes_int <- model1$coefficients[1] + 1.96 * summary(model1)$coef[, "Std. Error"][1] print(ci_unteres_int) print(ci_oberes_int) # Von Hand: Schätzer für x ci_unteres_est <- model1$coefficients[2] - 1.96 * summary(model1)$coef[, "Std. Error"][2] ci_oberes_est <- model1$coefficients[2] + 1.96 * summary(model1)$coef[, "Std. Error"][2] print(ci_unteres_est) print(ci_oberes_est) #------------------------------------------------------------------------------- ### Multivariate Regression lm(y ~ x + kategorische_variable, data = df) %>% summary() #------------------------------------------------------------------------------- ### Kategoriale Variablen — Tabelle table(df$kategorische_variable) #------------------------------------------------------------------------------- ### Modell mit kategorialer Variable model2 <- lm(y ~ kategorische_variable, data = df) summary(model2) #------------------------------------------------------------------------------- ### Modell mit + 0 (ohne Achsenabschnitt) model3 <- lm(y ~ kategorische_variable + 0, data = df) summary(model3) # Koeffizientendifferenz manuell überprüfen result <- coefficients(model3)[2] - coefficients(model3)[1] print(result) #------------------------------------------------------------------------------- ### Interaktionseffekte # Interaktionsmodell anpassen model_interaktion <- lm(coding_fähigkeiten ~ investierte_stunden * dieser_kurs, data = df_int) # Zusammenfassung summary(model_interaktion) #------------------------------------------------------------------------------- ### Interaktionseffekt plotten plot_model(model_interaktion, type = "int") + scale_x_continuous(breaks = seq(0, 10, 1)) + labs(title = "Programmierkenntnisse nach Kursart im Vergleich", x = "Aufgewendete Stunden", y = "R-Programmierkenntnisse") + scale_color_manual( values = c("red", "blue"), labels = c("Andere Kurse", "Dieser Kurs") ) + theme_sjplot() + theme(legend.position = "bottom", legend.title = element_blank()) #----------------------- # 6. Schleifen und Funktionen #----------------------- #------------------------------------------------------------------------------- ### For-Schleifen — Motivation: viele if-else note <- 4.0 if (note == 1.0) { print("Hervorragend") } else if (note > 1.0 & note <= 2.0) { print("Gut gemacht") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Das Leben geht weiter") } note <- 3.3 if (note == 1.0) { print("Hervorragend") } else if (note > 1.0 & note <= 2.0) { print("Gut gemacht") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Das Leben geht weiter") } note <- 2.3 if (note == 1.0) { print("Hervorragend") } else if (note > 1.0 & note <= 2.0) { print("Gut gemacht") } else if (note > 2.0 & note <= 3.0) { print("OK") } else if (note > 3.0 & note <= 4.0) { print("Das Leben geht weiter") } #------------------------------------------------------------------------------- ### Notenvektor und Schleife # Notenvektor noten <- c(1.7, 3.3, 4.0, 2.3, 1.0) # Die for-Schleife for (i in 1:length(noten)) { if (noten[i] == 1.0) { print("Hervorragend") } else if (noten[i] > 1.0 & noten[i] <= 2.0) { print("Gut gemacht") } else if (noten[i] > 2.0 & noten[i] <= 3.0) { print("OK") } else if (noten[i] > 3.0 & noten[i] <= 4.0) { print("Das Leben geht weiter") } } #------------------------------------------------------------------------------- ### Schleife durch einen Zahlenvektor num <- c(1, 2, 3, 4, 5, 249) for (i in num) { print(stringr::str_c("Das ist die ", i, ". Iteration")) } #------------------------------------------------------------------------------- ### Verschachtelte Schleifen — Tic-Tac-Toe # Matrix definieren ttt <- matrix(c("X", "O", "X", "O", "X", "O", "O", "X", "O"), nrow = 3, ncol = 3, byrow = TRUE) # Verschachtelte Schleife for (i in 1:nrow(ttt)) { for (j in 1:ncol(ttt)) { print(paste("In Zeile", i, "und Spalte", j, "enthält das Spielfeld", ttt[i, j])) } } #------------------------------------------------------------------------------- ### Die apply()-Funktionsfamilie # Matrix erstellen mat <- matrix(1:10, nrow = 5, ncol = 6) head(mat) # Mittelwert, Summe und Standardabweichung pro Spalte apply(mat, 2, mean) apply(mat, 2, sum) apply(mat, 2, sd) # Entsprechende Schleife for (i in 1:ncol(mat)) { durchschnitt_spalte <- mean(mat[, i]) print(durchschnitt_spalte) } #------------------------------------------------------------------------------- ### Eigene Funktionen schreiben # Einfache Additions-Funktion add <- function(x, y) { ergebnis <- x + y return(ergebnis) } add(2, 7) #------------------------------------------------------------------------------- ### Flächeninhalt eines Kreises aoc <- function(radius) { pi <- 3.14159 fläche <- pi * radius^2 return(fläche) } aoc(5) #------------------------------------------------------------------------------- ### Komplexere Funktion — Klassenzimmer klassenzimmer <- function(x) { for (i in 1:length(x)) { for (j in 1:length(x[[i]])) { schüler <- x[[i]][j] if (schüler == 1) { comment <- "Alice" } else if (schüler == 2) { comment <- "Bob" } else if (schüler == 3) { comment <- "Cathy" } else if (schüler == 4) { comment <- "David" } else if (schüler == 5) { comment <- "Eva" } else { comment <- paste("Unbekannter Student", schüler, "macht etwas Interessantes.") } cat("In Zeile", i, "Spalte", j, ":", comment, "\n") } } } sitzordnung <- list( c(1, 5, 2), c(4, 3, 7) ) klassenzimmer(sitzordnung) #----------------------- # 7. Weitere Erläuterungen #----------------------- #------------------------------------------------------------------------------- pacman::p_load("dplyr", "tidyr", "ggpubr", "gapminder", "kableExtra", "car") #------------------------------------------------------------------------------- ### Wahrscheinlichkeitstheorie — Einen Würfel werfen dice_role <- 3 print(dice_role) #------------------------------------------------------------------------------- ### 1000 Würfelwürfe — Gleichverteilung (data: würfel_würfe) ggplot(würfel_würfe, aes(x = factor(wurf))) + geom_bar(fill = "#89CFF0", color = "gray") + labs( title = "Verteilung von 1.000 Würfelwürfen", x = "Würfelseite", y = "Häufigkeit" ) + theme_minimal() #------------------------------------------------------------------------------- ### Theoretische Gleichverteilung ggplot(gleichverteilung, aes(x = ergebnis, y = wahrscheinlichkeit)) + geom_point() + labs( title = "Gleichmäßige Wahrscheinlichkeitsverteilung eines fairen Würfels", x = "Würfelseite", y = "Wahrscheinlichkeit" ) + theme_minimal() #------------------------------------------------------------------------------- ### Kumulative Verteilung des Würfels ggplot(gleichverteilung, aes(x = ergebnis, y = cumsum)) + geom_point() + labs( title = "Kumulative Verteilung eines fairen Würfels", x = "Würfelseite", y = "Wahrscheinlichkeit" ) + ylim(0, 1) + theme_minimal() #------------------------------------------------------------------------------- ### Bernoulli-Verteilung — faire Münze ggplot(faire_münze, aes(x = ergebnis)) + geom_bar(fill = "#89CFF0", width = 0.35) + labs( title = "Simulation von 10 Würfen einer fairen Münze", x = "Ergebnis", y = "Häufigkeit" ) + theme_minimal() # Unfaire Münze ggplot(unfaire_münze, aes(x = ergebnis)) + geom_bar(fill = "#89CFF0", width = 0.35) + labs( title = "Simulation von 10 Würfen einer unfairen Münze", x = "Ergebnis", y = "Häufigkeit" ) + theme_minimal() #------------------------------------------------------------------------------- ### Wahrscheinlichkeiten genauer Anzahl Köpfe — dbinom() # Faire Münze: P(5 Köpfe in 10 Würfen) dbinom( x = 5, size = 10, prob = 0.5 ) # Unfaire Münze: P(3 Köpfe in 10 Würfen) dbinom( x = 3, size = 10, prob = 0.28 ) #------------------------------------------------------------------------------- ### Binomialverteilungen visualisieren ggplot(theoretische_wahr, aes(x = köpfe, y = wahrscheinlichkeit)) + geom_point(size = 1.5, color = "black") + facet_wrap(~ münzen_typ, labeller = as_labeller(c( biased = "Verzerrte Münze (p = 0.28)", unbiased = "Faire Münze (p = 0.5)"))) + labs(title = "Theoretische Binomialverteilung der Anzahl von Kopf in 10 Würfen", x = "Anzahl Kopf", y = "Wahrscheinlichkeit") + scale_x_continuous(breaks = 0:10) + theme_bw() #------------------------------------------------------------------------------- ### Kumulative Binomialverteilungen ggplot(theoretische_wahr, aes(x = köpfe, y = cumsum_prob)) + geom_point(size = 1.5, color = "black") + facet_wrap(~ münzen_typ, labeller = as_labeller(c( biased = "Verzerrte Münze (p = 0.28)", unbiased = "Faire Münze (p = 0.5)")), nrow = 2) + labs( title = "Kumulative Verteilung der Anzahl von Kopf in 10 Würfen", x = "Anzahl Kopf", y = "Kumulative Wahrscheinlichkeit" ) + scale_x_continuous(breaks = 0:10) + theme_bw() #------------------------------------------------------------------------------- ### Normalverteilung — PDF ggplot(snd, aes(x = stichprobe)) + geom_density() + labs(title = "Normalverteilung", x = "Wert der Zufallsvariable", y = "Dichte") + scale_x_continuous(breaks = -5:5, limits = c(-5, 5)) + theme_minimal() # CDF ggplot(snd, aes(x = stichprobe)) + stat_ecdf(geom = "step", color = "black") + labs(title = "Kumulative Verteilungsfunktion (CDF)", x = "Wert der Zufallsvariable", y = "Kumulative Wahrscheinlichkeit") + theme_minimal() #------------------------------------------------------------------------------- ### Zentraler Grenzwertsatz visualisieren ggplot(df_clt, aes(x = mittelwert)) + geom_density(fill = "skyblue", alpha = 0.6) + facet_wrap(~ rolls, scales = "free", ncol = 2) + labs(title = "Demonstration des Zentralen Grenzwertsatzes mit Würfelwürfen", x = "Stichprobenmittelwert", y = "Dichte") + scale_x_continuous(breaks = 1:6, limits = c(1, 6)) + theme_minimal() #------------------------------------------------------------------------------- ### Überblick über gängige Verteilungen ggplot(plot_df, aes(x = x, y = y)) + geom_line(data = filter(plot_df, !distribution %in% c("Poisson (λ=3)")), color = "steelblue", linewidth = 1) + geom_point(data = filter(plot_df, distribution == "Poisson (λ=3)"), color = "steelblue", size = 1) + facet_wrap(~ distribution, scales = "free", ncol = 3) + labs(title = "Überblick über gängige statistische Verteilungen", x = "x", y = "Dichte / Wahrscheinlichkeit") + theme_minimal(base_size = 14) #------------------------------------------------------------------------------- ### Arbeiten mit Verteilungen — IQ simulieren ggplot(stichprobe_iq, aes(x = größe)) + geom_density(linewidth = 1, color = "#E35335") + labs( x = "IQ", y = "Häufigkeit" ) + scale_x_continuous(breaks = seq(40, 160, 20), limits = c(40, 160)) + theme_minimal() #------------------------------------------------------------------------------- ### Wahrscheinlichkeiten mit dnorm() dnorm(x = 100, mean = 100, sd = 15) # IQ 100 dnorm(x = 87, mean = 100, sd = 15) # IQ 87 dnorm(x = 140, mean = 100, sd = 15) # IQ 140 #------------------------------------------------------------------------------- ### Kumulative Wahrscheinlichkeiten mit pnorm() pnorm(q = 100, mean = 100, sd = 15) pnorm(q = 87, mean = 100, sd = 15) pnorm(q = 140, mean = 100, sd = 15) #------------------------------------------------------------------------------- ### Quantile mit qnorm() qnorm(p = 0.5, mean = 100, sd = 15) qnorm(p = 0.1930623, mean = 100, sd = 15) qnorm(p = 0.9961696, mean = 100, sd = 15) #------------------------------------------------------------------------------- ### Regressionsdiagnostik — Modell und Residuen # Modell model1 <- lm(y ~ x, data = df) # Vorhersagen für y df$y_dach <- 1.6821 + 1.5394 * df$x # Residuen von Hand df$residuen <- df$y - df$y_dach head(df) # Residuen automatisch df$residuen_auto <- residuals(model1) head(df) #------------------------------------------------------------------------------- ### Residualplot ggplot(df, aes(x, residuen_auto)) + geom_point() + geom_hline(yintercept = 0) + scale_y_continuous("Residuen", seq(-6, 6, 1), limits = c(-6, 6)) + scale_x_continuous("Gefittete Werte", seq(0, 10, 1), limits = c(0, 10)) + theme_bw() #------------------------------------------------------------------------------- ### Homoskedastizität vs. Heteroskedastizität homoskedastischer_plot <- ggplot(df_homo_hetero, aes(x = x, y = y_homo)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + scale_y_continuous("Y", seq(-0.5, 3.5, 0.5), limits = c(-0.5, 3.5)) + labs(title = "Homoskedastischer Plot") + theme_minimal() heteroskedastischer_plot <- ggplot(df_homo_hetero, aes(x = x, y = y_hetero)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + labs(title = "Heteroskedastischer Plot") + scale_y_continuous("Y", seq(-0.5, 3.5, 0.5), limits = c(-0.5, 3.5)) + theme_minimal() facet_plots <- ggarrange(homoskedastischer_plot, heteroskedastischer_plot, nrow = 1) print(facet_plots) #------------------------------------------------------------------------------- ### TSS, ESS, R-Quadrat tss <- sum((df$y - mean(df$y))^2) ess <- sum((df$y_dach - mean(df$y))^2) r_quadriert <- ess / tss r_quadriert # Automatisch summary(model1)$r.squared #------------------------------------------------------------------------------- ### Einflussreiche Ausreißer # Plot mit zwei Regressionsgeraden (mit/ohne Ausreißer) ggplot(daten_ausreißer, aes(x = x1, y = y1)) + geom_point(shape = 20, size = 3) + geom_abline(aes(slope = model_ausreißer$coefficients[2], intercept = model_ausreißer$coefficients[1], color = "Modell mit Ausreißer"), linewidth = 0.75, show.legend = TRUE) + geom_abline(aes(slope = model_ohne_ausreißer$coefficients[2], intercept = model_ohne_ausreißer$coefficients[1], color = "Modell ohne Ausreißer"), linewidth = 0.75, show.legend = TRUE) + xlab("Unabhängige Variable") + theme_classic() + theme(legend.position = c(0.15, 0.9), legend.title = element_blank()) #------------------------------------------------------------------------------- ### Cook's Distance daten_ausreißer$cooks_distance <- cooks.distance(model_ausreißer) ggplot(daten_ausreißer, aes(x = x1, y = cooks_distance)) + geom_point(colour = "darkgreen", size = 3, alpha = 0.5) + labs(y = "Cook's Distance", x = "Unabhängige Variable") + geom_hline(yintercept = 1, linetype = "dashed") + theme_bw() #------------------------------------------------------------------------------- ### Funktionsform — quadratische Daten # Einfaches lineares Modell auf quadratische Daten model_einfach <- lm(Y_quadratisch ~ X_quadratisch, data = df2) summary(model_einfach) # Plot mit linearer Anpassung ggplot(df2, aes(x = X_quadratisch, y = Y_quadratisch)) + geom_point(shape = 20, size = 3) + geom_smooth(method = "lm", se = FALSE) + theme_bw() #------------------------------------------------------------------------------- ### Quadratisches Modell (korrekt mit poly()) model_quadratisch <- lm(Y_quadratisch ~ poly(X_quadratisch, 2), data = df2) summary(model_quadratisch) # Plot mit quadratischer Anpassung ggplot(df2, aes(x = X_quadratisch, y = Y_quadratisch)) + geom_point(shape = 20, size = 3) + geom_smooth(method = "lm", formula = y ~ poly(x, 2), color = "red", se = FALSE) + scale_x_continuous("X", breaks = seq(-5, 5, 1), limits = c(-5, 5)) + ylab("Y") + theme_bw() #------------------------------------------------------------------------------- ### Gapminder — nicht-lineare Beziehung head(gapminder) # Unlogarithmiert ggplot(gapminder, aes(gdpPercap, lifeExp)) + geom_point() + geom_smooth(method = "loess", se = FALSE) + scale_y_continuous("Lebenserwartung", seq(30, 80, 10), limits = c(30, 80)) + theme_bw() # Logarithmiert ggplot(gapminder, aes(log(gdpPercap), lifeExp)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + scale_y_continuous("Lebenserwartung", seq(30, 80, 10), limits = c(30, 80)) + xlab("BIP pro Kopf") + theme_bw() #------------------------------------------------------------------------------- ### Unabhängige Beobachtungen — Zeitreihe ggplot(df_zeitreihe, aes(datum, y_zeit)) + geom_line() + ylab("Y") + xlab("Jahr") + theme_bw() #------------------------------------------------------------------------------- ### Adjustiertes R-Quadrat (multivariate Regression) # Multivariates Modell multivariate_model <- lm(y ~ x + kategorische_variable, data = df) summary(multivariate_model) # Extraktion summary(multivariate_model)$adj.r.squared # Von Hand adj_r_quadrat <- 1 - (((1 - summary(multivariate_model)$r.squared) * (nrow(df) - 1)) / (nrow(df) - 2 - 1)) print(adj_r_quadrat) #------------------------------------------------------------------------------- ### Auslassungsvariablenfehler (OVB) # Modell ohne Temperatur model_ohne_temperatur <- lm(gewalt_kriminalität_wahr ~ eis_verkäufe, data = data_ice) # Modell nur mit Temperatur model_nur_mit_temperatur <- lm(gewalt_kriminalität_wahr ~ temperatur, data = data_ice) # Vollständiges Modell model_mit_temperatur <- lm(gewalt_kriminalität_wahr ~ eis_verkäufe + temperatur, data = data_ice) # Zusammenfassungen summary(model_ohne_temperatur) summary(model_nur_mit_temperatur) summary(model_mit_temperatur) # Vergleichstabelle (Hilfsfunktion table_ovb wurde im Simulationsskript definiert) table_ovb(model_ohne_temperatur, model_mit_temperatur) #------------------------------------------------------------------------------- ### Multikollinearität # Modell mit korrelierten Prädiktoren noten_model <- lm(noten ~ lernzeit + gaming_zeit, data = df_noten) summary(noten_model) #------------------------------------------------------------------------------- ### Korrelationen prüfen cormatrix_daten <- df_noten %>% dplyr::select(lernzeit, gaming_zeit) cormatrix <- cor(cormatrix_daten) round(cormatrix, 2) #------------------------------------------------------------------------------- ### Varianzinflationsfaktor (VIF) vif(noten_model) #------------------------------------------------------------------------------- # Ende des Skripts! print("Du hast das Ende des Skripts erreicht — herzlichen Glückwunsch!")