BI in Healthcare 23/24
Flipped Classroom Aufgaben
Christian Franke
Erstellt am 06.12.2023
1 Einführung
Dieses Dokument fasst die Haus- und Übungsaufgaben des Moduls “Business Intelligence in Healthcare (BTX8332)” im Herbstsemster 2023/24 an der Berner Fachhochschule zusammen.
2 Data Clean(s)ing
2.1 Hausaufgaben
Erläuterung von wichtigen Begriffen und Beispiele:
- Data Cleaning: Schritt 2 im Datenanalyseprozess.
Die Fehler in zuvor beschafften Rohdaten werden beseitigt.
- z.B. Duplikate und Fehler entfernen, unvollständige Werte behandeln, Range Constraints (z.B. PLZ, Körpertemperatur)
- Data Preprocessing: Überbegriff oder Synonym zur
Data Cleaning, aber streng genommen ist Data Cleaning teil des Data
Preprocessing
- z.B. korrekte Datentypen, korrekte Beschriftung
- Feature Engineering: Kommt in Datenanalyseprozess
nach dem Data Cleaning; in diesem Schritt werden die modellrelevanten
Daten erstellt/bestimmt/transformiert (unabhängige Variable in
Statistik); Daten werden so aufbereitet, dass man sie in (Maschine
Learning) Modellen verwenden kann
- Feature Selection
- Featrue Extraction: Abhängig von der Fragestellung werden die relevante Information aus einem Merkmal extrahiert. Z.B.: es sei angenommen, dass für eine Fragestellung die Angabe des Jahres nicht relevant, ist sondern die Intervalle zwischen Tagen. Hierzu werden die Einträge des Datums der Fragestellung entsprechend angepasst.
- z.B. Codes/Lables hinzufügen/entfernen, Quoten berechnen etc.
\(\\\)
# Boxplot des Iris-Datensatzes, um die Verteilungen der Spalten darzustellen
boxplot(iris)
# Ausreisser der Spalte Sepal.Width werden berechnet
# auch andere für den Boxplot relevante Werte können bestimmt werden (ohne $out)
outlier_values <- boxplot.stats(iris$Sepal.Width)$out
# Boxplot nur von Spalte Sepal.Width mit Abbildungsbeschriftung und schmaler/dünner Box/Darstellung
boxplot(iris$Sepal.Width, main="Sepal Width", boxwex=0.1)
# Werte der Ausreisser werden dem Boxplot hinzugefügt
mtext(paste("Outliers: ", paste(outlier_values, collapse=", ")), cex=0.6)
# Die Outlier werden künstliche auf NA gesetzt, danach sind die Ausreisser "weg"
iris_neu <- iris
iris_neu[iris_neu$Sepal.Width %in% outlier_values, "Sepal.Width"] <- NA
# dplyr Variante
library(tidyverse)
iris_neu <- iris %>%
mutate(Sepal.Width = replace(Sepal.Width, Sepal.Width %in% outlier_values, NA))
boxplot(iris_neu)
2.2 Übungsaufgaben
Mit Hilfe des Bike-Datensatzes (http://jgendron.github.io/com.packtpub.intro.r.bi/) werden fehlende Werte/Daten, Ausreisser behandelt, Daten konvertiert und Zeichenketten standardisiert.
# Daten einlesen und Überblick verschaffen
df_bike <- read.csv("02 Data Clean(s)ing/bike.csv", stringsAsFactors = FALSE)
str(df_bike)## 'data.frame': 17379 obs. of 13 variables:
## $ datetime : chr "1/1/2011 0:00" "1/1/2011 1:00" "1/1/2011 2:00" "1/1/2011 3:00" ...
## $ season : int 1 1 1 1 1 1 1 1 1 1 ...
## $ holiday : int 0 0 0 0 0 0 0 0 0 0 ...
## $ workingday: int 0 0 0 0 0 0 0 0 0 0 ...
## $ weather : int 1 1 1 1 1 2 1 1 1 1 ...
## $ temp : num 9.84 9.02 9.02 9.84 9.84 ...
## $ atemp : num 14.4 13.6 13.6 14.4 14.4 ...
## $ humidity : chr "81" "80" "80" "75" ...
## $ windspeed : num 0 0 0 0 0 ...
## $ casual : int 3 8 5 3 0 0 2 1 1 8 ...
## $ registered: int 13 32 27 10 1 1 0 2 7 6 ...
## $ count : int 16 40 32 13 1 1 2 3 8 14 ...
## $ sources : chr "ad campaign" "www.yahoo.com" "www.google.fi" "AD campaign" ...summary(df_bike)## datetime season holiday workingday
## Length:17379 Min. :1.000 Min. :0.00000 Min. :0.0000
## Class :character 1st Qu.:2.000 1st Qu.:0.00000 1st Qu.:0.0000
## Mode :character Median :3.000 Median :0.00000 Median :1.0000
## Mean :2.502 Mean :0.02877 Mean :0.6827
## 3rd Qu.:3.000 3rd Qu.:0.00000 3rd Qu.:1.0000
## Max. :4.000 Max. :1.00000 Max. :1.0000
## weather temp atemp humidity
## Min. :1.000 Min. : 0.82 Min. : 0.00 Length:17379
## 1st Qu.:1.000 1st Qu.:13.94 1st Qu.:16.66 Class :character
## Median :1.000 Median :20.50 Median :24.24 Mode :character
## Mean :1.425 Mean :20.38 Mean :23.79
## 3rd Qu.:2.000 3rd Qu.:27.06 3rd Qu.:31.06
## Max. :4.000 Max. :41.00 Max. :50.00
## windspeed casual registered count
## Min. : 0.000 Min. : 0.00 Min. : 0.0 Min. : 1
## 1st Qu.: 7.002 1st Qu.: 4.00 1st Qu.: 36.0 1st Qu.: 42
## Median :12.998 Median : 16.00 Median :116.0 Median :141
## Mean :12.737 Mean : 34.48 Mean :152.5 Mean :187
## 3rd Qu.:16.998 3rd Qu.: 46.00 3rd Qu.:217.0 3rd Qu.:277
## Max. :56.997 Max. :367.00 Max. :886.0 Max. :977
## sources
## Length:17379
## Class :character
## Mode :character
##
##
## summary(is.na(df_bike))## datetime season holiday workingday
## Mode :logical Mode :logical Mode :logical Mode :logical
## FALSE:17379 FALSE:17379 FALSE:17379 FALSE:17379
##
## weather temp atemp humidity
## Mode :logical Mode :logical Mode :logical Mode :logical
## FALSE:17379 FALSE:17379 FALSE:17379 FALSE:17379
##
## windspeed casual registered count
## Mode :logical Mode :logical Mode :logical Mode :logical
## FALSE:17379 FALSE:17379 FALSE:17379 FALSE:17379
##
## sources
## Mode :logical
## FALSE:16825
## TRUE :554# Fehlerhafte Daten in Spalte humidity entfernen
table(df_bike$humidity)##
## 0 10 100 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
## 22 1 270 1 1 2 4 10 10 10 16 17 26 27 46 56 59 78 71 97
## 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
## 106 113 118 99 162 133 163 187 224 186 209 224 290 235 270 244 248 316 247 240
## 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
## 327 266 262 312 267 287 352 310 231 258 272 267 335 325 163 219 387 388 161 172
## 69 70 71 72 73 74 75 76 77 78 79 8 80 81 82 83 84 85 86 87
## 359 430 193 191 317 341 222 219 336 327 238 1 107 275 299 630 124 5 76 488
## 88 89 90 91 92 93 94 96 97 x61
## 657 239 7 1 2 331 560 3 1 1df_bike$humidity <- gsub("[a-z A-Z]","",df_bike$humidity)
df_bike$humidity <- as.numeric(df_bike$humidity)
# Ausreisser zeigen und am Beispiel Windspeed entfernen
boxplot(df_bike[,6:12])
boxplot(df_bike$windspeed)
outlier_values <- boxplot.stats(df_bike$windspeed)$out
df_bike[df_bike$windspeed %in% outlier_values, "windspeed"] <- NA
boxplot(df_bike$windspeed)
# Datentypkonvertierung (hier Datum)
# library("lubridate")
df_bike$datetime <- mdy_hm(df_bike$datetime)
# df_bike$datetime <- parse_date_time(x = df_bike$datetime, orders = "%m/%d/%Y %H:%M")
# df_bike$datetime <- strptime(x = df_bike$datetime, format = "%m/%d/%Y %H:%M")
# Zeichenketten standardisieren
unique(df_bike$sources)## [1] "ad campaign" "www.yahoo.com" "www.google.fi" "AD campaign"
## [5] "Twitter" "www.bing.com" "www.google.co.uk" "facebook page"
## [9] "Ad Campaign" "Twitter " NA "www.google.com"
## [13] "direct" "blog"df_bike$sources <- trimws(tolower(df_bike$sources))
df_bike[is.na(df_bike$sources), c("sources")] <- "unknown"
unique(df_bike$sources)## [1] "ad campaign" "www.yahoo.com" "www.google.fi" "twitter"
## [5] "www.bing.com" "www.google.co.uk" "facebook page" "unknown"
## [9] "www.google.com" "direct" "blog"df_bike$holiday <- factor(df_bike$holiday, levels = c(0, 1), labels = c("yes","no"))
df_bike$workingday <- factor(df_bike$workingday, levels = c(0, 1), labels = c("yes","no"))
df_bike$season <- factor(df_bike$season, levels = 1:4, labels = c("spring","summer","autumn","winter"), ordered = TRUE)
df_bike$weather <- factor(df_bike$weather, levels = 1:4, labels = c("clear","mist + cloudy","light rain/snow","heavy rain"), ordered = TRUE)3 Feature Engineering
3.1 Hausaufgaben
3.1.1 One-Hot-Coding
Beim One-Hot-Coding werden kategorielle Attribute (Faktoren) in so viele neue Spalten aufgeteilt wie es Kategorien (N) gibt. Die Ausprägungen der neuen Spalten sind 0 und 1. Bei der Dummy-Codierung wird eine Spalte weggelassen, denn wenn alle andere Spalten 0 sind, hat diese Dummy-Spalte die Ausprägung 1.
\(\\\)
In R gibt es mehrere Möglichkeiten für One-Hot-Coding. Man kann die Libraries “Matrix” oder “fastDummies” nutzen oder manuell umcodieren. Die umcodierte Variable (hier Season) muss jedoch zwingend ein Factor sein!
library(Matrix)
df_one_hot_matrix <- df_bike %>%
select(datetime, season)
df_one_hot_matrix <- sparse.model.matrix(~.-1, df_one_hot_matrix) # -1 enttfernt Intercept aus Matrix-Objekt
head(df_one_hot_matrix)## 6 x 5 sparse Matrix of class "dgCMatrix"
## datetime seasonspring seasonsummer seasonautumn seasonwinter
## 1 1293840000 1 . . .
## 2 1293843600 1 . . .
## 3 1293847200 1 . . .
## 4 1293850800 1 . . .
## 5 1293854400 1 . . .
## 6 1293858000 1 . . .library(fastDummies)
df_fast_dummies <- df_bike
df_fast_dummies <- dummy_cols(df_fast_dummies, c("season"), remove_selected_columns = TRUE)
str(df_fast_dummies)## 'data.frame': 17379 obs. of 16 variables:
## $ datetime : POSIXct, format: "2011-01-01 00:00:00" "2011-01-01 01:00:00" ...
## $ holiday : Factor w/ 2 levels "yes","no": 1 1 1 1 1 1 1 1 1 1 ...
## $ workingday : Factor w/ 2 levels "yes","no": 1 1 1 1 1 1 1 1 1 1 ...
## $ weather : Ord.factor w/ 4 levels "clear"<"mist + cloudy"<..: 1 1 1 1 1 2 1 1 1 1 ...
## $ temp : num 9.84 9.02 9.02 9.84 9.84 ...
## $ atemp : num 14.4 13.6 13.6 14.4 14.4 ...
## $ humidity : num 81 80 80 75 75 75 80 86 75 76 ...
## $ windspeed : num 0 0 0 0 0 ...
## $ casual : int 3 8 5 3 0 0 2 1 1 8 ...
## $ registered : int 13 32 27 10 1 1 0 2 7 6 ...
## $ count : int 16 40 32 13 1 1 2 3 8 14 ...
## $ sources : chr "ad campaign" "www.yahoo.com" "www.google.fi" "ad campaign" ...
## $ season_spring: int 1 1 1 1 1 1 1 1 1 1 ...
## $ season_summer: int 0 0 0 0 0 0 0 0 0 0 ...
## $ season_autumn: int 0 0 0 0 0 0 0 0 0 0 ...
## $ season_winter: int 0 0 0 0 0 0 0 0 0 0 ...# manuelles umcodieren z.B. mit dplyr und ifelse
df_manuell <- df_bike %>%
mutate(spring = ifelse(season == 1, 1, 0),
summer = ifelse(season == 2, 1, 0),
fall = ifelse(season == 3, 1, 0),
winter = ifelse(season == 4, 1, 0))One-hot-Coding muss bei der normalen linearen Regression (LM) nicht zwingend gemacht werden, wenn die Spalte ein Faktor ist. Bei anderen Modellen wird evtl. One-hot-Coding/Dummy benötigt. Das kommt auf das Modell drauf an.
3.1.2 Kontraste
Eine kategorielle Variabel wird umcodiert mit One-Hot-Coding. Kontraste vergleichen dann die Referenzwerte (Mittelwerte) der Gruppen miteinander. Es wird beispielsweise das durchschnittliche Gewicht einer Gruppe mit den durchschnittlichen Gewichten der anderen Gruppen verglichen. Das nächsten Level vergleicht jeweils zum vorangegangenen Level. Kontraste dienen dazu, welche Vergleiche angestellt werden sollen.
Im Quiz gabe es Rechenbeispiele dazu. In den Standardeinstellungen von linearen Modellen in R sind die Kontraste “NULL”, die gemäss R-Hilfe eine optionale Liste darstellen.
lm(formula, data, subset, weights, na.action,
method = "qr", model = TRUE, x = FALSE, y = FALSE, qr = TRUE,
singular.ok = TRUE, contrasts = NULL, offset, ...)Eine andere Kontrast-Methode ist Helmert, wobei f hier den Spaltennamen meint.
contrasts = list(f = "contr.helmert")Ein konkretes Beispiel mit dem Iris-Datensatz macht das Thema hoffentlich besser greifbar. Zunächst zeigen wir die Daten grafisch und berechnen die exakten Mittelwerte für Sepal.Length. Diese beiden Schritte dienen nur dem Verständnis und der Nachvollziehbarkeit, sind aber eigentlich egal.
plot(iris$Species, iris$Sepal.Length)
tapply(iris$Sepal.Length, iris$Species, mean)## setosa versicolor virginica
## 5.006 5.936 6.588Jetzt werden zwei Regeresisonen ausgeführt. Die normale LM zeigt in den Schätzern die oben berechneten Mittelwerte je Spezien an (muss kumuliert werden).
summary(lm(Sepal.Length ~ Species, iris))##
## Call:
## lm(formula = Sepal.Length ~ Species, data = iris)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6880 -0.3285 -0.0060 0.3120 1.3120
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.0060 0.0728 68.762 < 2e-16 ***
## Speciesversicolor 0.9300 0.1030 9.033 8.77e-16 ***
## Speciesvirginica 1.5820 0.1030 15.366 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5148 on 147 degrees of freedom
## Multiple R-squared: 0.6187, Adjusted R-squared: 0.6135
## F-statistic: 119.3 on 2 and 147 DF, p-value: < 2.2e-16summary(lm(Sepal.Length ~ Species, iris, contrasts = list(Species = "contr.helmert")))##
## Call:
## lm(formula = Sepal.Length ~ Species, data = iris, contrasts = list(Species = "contr.helmert"))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6880 -0.3285 -0.0060 0.3120 1.3120
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.84333 0.04203 139.020 < 2e-16 ***
## Species1 0.46500 0.05148 9.033 8.77e-16 ***
## Species2 0.37233 0.02972 12.527 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5148 on 147 degrees of freedom
## Multiple R-squared: 0.6187, Adjusted R-squared: 0.6135
## F-statistic: 119.3 on 2 and 147 DF, p-value: < 2.2e-16Das lineare Modell mit Helmert-Kontrast kann alternativ auch wie folgt geschrieben werden. Erst wird eine Kopie von iris erstellt und dort für die Spezies die Helmert-Kontraste eingefügt. Danach erfolgt die Regression mit “impliziten” Kotrasten über diesen Datensatz inkl. definierten Kontrasten. Das ist am Ende aber (glaueb ich) das gleiche.
iris_contrasts <- iris
contrasts(iris_contrasts$Species) <- contr.helmert(3)
summary(lm(Sepal.Length ~ Species, iris_contrasts))Bei der Regression mit Kontrasten werden nun die Mittelwerte geschätzt statt die übliche lineare Gleichung. Der Schätzer des Intercepts ist einfach der Mittelwert aller Datenpunkte. Der erste Kontrastschätzer ist Mittel von sich selbst minus Mittelwert von sich slbst und nächstem Gruppenmittelwert (von der t-Apply-Funktion oben). Der nächster Kontrastschätzer ist wieder der eigener Mittelwert minus Mittel des eigenen Mittelwerts und nächster Gruppenmittelwerte.
# Intercept
mean(iris$Sepal.Length)## [1] 5.843333# erste Kontrastschätzer
5.936-(5.006+5.936)/2## [1] 0.465# zweiter Kontrastschätzer
(5.006+5.936+6.588)/3-(5.006+5.936)/2## [1] 0.37233333.1.3 Principal Component Analysis
Bei der Principal Component Analysis (PCA) soll maximale viel von der Varianz erklärt werden! Die PCA ist eine Vorstufe, bevor überhaupt ein Modell weiterentwickelt wird. Wir möchten einschätzen, ob der Datensatz überhaupt geeignet ist, um damit weiter zu arbeiten. PCA kann zudem als Ersatz für sehr viele (hunderte?) Originalvariablen genutzt werden. Am Ende werden Dimensionen reduziert.
In R wird die PCA mit prcomp() durchgeführt. Das Methoden-Attribute “center” ist bereits standarmässig TRUE, sodass die Mittelwerte auf 0 normiert werden (diese Spezifizierung benötigen wir im Code unten somit eigentlich nicht). Das Methoden-Attribut “scale” sollte ebenfalls TRUE sein, um die Standardabweichung auf 1 zu normieren, bevor PCA berechnet wird (scale ist standardmässig FALSE).
pc <- prcomp(iris[,-5], center = TRUE, scale = TRUE)In “rotation” werden die Details der Linearkombinationen / Pricipal Components (PC) angezeigt. Dabei ist der absolute Betrag wichtig. PC1 repräsentiert alle Attribute gut ausser Sepal.Width. PC2 repräsentiert vor allem Sepal.Width, aber die anderne nicht so gut.
pc$rotation## PC1 PC2 PC3 PC4
## Sepal.Length 0.5210659 -0.37741762 0.7195664 0.2612863
## Sepal.Width -0.2693474 -0.92329566 -0.2443818 -0.1235096
## Petal.Length 0.5804131 -0.02449161 -0.1421264 -0.8014492
## Petal.Width 0.5648565 -0.06694199 -0.6342727 0.5235971Diese Details sind interessant für das Verständnis der PCA, aber mit der Zusammenfassung können wir entscheiden, ob der Datensatz überhaupt geeinet ist.
summary(pc)## Importance of components:
## PC1 PC2 PC3 PC4
## Standard deviation 1.7084 0.9560 0.38309 0.14393
## Proportion of Variance 0.7296 0.2285 0.03669 0.00518
## Cumulative Proportion 0.7296 0.9581 0.99482 1.00000Wenn “Cumulative Proportion” der ersten zwei (bis drei) PC sehr hoch ist, dann können wir den Datensatz nutzen, sonst können wir ihn uns schenken. Mind. 70-80% sollten durch PC1 und PC2 (oder auch PC3) erklärt werden. Es geht hier icht um die finale Selektion der Variablen, sondern darum überhaupt zu schauen, ob der Datensatz geeignet ist.
Nun stellen wir die Zwischenergebnisse grafisch dar. Der plot(pc) verschafft uns einen Überblick über die Varianzen je PC, um die “Unterschiede” in den PC besser beurteilen zu können.
plot(pc)
biplot(pc)
Der biplot() zeigt die ersten beiden PC-Werte je Datenpunkt. Nahe Datenpunkte sind eher “ähnlich” zu einander.
Als nächstes nutzen wir die preditc() Methode, um auf Basis der PC die neuen Koordinaten des Iris-Datensatzes zu erstellen. Die Spezies-Werte werden dem neuen Datensatz hinzugefügt. Zudem werden Setosa zur Referenz bestimmt.
trg <- data.frame(predict(pc), iris[5])
trg$Species <- relevel(trg$Species, ref = "setosa")Das nnet Package (Fit Neural Networks) wird geladen und ein multinomiales log-lineares Model mit Hilfe der Neuralen Netzwerke des nnet-Package erstellt. Die Spezies wird mit Hilde von PC1 und PC2 vorhergesagt.
library(nnet)
mymodel <- multinom(Species~PC1+PC2, data = trg)## # weights: 12 (6 variable)
## initial value 164.791843
## iter 10 value 25.921971
## iter 20 value 24.637111
## iter 30 value 24.515626
## iter 40 value 24.513212
## iter 40 value 24.513212
## final value 24.513212
## convergedsummary(mymodel)## Call:
## multinom(formula = Species ~ PC1 + PC2, data = trg)
##
## Coefficients:
## (Intercept) PC1 PC2
## versicolor 9.125730 12.77516 2.853780
## virginica 2.728464 18.56054 3.396886
##
## Std. Errors:
## (Intercept) PC1 PC2
## versicolor 108.4973 67.86478 82.44931
## virginica 108.5069 67.87592 82.45103
##
## Residual Deviance: 49.02642
## AIC: 61.02642Da Setoa unsere Referenz ist, werden die anderen beiden Spezies gegen Setosa (als Intercept) dargestellt.
Im letzten Schritt wird die Vorhersage mit Hilfe der “Confusion Matrix & Misclassification Error” überprüft.
p <- predict(mymodel, trg)
tab <- table(p, trg$Species)
tab##
## p setosa versicolor virginica
## setosa 50 0 0
## versicolor 0 43 5
## virginica 0 7 45Anhand der Konfusionsmatrix (tab) kann gesehen werden, dass das Modell in den meisten Fällen die Spezies korrekt klassifiziert hat. In nur 12 Fällen stimmt die Klassifizierung nicht.
3.1.4 Filter, Wrapping, Embedded-Verfahren
- Filtering: Man verwendet statistische Verfahren, um die Beziehung zwischen den Merkmalen und der Zielvariable zu analysieren. Dies kann beinhalten, dass man sich anschaut, wie Merkmale miteinander korrelieren, wie stark sie mit der Zielvariable zusammenhängen oder ob es signifikante Unterschiede zwischen den Klassen gibt. Filter-Verfahren bewerten die Merkmale auf Basis dieser statistischen Maße, um die relevanten Merkmale zu identifizieren. Statistische Tests (T-Test, Korrelation) helfen dabei, die erklärenden Variable zu finden. Alle Daten genutzt des Modells werden genutzt.
- Wrapping: Wrapper Verfahren verwenden tatsächliche Vorhersagemodelle, um die Qualität der Merkmale zu bewerten. Sie bewerten, wie gut ein Modell mit verschiedenen Merkmalsubsets auf einem Trainingsdatensatz abschneidet. Diese Methode ist modellabhängig, da sie die Leistung des Modells als Maß für die Merkmalsauswahl verwendet. Features werden schrittweise hinzugefügt oder entfernt, um die Leistung zu optimieren. Es wird jeweils nur ein Teil der Daten genutzt.
- Embedded-Verfahren: Filtering und Wrapping passieren nicht sequentiell, sondern Bestandteil der Modellkreierung. Embedded-Verfahren integrieren die Merkmalsauswahl in den Modelltrainingsprozess selbst. Das Modell analysiert automatisch die Relevanz der Merkmale während des Trainings und eliminiert unwichtige Features.
3.2 Übungsaufgaben
3.2.1 PCA mit mtcars
Die “Cumulative Proportion” PC1 liegt bei 60% und zusammen mit PC2 bereits bei über 84%. Das bedeutet, dass wir den mtcars Datensatz für weitere Modellentwicklung nutzen können.
pc <- prcomp(mtcars, center = TRUE, scale = TRUE)
summary(pc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.5707 1.6280 0.79196 0.51923 0.47271 0.46000 0.3678
## Proportion of Variance 0.6008 0.2409 0.05702 0.02451 0.02031 0.01924 0.0123
## Cumulative Proportion 0.6008 0.8417 0.89873 0.92324 0.94356 0.96279 0.9751
## PC8 PC9 PC10 PC11
## Standard deviation 0.35057 0.2776 0.22811 0.1485
## Proportion of Variance 0.01117 0.0070 0.00473 0.0020
## Cumulative Proportion 0.98626 0.9933 0.99800 1.0000Interessant ist in diesem Fall auch der Biplot je Auto.
biplot(pc)
Die “Sportwagen” sind im Biplot oben in der Mitte dargestellt, amerikanische Limusinen unten rechts und internationale “Kleinwagen” links.
3.2.2 Up/Down-Sampling
Beim Sampling werden unbalancierte Daten ausbalanciert. Wenn wir genug Daten haben, können wir Under-Sampling machen.
- Down-Sampling (Under): aus der Subgruppe mit vielen Daten wird eine Stichprobe zur Subgruppe mit wenigen Daten hinzugefügt, sodass schliesslich jeweils die Hälfte der Daten aus je einer Subgruppe stammt
- Up-Sampling (Over): Datensätze der Subgruppe mit wenigen Daten werden mehrfach verwendet (“ziehen mit zurücklegen”)
library(MASS)
library(caret)
summary(biopsy$class)## benign malignant
## 458 241downSample <- downSample(biopsy, biopsy$class)
summary(downSample$class)## benign malignant
## 241 241upSample <- upSample(biopsy, biopsy$class)
summary(upSample$class)## benign malignant
## 458 4583.3 Studierendenfragen
Hinweise, die sich aus unseren Fragen oder Multiple-Choise-Quiz ergeben haben und oben nicht erklärt wurden
- Das Prinzip der Kontraste müssen wir können. Details beispielsweise zu Helmert sind weniger wichtig.
- Skalieren: Abgleichen der Variablen, sodass die Varianz redzuiert wird (eine Variable von 0 bis 100 und eine andere von 0 bis 1). Regeressionmodell können die Niveauunterschiede ausgleichen, weil die Schätzer dann angepasst werden. Bei anderen Verfahren (La Sous?) gibt es aber einen Straftherm und dort beötgien wir Standardierung.
- Bias-Variance-Tradeoff? (p.28): Ich möchte im Mittel dort liegen, wo meine Zielgrösse ist; ich nehme aber in Kauf, dass ich von meinem Zielpunkt wegkomme und dakzeptiere dafür etwas mehr Varianz.
- Folie 24: trg$Species <- relevel(trg$Species, ref = “setosa”): Nein, bei ref = “setosa” handelt es sich hier nicht um Kontraste.
- Overfitting: ein Modell versucht, zu viel aus den Daten zu erklären, was sonst nur “Rauschen” wäre; Overfitting kann nicht durch durch Datenbereiningung vermieden werden, sondern auch durch zu wenige Daten entstehen. Gleichezitig passt sich ein zu komplexes Modell an Daten an
- Signifikanz spielt keine Rolle für PCA; PC1 und PC2 erklären die meiste Varianz, die mit einem Optimierungsverfahren zur Erklärung der maximalen Varianz berechnet wurden
- Over und untersampling können kombiniert werden (statt bei 90:10 zu 90:90 oder 10:10 selektieren wir 50:50 Fälle). Für Sampling berauchen wir keine Vereinteilungannahmen. Samples machen Subselect oder “zufällige” Vervielfachung.
4 Clustering
4.1 Hausaufgaben
4.1.1 Linkage Varianten
- Sinlge (min): ein Datenpunkt wird mit “direktem” Nachbarn verknüpft (mit kleinster Distanz), aber daraus können sich Ketten entstehen
- Complete (min/max): maximal entfernte Datenpunkte unterschiedlicher Cluter werden verglichen und die minimale Distanz dieser Distanzen genutzt (anfällig für Ausreisser)
- Average: Mittelwert der Entfernungen zwischen allen Datenpunktpaaren und davon der kleineste Abstand
- Centroid: Mittelwert jedes Clusters wird ermittelt und Distanz zwischen diesen Mittelpunkten betrachtet
- Ward: für jedes Cluster wird die Summe der quadrierten Distanzen der Datenpunkt vom Cluster-Centroid berechnet und alles aufsummiert. Danach werden diejenigen beiden Cluster vereinigt, deren Zusammenfügen die geringste Erhöhung der Gesamtsumme der quadrierten Distanzen zur Folge hat
4.1.2 Hierarchisches Clustering (iris)
Beginne mit kleinster Partitionierung (jede Datenpunkt = eigenes Cluster) und fusioniere Cluster bis ein zuvor festgelegtes Kriterium erfüllt ist.
- Berechnung der Distanz zwischen Cluster
- Fusion der Cluster mit kleinster Distanz (siehe Linkage-Frage oben)
- Berechnung des End-Kriteriums (ggfs. wieder von vorn)
Die voreingestelle Distanz-Berechnung ist “euclidean”. Die standard Linkage-Methode ist “complete”, kann aber überschrieben werden mit “ward.D”, “ward.D2”, “single”, “complete”, “average” (“avg”), “mcquitty”, “median” or “centroid” (“cen”).
iris_h_cluster <- hclust(dist(iris[,1:4]), method = "cen")
plot(iris_h_cluster)
Das Dendogramm zeigt mir, wo man einen “Schnitt” machen kann, um die Cluster zu trennen. Angenommen wir wollen drei Cluster produzieren, dann können wir dies wie folgt machen:
groups_3 <- cutree(iris_h_cluster, 3)
table(groups_3, iris$Species)##
## groups_3 setosa versicolor virginica
## 1 50 0 0
## 2 0 50 48
## 3 0 0 2Wir sehen hier, dass die Zuoordnung recht gut funktioniert. Das ist aber abhängig von der Distanz-Methode. Häufig ist Ward das beste, weil hier die Varianz minimiert wird.
library(cluster)
head(silhouette(cutree(iris_h_cluster,3), dist=dist(iris[,1:4])))## cluster neighbor sil_width
## [1,] 1 2 0.8738361
## [2,] 1 2 0.8429809
## [3,] 1 2 0.8536475
## [4,] 1 2 0.8341189
## [5,] 1 2 0.8704164
## [6,] 1 2 0.7841426Silhouette: Für jede Zeile kann eine Silhouette berechnet werden. Distanzen eines Punktes 0 zu Cluster A oder B und davon die Differenz sowie mit dem Maximum der Distanz aus A der B normiert. Je grösser der Silhouette-Wert, desto besser ist die Zuordnung zum Cluster. Bei negativen Werten müsten die Daten eigentlich in ein anderes Cluster.
4.1.3 k-means Clutering (iris)
K-Means Clustering startet an einer fest definierten Anzahl an zufälligen Punkten und bezieht die Datenpunkte in der jeweiligen Umbegung mit ein. Dafür können einfach die Abstände ermittelt werden. Dann werden die Mittelwerte der jeweiligen Cluster neu berechnet, sodass sie sich mehr ins Zentrum des Clusters verschieben. Das geht solange, wie wir es definiert haben.
iris_k_means <- kmeans(iris[,1:4], centers = 3)
ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
geom_point(aes(colour = factor(iris_k_means$cluster)))
table(iris_k_means$cluster, iris$Species)##
## setosa versicolor virginica
## 1 0 2 36
## 2 0 48 14
## 3 50 0 0Die Anzahl können wir z.B. mit der Elbow-Methode herausfinden. Dabei berechnen wir die “Diameter” (maximale Abstände in den Clustern) und plotten sie (X-Achse ist Anzahl Cluster und Y-Achse ist Abstand). Dort, wo unsere Kurve einen “Ellbogen” hat (max der “zweiten Ableitung”), ist beste Anzahl an Cluster. Dafür verwenden wir die Funktion fviz_nbclust() aus dem Package factoextra.
library (factoextra)
fviz_nbclust(iris[,1:4], kmeans, method = "wss")
4.1.4 Vor- und Nachteile
- Für k-means werden keine Linkage Methoden benötigt.
- Dafür benötigen wir aber die Anzahl an “gewünschten” Cluster. Entweder mit dem Elbogendiagramm (mit Diameter oder erklärte Varianz) oder mit Siluhet.
4.1.5 Gradient Descent
Elegantere Herleitung des Lyod Algorithmus. Nach den zufälligen Startpunkten und initialer Zuteilung werden die neuen Mittelwerte berechnet. Danach wird die Zuordnung neu berechnet und ein Update-Mechanismus durchgeführt.
4.2 Übungsaufgaben
4.2.1 Hierarchisches Clustering (bike)
library(cluster)
bike_dist <-dist(df_bike[,c("temp", "casual", "registered", "windspeed")])
bike_h_cluster <- hclust(bike_dist, method = "cen")
plot(bike_h_cluster)
Das Bike-Distanz-Objekt ist über 1 GB gross, sodass es hier gelöscht wird.
rm(bike_dist)4.2.2 k-means Clutering (bike)
Dieser Code funktioniert im Markdown-Skript, aber kann komischerweise nicht geknitet werden. Deshalb werden die Ergebnisse hier nicht angezeigt.
library(ggplot2)
bike_c_columns <- df_bike[,c("temp", "casual", "registered", "windspeed")]
bike_km_cluster <- kmeans(bike_c_columns, centers = 6, iter.max = 20)
bike_km_cluster$size
ggplot(bike_c_columns, aes(registered, casual)) +
geom_point(aes(colour = factor(bike_km_cluster$cluster)))4.3 Studierendenfragen
- Spalten/Zeilen bei dist() (Distanzmatrix): alle Distanzen zum ersten Punkt in ersten Spalte, alle Distanzen zum zweiten Punkt in der zweiten Spalte etc.; aus Vereinfachungsgründen werden redundante Werte rausgelassen (im R-Output nur 7 Zeilen statt 150)
5 Machine Learning
5.1 Hausaufgaben
5.1.1 Overfittung
- Beim Overfitting ist das Modell zu gut an den Trainingsdatensatz angepasst.
- Auf Trainginsdaten toll, auf Testdaten nicht gut.
- Bei neuen Daten schneidet die Modellqualität dann jedoch schlecht ab, weil keine Verallgemeinerung mehr möglich ist.
- Beispiel: Selection Bias, d.h. die Daten werden an einem Ort erhoben, an denen keine repräsentative Auswahl der Population vorhanden ist (z.B. Umfrage im Sportverein bezüglich chronischer Krankheiten)
5.1.2 Generative und diskriminante Classifier
- Generativ: was ist die W’keit, die Klasse “nicht krank” und die entsprechenden Features im Kombination (Gesamtw’keit muss modelliert werden) –> bedingte W’keit steht hier im Vordergrund (ist das die “übliche” Vorhersage bei gegebenen, realen Inputs?) Beispiel: hat diese Person, die vor mit steht mit Alter 40, Raucher, etc.
- Diskriminativ: W’keit, dass ein Ereignis eintritt, wenn auch
- Naive Bayes-Klassifikatoren für binäre Merkmale werden unter logistische Regressionsklassifikatoren subsumiert.
- NB hängt für binäre Merkmale mathematisch mit der logistischen Regeression zusammen.
5.1.3 Aufgabe comedy/action
- Der Film mit den Worten fast, couple, shoot, fly wird vermutlcih nach NB ein Action-Film sein.
- Inklusive alpha = 1
- Wichtige Annahme: die Wörter seien unabhängig voneinander.
5.1.4 Naive Bayes auf bike
Als erstes die die naivebayes-Libraries gepladen. Ich benutzte aus Vereinfachungsgründen zunächst nur die beiden Spalten weather und count.
library(tidyverse)
library(naivebayes)
nb_bike <- df_bike %>%
dplyr::select(weather, temp, humidity, windspeed)Der Datensatz wird in Trainingsdaten und Testdaten aufgeteilt und NB ausgeführt.
set.seed(1234)
ind <- sample(2, nrow(nb_bike), replace = TRUE, prob = c(0.8, 0.2))
df_train <- nb_bike[ind == 1,]
df_test <- nb_bike[ind == 2,]
model <- naive_bayes(weather ~ ., data = df_train, laplace=3)
plot(model)
Wenn wir uns das Modell im Detail/Output anschauen, dann sehen wir hier auch die “Zähltabelle” für kategorielle variablen (hier habe ich nur stetige variablen, drum wurden nur mean/sd berechnet, die eine Gauss-Verteilung repräsentiert, eine Dichtefunktion wird somit berechnet). Vorhersage und Confusion Matrix wird erstellt.
library(caret)
p <- predict(model, df_train[, 2:ncol(df_train)])
confusionMatrix(df_train[,"weather"],p)## Confusion Matrix and Statistics
##
## Reference
## Prediction clear mist + cloudy light rain/snow heavy rain
## clear 8375 729 1 0
## mist + cloudy 2703 889 52 0
## light rain/snow 501 564 77 0
## heavy rain 0 2 1 0
##
## Overall Statistics
##
## Accuracy : 0.6723
## 95% CI : (0.6644, 0.6801)
## No Information Rate : 0.8334
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.2044
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: clear Class: mist + cloudy Class: light rain/snow
## Sensitivity 0.7233 0.40705 0.587786
## Specificity 0.6847 0.76473 0.922619
## Pos Pred Value 0.9198 0.24396 0.067426
## Neg Pred Value 0.3310 0.87366 0.995765
## Prevalence 0.8334 0.15719 0.009429
## Detection Rate 0.6028 0.06398 0.005542
## Detection Prevalence 0.6553 0.26227 0.082194
## Balanced Accuracy 0.7040 0.58589 0.755202
## Class: heavy rain
## Sensitivity NA
## Specificity 0.9997841
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0.0000000
## Detection Rate 0.0000000
## Detection Prevalence 0.0002159
## Balanced Accuracy NADie Vorhersage auf Basis der Trainingsdaten ist “solala” und auf Basis der Test-Daten auch nicht viel besser. Dies kann man an der “Accuracy” von 0.6723 ablesen.
p_test <- predict(model, df_test[, 2:ncol(df_test)])
confusionMatrix(df_test[,"weather"],p_test)## Confusion Matrix and Statistics
##
## Reference
## Prediction clear mist + cloudy light rain/snow heavy rain
## clear 2113 195 0 0
## mist + cloudy 665 222 13 0
## light rain/snow 129 127 21 0
## heavy rain 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.676
## 95% CI : (0.6602, 0.6916)
## No Information Rate : 0.8341
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.203
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: clear Class: mist + cloudy Class: light rain/snow
## Sensitivity 0.7269 0.4081 0.617647
## Specificity 0.6626 0.7695 0.925819
## Pos Pred Value 0.9155 0.2467 0.075812
## Neg Pred Value 0.3254 0.8754 0.995948
## Prevalence 0.8341 0.1561 0.009756
## Detection Rate 0.6063 0.0637 0.006026
## Detection Prevalence 0.6623 0.2582 0.079484
## Balanced Accuracy 0.6947 0.5888 0.771733
## Class: heavy rain
## Sensitivity NA
## Specificity 1
## Pos Pred Value NA
## Neg Pred Value NA
## Prevalence 0
## Detection Rate 0
## Detection Prevalence 0
## Balanced Accuracy NAAber immerhin verhalten sich die Testdaten “ähnlich” wie die Trainingsdaten.
5.1.5 rpart auf bike
Die Library wird geladen. Da wir voher schon den Trainings- und Testdatensatz erstellt haben, können wir direkt das Modell laufen lassen.
library(rpart)
fit <- rpart(weather ~ ., method="class", data=df_train, cp=0.001)
printcp(fit) # display the results##
## Classification tree:
## rpart(formula = weather ~ ., data = df_train, method = "class",
## cp = 0.001)
##
## Variables actually used in tree construction:
## [1] humidity temp windspeed
##
## Root node error: 4789/13894 = 0.34468
##
## n= 13894
##
## CP nsplit rel error xerror xstd
## 1 0.0250574 0 1.00000 1.00000 0.011698
## 2 0.0133640 2 0.94989 0.95239 0.011558
## 3 0.0087701 3 0.93652 0.94362 0.011531
## 4 0.0085613 4 0.92775 0.94320 0.011529
## 5 0.0037586 5 0.91919 0.94028 0.011520
## 6 0.0020881 6 0.91543 0.92900 0.011483
## 7 0.0019837 9 0.90812 0.92525 0.011471
## 8 0.0017749 13 0.90019 0.92190 0.011460
## 9 0.0013573 16 0.89455 0.91856 0.011449
## 10 0.0010441 20 0.88849 0.91940 0.011452
## 11 0.0010000 23 0.88536 0.91815 0.011448plotcp(fit) # visualize cross-validation results
# summary(fit) In der Summary wird der CP (Complexity Parameter) angegeben. Es wird verzweigt, sodass neue Klasse/Knoten entstehen, die mehr von der jeweiligen Klasse aufweisen (mehr “Reinheit”). Der Entscheidungsbaum ist wie ein “Sieb”. Hier gibt es noch die Begriffe Entrophie und Gini-Koeffizient, auf dessen Basis die Reinheit/Unreinheits-Knotenaufteilung erfolgt. Dies Aufteilung sieht man auf Basus der primary Splits und der weiteren Angaben in der Summary, die hier nicht dargestellt werden.
Die Baumstruktur ergibt sich wie folgt.
# plot tree
plot(fit, uniform=TRUE, main="Classification Tree for Bike (Weather)")
Und schliesslich prüfen wir wieder die Vorhersage des Modells.
p <- predict(fit, df_test[, -1], type = c("prob"))
fitted.results <- ifelse(p[,2] > 0.5,1,0)
table(fitted.results, df_test$weather)##
## fitted.results clear mist + cloudy light rain/snow heavy rain
## 0 2282 880 270 0
## 1 26 20 7 05.2 Übungsaufgaben
5.2.1 Under-/Down-Sampling
library(MASS)
library(caret)
summary(biopsy$class)## benign malignant
## 458 241downSample <- downSample(biopsy, biopsy$class)
summary(downSample$class)## benign malignant
## 241 241upSample <- upSample(biopsy, biopsy$class)
summary(upSample$class)## benign malignant
## 458 4585.2.2 rpart auf kyphosis Datensatz
5.3 Studierendenfragen
- angewendet auf den Bike-Datensatz: was genau sagen uns die beiden Modelle?
6 Text Mining
6.1 Allgemeines
- Semi-Automatisierter Prozess auf Basis von Texten
- Fokus: Kerninformationen finden
- Vorgehen
- Problem und Ziele definieren
- Daten/Text sammeln
- Daten aufbereiten
- Tokenisieren
- Grundformen, Stopword etc.
- Analysieren und interpretieren
- Abgrenzung zu NLP
- NLP inkl. Semantik (Verstehen des Textes, Bedeutung der Wörter)
- NLP inkl. Audio und für Übersetzungen und weiterführende Anwendungen
- Sentiments berücksichtigen die Bedeutungsrichtung von Wörtern (positiv, negativ etc.)
6.2 Hausaufgaben
6.2.1 Word Embeddings und PCA
Word Embeddings respräsentieren Wörter mit “gleicher” Bedeutung in einem n-Dimensionalen Raum, sodass Men/Women und Kind/Queen oder walk/walked und swim/swam “gleichartig” repräsentiert werden
6.2.2 skip_ngrams und nnest_tokens
6.2.3 Wordcloud
6.2.4 Sentiment-Anayse in der Praxis
Produktanalysen, gesellschaftliche Fragestellungen etc.