data > opinion

Tom Alby

Notebook zum Vortrag an der FH Würzburg

2021-04-14


Einführung

In diesem Notebook werden die verschiedenen im Vortrag erwähnten Machine Learning-Algorithmen und ihre Anwendungen vorgestellt.

Unsupervised Learning

Hierarchical Clustering

In diesem ersten Beispiel haben wir eine Reihe von Studierenden mit den Merkmalen Alter, Semester und Note in einem Seminar (natürlich rein erfunden).

data <- read.csv("https://tom.alby.de/post/students.csv")
data
##   age term grade
## 1  22    4     1
## 2  22    5     3
## 3  21    3     5
## 4  23    5     1
## 5  27   10     5
## 6  26    4     3
## 7  26    8     4
## 8  20    2     1

Mit der Euklidischen Distanz soll einmal die Distanz zwischen den ersten beiden Studierenden berechnet werden:

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

Netterweise übernimmt diese Berechnung die dist()-Funktion für uns:

d <- dist(data)
d
##           1         2         3         4         5         6         7
## 2  2.236068                                                            
## 3  4.242641  3.000000                                                  
## 4  1.414214  2.236068  4.898979                                        
## 5  8.774964  7.348469  9.219544  7.549834                              
## 6  4.472136  4.123106  5.477226  3.741657  6.403124                    
## 7  6.403124  5.099020  7.141428  5.196152  2.449490  4.123106          
## 8  2.828427  4.123106  4.242641  4.242641 11.357817  6.633250  9.000000

Allerdings hat dieser Ansatz noch einen Schönheitsfehler, denn wenn eine Variable höhere Werte als die andere Variable hat wie in diesem Beispiel, so können die höheren Werte das Ergebnis dominieren. Daher werden die Daten in der Regel zunächst einmal normalisiert:

(d <- dist(scale(data), method="euclidean"))
##           1         2         3         4         5         6         7
## 2 1.2184170                                                            
## 3 2.3779626 1.4354168                                                  
## 4 0.5379931 1.2196440 2.5540196                                        
## 5 3.7651869 2.9286913 3.5045129 3.3593538                              
## 6 1.9185262 1.5756421 2.2671331 1.6734595 2.5775069                    
## 7 2.7656735 1.9909188 2.7515894 2.3712641 1.0268561 1.6207682          
## 8 1.0759863 1.7930913 2.3779626 1.6139794 4.6578966 2.6791631 3.6657444

Nun kann das Ergebnis in einem Dendrogram geplottet werden:

hc <- hclust(d)
# Und nun der Plot
plot(hc)

Die Abstände auf der Y-Achse zeigen die Entfernungen der Cluster voneinander.

Association Rules

Association Rules sind ein sehr bekannter Algorithmus, der häufig dazu verwendet wird, Produkte anzuzeigen, die andere Nutzer mit einem ähnlichen Einkaufskorb gekauft haben.

data("Groceries")

Daraus werden die einzelnen Regeln identifiziert:

basket_rules <- apriori(Groceries, parameter = list(sup = 0.04, conf = 0.06, target="rules"))
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##        0.06    0.1    1 none FALSE            TRUE       5    0.04      1
##  maxlen target  ext
##      10  rules TRUE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 393 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[169 item(s), 9835 transaction(s)] done [0.00s].
## sorting and recoding items ... [32 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [38 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].

Schauen wir uns diese Regeln einmal genauer an:

myRules_Direct <- as(basket_rules, "data.frame");
myRules_Direct %>%
  filter(lift > 1.1) %>%
  arrange(desc(lift)) %>%
  head() %>%
  kable()
rules support confidence coverage lift count
{root vegetables} => {other vegetables} 0.0473818 0.4347015 0.1089985 2.246605 466
{other vegetables} => {root vegetables} 0.0473818 0.2448765 0.1934926 2.246605 466
{whole milk} => {root vegetables} 0.0489070 0.1914047 0.2555160 1.756031 481
{root vegetables} => {whole milk} 0.0489070 0.4486940 0.1089985 1.756031 481
{yogurt} => {other vegetables} 0.0434164 0.3112245 0.1395018 1.608457 427
{other vegetables} => {yogurt} 0.0434164 0.2243826 0.1934926 1.608457 427

Jede Regel kommt mit mehreren Metriken:

  • Support: Die Anzahl der Transaktionen mit dieser Item-Kombination geteilt durch alle Transaktionen, ungeachtet dessen, ob weitere Items in der Transaktion waren. Die Kombination {POPPY’S PLAYHOUSE BEDROOM } => {POPPY’S PLAYHOUSE KITCHEN} kommt 180 Mal vor.
  • Confidence: hat nichts mit der Konfidenz aus Signifikanztests zu tun. Hier geht es um den Support für das gleichzeitige Auftreten aller Items in einer Regel, bedingt nur durch den Support für das Left-hand Set. Dies wird so berechnet: \(confidence(X ⇒Y)=\frac{support(X ∩ Y)}{support(X)}\); in dem Beispiel für {POPPY’S PLAYHOUSE BEDROOM } => {POPPY’S PLAYHOUSE KITCHEN} könnte man das so ausdrücken: {POPPY’S PLAYHOUSE KITCHEN} taucht in 51.7% der Fälle auf, wo auch {POPPY’S PLAYHOUSE BEDROOM } auftaucht.
  • Lift: Diese Metrik gibt an, wie viel häufiger ein Set auftaucht als wir erwarten würden, wenn die Items unabhängig voneinander wären. Berechnet wird der Lift wie folgt: \(lift(X ⇒Y) = \frac{support(X ∩ Y)}{(support(X) * support(Y))}\). Die Kombination {POPPY’S PLAYHOUSE BEDROOM } => {POPPY’S PLAYHOUSE KITCHEN} erscheint >15x häufiger als wir erwarten würde, wenn sie unabhängig voneinander wären.

Diese drei Metriken sind im Zusammenspiel wichtig, denn zum einen möchte man Items-Sets “minen”, die häufig genug auftauchen, dass sie auch geschäftlich sinnvoll sind. Zum andern möchte man eine starke Assoziation sehen, die in der Confidence abgebildet ist. Allerdings kann diese auch irreführend sein, wenn wir uns zum Beispiel die Items Apfel und Bier ansehen. Sie werden häufig zusammen gekauft, aber das kann auch einfach daran liegen, dass diese Items generell häufig gekauft werden. Diesen Effekt kann die Metrik Lift lindern.

Supervised Learning

Ein typisches Beispiel für Supervised Learning: Spam Detection

Die Daten stammen aus einem Uni-Projekt, es handelt sich um SMS-Nachrichten und SMS-Spam.

rawdata <- read.csv("https://raw.githubusercontent.com/stedy/Machine-Learning-with-R-datasets/master/sms_spam.csv",stringsAsFactors=FALSE)
names(rawdata) <- c("Class","Message")
kable(head(rawdata))
Class Message
ham Go until jurong point, crazy.. Available only in bugis n great world la e buffet… Cine there got amore wat…
ham Ok lar… Joking wif u oni…
spam Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question(std txt rate)T&C’s apply 08452810075over18’s
ham U dun say so early hor… U c already then say…
ham Nah I don’t think he goes to usf, he lives around here though
spam FreeMsg Hey there darling it’s been 3 week’s now and no word back! I’d like some fun you up for it still? Tb ok! XxX std chgs to send, £1.50 to rcv
NumberOfChar <- as.numeric(lapply(rawdata$Message,FUN=nchar))
number.digits <- function(vect) {
    length(as.numeric(unlist(strsplit(gsub("[^0-9]", "", unlist(vect)), ""))))
}
NumberOfDigits <- as.numeric(lapply(rawdata$Message,FUN=number.digits))

Die Daten müssen zunächst einmal gesäubert werden, es werden Zahlen, Satzzeichen und Großbuchstaben entfernt:

clean.text = function(x)
{ 
  x = tolower(x)
  x = gsub("[[:punct:]]", "", x)
  x = gsub("[[:digit:]]", "", x)
  x = gsub("[ |\t]{2,}", "", x)
  x = gsub("^ ", "", x)
  x = gsub(" $", "", x)
  x = removeWords(x,stopwords("en"))
  return(x)
}

cleanText <- clean.text(rawdata$Message)

Nun wird ein Corpus gebaut und ein Dokumenten-Term-Matrix daraus erstellt:

corpus <- Corpus(VectorSource(cleanText))

tdm <- DocumentTermMatrix(corpus)
tdm.df <- as.data.frame(data.matrix(tdm),stringsAsFactors=FALSE)
tdm.new <- tdm.df[,colSums(tdm.df) > 2]

Zum Schluss werden die Daten in ein Test- und ein Trainingsset aufgeteilt:

cleandata <- cbind("Class" = rawdata$Class, NumberOfChar, NumberOfDigits, tdm.new)

cleandata$Class <- as.factor(cleandata$Class)

set.seed(1234)
inTrain <- createDataPartition(cleandata$Class,p=0.8,list=FALSE)
train <- cleandata[inTrain,]
test <- cleandata[-inTrain,]

Support Vector Machines

SVMs versuchen eine optimale Grenzlinie zwischen zwei Gruppen von Datenpunkten zu finden:

## Linear Kernel
svm.linear <- svm(Class~., data=train, scale=FALSE, kernel='linear', type = "C")
pred.linear <- predict(svm.linear, test)
confusionMatrix(pred.linear,test$Class)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  963    8
##       spam   2  141
##                                           
##                Accuracy : 0.991           
##                  95% CI : (0.9836, 0.9957)
##     No Information Rate : 0.8662          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9606          
##                                           
##  Mcnemar's Test P-Value : 0.1138          
##                                           
##             Sensitivity : 0.9979          
##             Specificity : 0.9463          
##          Pos Pred Value : 0.9918          
##          Neg Pred Value : 0.9860          
##              Prevalence : 0.8662          
##          Detection Rate : 0.8645          
##    Detection Prevalence : 0.8716          
##       Balanced Accuracy : 0.9721          
##                                           
##        'Positive' Class : ham             
## 

In diesem Output ist zunächst die Confusion Matrix spannend, sie zeigt an wie viele False Negatives und False Positives es gab. Darunter ist die Accuracy zu sehen.

Naive Bayes

IN diesem Algorithmus geht es ausnahmsweise mal nicht um Distanzen wie bei dem Hierarchical Clustering oder den Support Vector Machines. Nehen wir nun an, dass H eine Hypothese ist (etwas ist Spam oder nicht) und E eine Evidenz, 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 in unserem Datensatz jedes Wort (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)}\]

Naive Bayes kann nicht mit numerischen Daten umgehen, daher müssen diese umgewandelt werden:

convert_counts <- function(x){
  x <- ifelse(x > 0, "Yes", "No")
}

#apply to train and test reduced DTMs, applying to column
train2 <- cbind(train[1:3], apply(train[4:2499], 2, convert_counts))
test2 <- cbind(test[1:3], apply(test[4:2499], 2, convert_counts))

Nun beginnt die Klassifikation

classifier <- naiveBayes(Class~., data=train2)
test_pred <- predict(classifier, test2)
confusionMatrix(test_pred,test$Class)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  957    5
##       spam   8  144
##                                           
##                Accuracy : 0.9883          
##                  95% CI : (0.9801, 0.9938)
##     No Information Rate : 0.8662          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9501          
##                                           
##  Mcnemar's Test P-Value : 0.5791          
##                                           
##             Sensitivity : 0.9917          
##             Specificity : 0.9664          
##          Pos Pred Value : 0.9948          
##          Neg Pred Value : 0.9474          
##              Prevalence : 0.8662          
##          Detection Rate : 0.8591          
##    Detection Prevalence : 0.8636          
##       Balanced Accuracy : 0.9791          
##                                           
##        'Positive' Class : ham             
## 

Dieser Algorithmus hat eine etwas geringere Accuracy als die SVM.