data > opinion

Tom Alby

5 Klassifikation & Clustering


Sie sind hier: start / lehrveranstaltungen / datenanalyse data science machine learning / 05 segmentierung /

Segmentierung: Klassifikation und Clustering

## ── Attaching packages ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.0     ✓ purrr   0.3.4
## ✓ tibble  3.0.1     ✓ dplyr   0.8.5
## ✓ tidyr   1.0.3     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0
## ── Conflicts ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

Warum überhaupt segmentieren?

Besonders in der Marketing-Welt wird häufig über Segmentierung gesprochen, denn je besser ein Werbemittel auf eine Zielgruppe abgestimmt ist, desto wirkungsvoller ist es. Dazu müssen Zielgruppen aber auch erst einmal identifiziert und gegebenenfalls untereinander abgegrenzt werden.

Die folgende Definition von Segmentierung stammt aus @chapman2015:

The general goal of market segmentation is to find groups of customers that differ in important ways associated with product interest, market participation, or response to marketing efforts. By understanding the differences among groups, a marketer can make better strategic choices about opportunities, product definition, and positioning, and can engage in more effective promotion.

Segmentierung ist aber nicht nur für Marketing-Zwecke interessant, sondern auch für andere Bereiche. Jeder Spam-Filter basiert auf einer Art Klassifikation. Und damit sind wir schon bei einer wichtigen Unterscheidung: Segmentierung, also das Einteilen in Gruppen, ist der Oberbegriff, unter dem sich zwei verschiedene Ansätze tummeln, das Clustering und die Klassifikation.

Clustering und Unsupervised Learning

Beim Clustering wird eine Zugehörigkeit zu einer Gruppe entdeckt. Mit anderen Worten, wir wissen eventuell noch nicht, welche Gruppen überhaupt existieren (auch wenn wir vielleicht eine Vermutung haben). Clustering würde bei dem Beispiel Spam-Mails nicht funktionieren, denn hier benötigt der Algorithmus Beispiele, was als Spam betrachtet wird und was nicht. Clustering könnte eventuell herausfinden, dass es verschiedene Arten von E-Mails gibt, wüsste aber nicht, was davon Spam ist.

Clustering ist ein gutes Beispiel für Unsupervised Learning. Beim Unsupervised Machine Learning wird keine Zielvariable vorgegeben. Anstattdessen soll die Maschine selbst Muster finden auf Basis der Daten. Eine Fragestellung könnte zum Beispiel sein, ob Kunden Merkmalsausprägungen haben, durch die sie in Gruppen unterteilt werden können.

Klassifikation und Supervised Learning

Bei einer Klassifikation wird die Zugehörigkeit zu einer Gruppe vorhergesagt. Das heißt, die Gruppen sind bereits bekannt, aber bei einem neuen Element ist noch nicht klar, zu welcher Gruppe das Element gehört. Klassifikation ist ein gutes Beispiel für Supervised Learning. Bei dieser Art von Machine Learning wird eine Zielvariable vorgegeben, und der Algorithmus versucht herauszufinden, mit welchen Parametern diese Zielvariable erreicht werden kann.

Hierarchisches Clustering

Hierarchisches Clustering ist ein populärer Ansatz des Unsupervised Machine Learnings. Zunächst laden wir eine Library für das Clustering:

library(cluster)

Dann wählen wir aus dem Flights-Datensatz 3 Spalten aus; wir wollen schauen, ob hier Muster auffindbar sind, und dazu entfernen wir alle Reihen, in denen ein NA auftaucht. (Die folgenden beiden Zeilen sind nur aus logistischen Gründen drin; da das Sample bei jeder Änderung im Skript neu generiert wird, passt der Text irgendwann nicht mehr zu den Zahlen :) )

#write_csv(df_sample,path="flights_sample.csv")
df_sample <- read_csv("flights_sample.csv")
## Parsed with column specification:
## cols(
##   engines = col_double(),
##   seats = col_double(),
##   distance = col_double()
## )

Im nächsten Schritt berechnen wir eine Distanzmatrix (die werden gleich erklärt), erstellen die Cluster und plotten diese:

seg.dist <- dist(df_sample)
seg.hc <- hclust(seg.dist, method="complete")
plot(seg.hc)

Aus dem Dendrogram nehmen wir einzelne Datenpunkte heraus, hier einige aus dem linken Ast:

df_sample[c(88, 18,42,14,2,41), ]
## # A tibble: 6 x 3
##   engines seats distance
##     <dbl> <dbl>    <dbl>
## 1       2   255     2586
## 2       2   178     2586
## 3       2   200     2521
## 4       2   178     2402
## 5       2   182     2475
## 6       2   189     2454

Und hier einige aus dem rechten Ast:

df_sample[c(45, 63, 40, 47,1,26), ]
## # A tibble: 6 x 3
##   engines seats distance
##     <dbl> <dbl>    <dbl>
## 1       2   145     1035
## 2       2   149      997
## 3       2    80     1107
## 4       2   149     1167
## 5       1     2     1005
## 6       2    20     1023

Offensichtlich hat der Cluster-Algorithmus etwas gefunden: In dem einen Cluster sind eher Flieger mit weniger Sitzen, die kürzere Distanzen fliegen, und in dem anderen Cluster Flieger mit mehr Sitzen, die weitere Distanzen geflogen sind. Ganz überraschend ist das nicht, es zeigt aber, wie gut der Ansatz funktioniert. Aber was genau ist hier passiert?

Die Distanzmatrix spielt hier eine elementare Rolle, denn in ihr werden, wie der Name schon sagt, Distanzen zwischen den einzelnen Datenpunkten berechnet. Das soll an einem vereinfachten Beispiel erläutert werden. Der folgende Datensatz beinhaltet das Alter und die Noten von Studierenden, natürlich völlig fiktiv.

(age_grades <- data.frame(age = c(22,22,21,23,27,27,26,20), grades = c(1,3,5,1,5,3,4,1)))
##   age grades
## 1  22      1
## 2  22      3
## 3  21      5
## 4  23      1
## 5  27      5
## 6  27      3
## 7  26      4
## 8  20      1

Für die Berechnung wird die euklidische Distanz verwendet, Beispiel Datenpunkt 1 (22,1) und Datenpunkt 2 (22,3):

\[\sqrt{(22-22)^2 + (1-3)^2}\]

Beispiel Datenpunkt 1 (22,1) und Datenpunkt 3 (21,5): \[\sqrt{(22-21)^2 + (1-5)^2} = \sqrt{(1 + 16)} = 4,123106\]

(age_grades.dist <- dist(age_grades, method="euclidean"))
##          1        2        3        4        5        6        7
## 2 2.000000                                                      
## 3 4.123106 2.236068                                             
## 4 1.000000 2.236068 4.472136                                    
## 5 6.403124 5.385165 6.000000 5.656854                           
## 6 5.385165 5.000000 6.324555 4.472136 2.000000                  
## 7 5.000000 4.123106 5.099020 4.242641 1.414214 1.414214         
## 8 2.000000 2.828427 4.123106 3.000000 8.062258 7.280110 6.708204
age_grades.hc <- hclust(age_grades.dist, method = "complete")
plot(age_grades.hc)

Das Dendrogramm ist so zu lesen, dass auf der y-Achse die Entfernungen zwischen den Clustern gezeigt werden; die Abstände auf der x-Achse haben nichts zu sagen.

Schauen wir uns das mal mit 3 Vektoren an:

(age_grades <- data.frame(age = c(22,22,21,23,27,27,26,20), grades = c(1,3,5,1,5,3,4,1), term = c(2,2,1,4,9,10,8,1)))
##   age grades term
## 1  22      1    2
## 2  22      3    2
## 3  21      5    1
## 4  23      1    4
## 5  27      5    9
## 6  27      3   10
## 7  26      4    8
## 8  20      1    1

Auch hier wird wieder die euklidische Distanz berechnet, Beispiel Datenpunkt 1 (22,1,2) und Datenpunkt 2 (22,3,2):

\[\sqrt{((22-22)^2 + (1-3)^2 + (2-2)^2)} = \sqrt{(0+4+0)} = 2\]

Netterweise macht R das alles für uns mit der Funktion dist(), so dass wir das nicht selber rechnen müssen.

(age_grades.dist <- dist(age_grades, method="euclidean"))
##           1         2         3         4         5         6         7
## 2  2.000000                                                            
## 3  4.242641  2.449490                                                  
## 4  2.236068  3.000000  5.385165                                        
## 5  9.486833  8.831761 10.000000  7.549834                              
## 6  9.643651  9.433981 11.000000  7.483315  2.236068                    
## 7  7.810250  7.280110  8.660254  5.830952  1.732051  2.449490          
## 8  2.236068  3.000000  4.123106  4.242641 11.357817 11.575837  9.695360

Auch diese Daten plotten wir in ein Dendrogramm:

age_grades.hc <- hclust(age_grades.dist, method = "complete")
plot(age_grades.hc)

Die Cluster sind immer noch ähnlich aufgeteilt, haben sich aber leicht verschoben.

Klassifikation: Naive Bayes

Jedes Klassifikations-Projekt beinhaltet mindestens die folgenden Schritte:

  • Es wird ein Datensatz erstellt, in dem die Klasse eines Objekts bekannt ist, sei es dadurch, dass das Verhalten beobachtet wurde oder Menschen die Klasse manuell bestimmt haben. Auch Clustering kann hier eine Rolle gespielt haben.
  • Die Daten werden in zwei Teile geteilt, Trainings-Daten und Test-Daten. Je nach Literatur werden unterschiedliche Verhältnisse empfohlen, von 50% für das Trainings-Set bis zu 80%. Ein besonderes Konzept ist der Cross-Validation, auf das später eingegangen wird.
  • Mit den Trainings-Daten wird ein Prognosemodell erstellt.
  • Die Leistung des Models wird mit den Test-Daten beurteilt; dabei wird darauf geachtet, dass das Model eine bessere Leistung erbringen muss als der Zufall. Nicht selten

In dem folgenden Beispiel wird Naive Bayes verwendet. Dazu ein bisschen mathematischer Hintergrund. Die Wahrscheinlichkeit, dass A auftritt, wird in dem Ausdruck p(A) beschrieben (p für Probability). Die Wahrscheinlichkeit, dass A und B zusammen auftauchen, wird mit dem Ausdruck p(AB) beschrieben. Am Beispiel eines Würfels:

\[p(AB) = p(A) * p(B)\]

Die Wahrscheinlichkeit, dass nach einer 6 eine 1 gewürfelt wird, ist

\[p(AB) = \frac{1}{6} * \frac{1}{6} = \frac{1}{36}\] denn das Ergebnis des zweiten Wurfs ist unabhängig vom Ergebnis des ersten Wurfs. Anders sieht es aus, wenn der Würfel gezinkt ist. Um auch diese Möglichkeit einzubeziehen, wird die Formel leicht geändert:

\[p(AB) = p(A) · p(B | A)\]

Es spielt übrigens keine Rolle, ob

\[p(A) · p(B | A)\] oder \[p(B) · p(A | B)\] Daher können wir auch schreiben:

\[p(A) · p(B | A) = p(B) · p(A | B)\]

Teilt man nun beide Teile durch p(A), so ergibt sich die folgende Formel:

\[p(B|A)= \frac{p(A|B)·p(B)} {p(A)}\]

Nehen wir nun an, dass A eine Evidenz ist und B unsere Hypothese, dann kommen wir zum Satz von Bayes:

\[p(H|E)= \frac{p(E|H)·p(H)} {p(E)}\]

Naive Bayes sieht wie folgt aus, basierend darauf, dass häufig mehrere Konditionen verwendet werden, zum Beispiel im Titanic-Datensatz Geschlecht, Alter und Klasse (hier als \(e_1, e_2, ... e_k\) aufgeführt):

\[p(c|E) = \frac{p(e_1|c) * p(e_2|c) ... p(e_k|c) * p(c)}{p(E)}\]

Es wird übrigens nur deswegen “Naive” genannt, weil von der Unabhängigkeit der Ereignisse ausgegangen wird.

Für ein Beispiel mit Naive Bayes wird ein Datensatz von der Titanic verwendet. Wir wollen herausfinden, ob wir vorhersagen können, ob jemand das Unglück überlebt oder nicht.

data("Titanic")
Titanic_df=as.data.frame(Titanic)
head(Titanic_df)
##   Class    Sex   Age Survived Freq
## 1   1st   Male Child       No    0
## 2   2nd   Male Child       No    0
## 3   3rd   Male Child       No   35
## 4  Crew   Male Child       No    0
## 5   1st Female Child       No    0
## 6   2nd Female Child       No    0

Beginnen wir mit einem einfachen Beispiel, in dem wir nur ein Feature aufnehmen, und zwar das Geschlecht. Umgangssprachlich könnte man das so ausdrücken:

\[p(Survived|Mann) = \frac{p(Mann|Survived) · p(Survived)}{p(Mann)}\]

Titanic_df %>%
  select(Sex,Survived,Freq) %>%
  filter(Sex == "Male") %>%
  group_by(Survived) %>%
  summarize(n = sum(Freq))
## # A tibble: 2 x 2
##   Survived     n
##   <fct>    <dbl>
## 1 No        1364
## 2 Yes        367
Titanic_df %>%
  select(Survived,Freq) %>%
  group_by(Survived) %>%
  summarize(n = sum(Freq))
## # A tibble: 2 x 2
##   Survived     n
##   <fct>    <dbl>
## 1 No        1490
## 2 Yes        711

In die Formel eingesetzt:

\[p(Survived|Mann) = \frac{0.212 · 0.323}{0.786} = 0.0871\]

Die Daten im Titanic-Datensatz sind nur aggregiert, hier wird sozusagen x-Mal eine Zeile wiederholt. Schauen wir uns zum Beispiel die Zeile 3 an, “3rd Male Child No 35”: Diese eine Zeile für 35 männliche Kinder in der 3. Klasse wird nun 35 Mal wiederholt, so dass aus den 32 Zeilen des Datensatzes insgesamt 2.201 Zeilen werden:

repeating_sequence=rep.int(seq_len(nrow(Titanic_df)), Titanic_df$Freq) 
Titanic_dataset=Titanic_df[repeating_sequence,]
Titanic_dataset$Freq=NULL
summary(Titanic_dataset)
##   Class         Sex          Age       Survived  
##  1st :325   Male  :1731   Child: 109   No :1490  
##  2nd :285   Female: 470   Adult:2092   Yes: 711  
##  3rd :706                                        
##  Crew:885

Der Datensatz wird in Trainings- und Test-Daten geteilt. Hierfür verwenden wir eine spezielle Library, Caret, denn wir wollen, dass in unseren Samples das Feature “Survived” gleichmäßig ausgeprägt ist.

library(caret)
## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
set.seed(2425)
trainIndex=createDataPartition(Titanic_dataset$Survived, p=0.8)$Resample1
train.data=Titanic_dataset[trainIndex, ]
test.data=Titanic_dataset[-trainIndex, ]

## check the balance
print(table(Titanic_dataset$Survived))
## 
##   No  Yes 
## 1490  711

Die Library e1071 wird für die Verwendung von Naive Bayes geladen; das Trainieren startet mit einem einfachen Befehl:

library(e1071)

#Fitting the Naive Bayes model
Naive_Bayes_Model=naiveBayes(Survived ~., data=train.data)
#What does the model say? Print the model summary
Naive_Bayes_Model
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##        No       Yes 
## 0.6768881 0.3231119 
## 
## Conditional probabilities:
##      Class
## Y            1st        2nd        3rd       Crew
##   No  0.08557047 0.11996644 0.35654362 0.43791946
##   Yes 0.28646749 0.17398946 0.24780316 0.29173989
## 
##      Sex
## Y          Male    Female
##   No  0.9135906 0.0864094
##   Yes 0.5096661 0.4903339
## 
##      Age
## Y          Child      Adult
##   No  0.03271812 0.96728188
##   Yes 0.08084359 0.91915641

Nun wird das Modell auf die Test-Daten “geworfen”:

Titanic.class <- predict(Naive_Bayes_Model, test.data)
table(Titanic.class, test.data$Survived)
##              
## Titanic.class  No Yes
##           No  275  74
##           Yes  23  68
prop.table(table(Titanic.class))
## Titanic.class
##        No       Yes 
## 0.7931818 0.2068182

Nun schauen wir uns die Genauigkeit unseres Modells an:

mean(test.data$Survived==Titanic.class)
## [1] 0.7795455

Mit cbind können wir uns die Prediction zusammen mit den Originaldaten sehen und somit sehen, wo der Algorithmus richtig und wo er falsch gelegen hat.

head(model.results <- cbind(test.data,Titanic.class),50)
##        Class    Sex   Age Survived Titanic.class
## 3.2      3rd   Male Child       No            No
## 3.4      3rd   Male Child       No            No
## 3.6      3rd   Male Child       No            No
## 3.8      3rd   Male Child       No            No
## 3.9      3rd   Male Child       No            No
## 3.17     3rd   Male Child       No            No
## 3.32     3rd   Male Child       No            No
## 3.33     3rd   Male Child       No            No
## 7        3rd Female Child       No           Yes
## 7.5      3rd Female Child       No           Yes
## 7.7      3rd Female Child       No           Yes
## 7.14     3rd Female Child       No           Yes
## 7.16     3rd Female Child       No           Yes
## 9.3      1st   Male Adult       No            No
## 9.13     1st   Male Adult       No            No
## 9.16     1st   Male Adult       No            No
## 9.26     1st   Male Adult       No            No
## 9.32     1st   Male Adult       No            No
## 9.35     1st   Male Adult       No            No
## 9.37     1st   Male Adult       No            No
## 9.39     1st   Male Adult       No            No
## 9.44     1st   Male Adult       No            No
## 9.51     1st   Male Adult       No            No
## 9.52     1st   Male Adult       No            No
## 9.53     1st   Male Adult       No            No
## 9.54     1st   Male Adult       No            No
## 9.61     1st   Male Adult       No            No
## 9.62     1st   Male Adult       No            No
## 9.71     1st   Male Adult       No            No
## 9.86     1st   Male Adult       No            No
## 9.100    1st   Male Adult       No            No
## 9.102    1st   Male Adult       No            No
## 9.108    1st   Male Adult       No            No
## 10.2     2nd   Male Adult       No            No
## 10.15    2nd   Male Adult       No            No
## 10.19    2nd   Male Adult       No            No
## 10.31    2nd   Male Adult       No            No
## 10.36    2nd   Male Adult       No            No
## 10.46    2nd   Male Adult       No            No
## 10.47    2nd   Male Adult       No            No
## 10.55    2nd   Male Adult       No            No
## 10.56    2nd   Male Adult       No            No
## 10.64    2nd   Male Adult       No            No
## 10.72    2nd   Male Adult       No            No
## 10.86    2nd   Male Adult       No            No
## 10.94    2nd   Male Adult       No            No
## 10.95    2nd   Male Adult       No            No
## 10.103   2nd   Male Adult       No            No
## 10.119   2nd   Male Adult       No            No
## 10.130   2nd   Male Adult       No            No

Auch kann für jedes Segment überprüft werden, wie gut der Klassifikator gearbeitet hat.

table(Titanic.class, test.data$Class)
##              
## Titanic.class 1st 2nd 3rd Crew
##           No   29  22 104  194
##           Yes  31  21  36    3

Klassifikation: Support Vector Machines

Das Prinzip der Support Vector Machines basiert wieder auf Distanzen. In einer Menge von Punkten wird versucht eine Fläche zu ziehen. Anstatt einer Linie, die in verschiedenen Winkeln durch die Punkte gezogen werden könnte, werden stattdessen um die Linie herum Parallel-Linien gezogen. Nun wird geschaut, wie weit die Parallel-Linien von der Hauptlinie entfernt sein können, so dass möglichst wenig Fehler entstehen.

Damit das funktioniert, müssen wir die Daten etwas umwandeln, denn mit nicht-numerischen Daten können keine Distanzen berechnet werden.

titanic.data.num <- Titanic_dataset %>%
  mutate(Age = ifelse(Age == "Child",1,2)) %>%
  mutate(Sex= ifelse(Sex == "Male", 1,2)) %>%
  mutate(Class = ifelse(Class == "1st", 1,ifelse(Class == "2nd",2,ifelse(Class == "3rd", 3,4))))
set.seed(2425)
trainIndex=createDataPartition(titanic.data.num$Survived, p=0.8)$Resample1
train.data=titanic.data.num[trainIndex, ]
test.data=titanic.data.num[-trainIndex, ]

Das Package e1071 bietet auch einen SVM-Klassifikator:

classifier = svm(Survived ~ .,
                 data = train.data,
                 type = 'C-classification',
                 kernel = 'linear')

Wieder nehmen wir die Test-Daten…

# Predicting the Validation set results
svm.predict = predict(classifier, newdata = test.data[,-which(names(test.data)=="Survived")])

…und werfen das entstandene Modell auf die Test-Daten:

# Checking the prediction accuracy
table(test.data$Survived, svm.predict) # Confusion matrix
##      svm.predict
##        No Yes
##   No  275  23
##   Yes  77  65

Nun rechnen wir wieder die Genauigkeit aus:

error <- mean(test.data$Survived != svm.predict) # Misclassification error
paste('Accuracy',round(1-error,4))
## [1] "Accuracy 0.7727"
head(cbind(test.data,svm.predict), 50)
##     Class Sex Age Survived svm.predict
## 3       3   1   1       No          No
## 5       3   1   1       No          No
## 7       3   1   1       No          No
## 9       3   1   1       No          No
## 10      3   1   1       No          No
## 18      3   1   1       No          No
## 33      3   1   1       No          No
## 34      3   1   1       No          No
## 36      3   2   1       No         Yes
## 41      3   2   1       No         Yes
## 43      3   2   1       No         Yes
## 50      3   2   1       No         Yes
## 52      3   2   1       No         Yes
## 56      1   1   2       No          No
## 66      1   1   2       No          No
## 69      1   1   2       No          No
## 79      1   1   2       No          No
## 85      1   1   2       No          No
## 88      1   1   2       No          No
## 90      1   1   2       No          No
## 92      1   1   2       No          No
## 97      1   1   2       No          No
## 104     1   1   2       No          No
## 105     1   1   2       No          No
## 106     1   1   2       No          No
## 107     1   1   2       No          No
## 114     1   1   2       No          No
## 115     1   1   2       No          No
## 124     1   1   2       No          No
## 139     1   1   2       No          No
## 153     1   1   2       No          No
## 155     1   1   2       No          No
## 161     1   1   2       No          No
## 173     2   1   2       No          No
## 186     2   1   2       No          No
## 190     2   1   2       No          No
## 202     2   1   2       No          No
## 207     2   1   2       No          No
## 217     2   1   2       No          No
## 218     2   1   2       No          No
## 226     2   1   2       No          No
## 227     2   1   2       No          No
## 235     2   1   2       No          No
## 243     2   1   2       No          No
## 257     2   1   2       No          No
## 265     2   1   2       No          No
## 266     2   1   2       No          No
## 274     2   1   2       No          No
## 290     2   1   2       No          No
## 301     2   1   2       No          No

Hier noch ein Beispiel für einen anderen Kernel, eine nicht-lineare Support Vector Machine:

classifier = svm(Survived ~ .,
                 data = train.data,
                 type = 'C-classification',
                 kernel = 'radial')

svm.nlm.predict = predict(classifier, newdata = test.data[,-which(names(test.data)=="Survived")])


table(test.data$Survived, svm.nlm.predict) 
##      svm.nlm.predict
##        No Yes
##   No  293   5
##   Yes  90  52
error <- mean(test.data$Survived != svm.nlm.predict) 
paste('Accuracy',round(1-error,4))
## [1] "Accuracy 0.7841"