data > opinion

Tom Alby

Notebook für Gastvortrag in der Web Intelligence-Vorlesung

2020-05-18


Sie sind hier: start / blog / notebook fuer gastvortrag in der web intelligence vorlesung /

Einführung

In diesem Notebook werden verschiedene Machine Learning-Algorithmen und ihre Anwendung vorgestellt.

library(tidyverse)
library(class)
library(knitr)
library(cluster)
library(arules)
library(caret)
library(e1071)
library(tm)
library(janitor)

Unsupervised Learning

Hierarchical Clustering

In diesem ersten Beispiel haben wir eine Reihe von Studierenden mit den Merkmalen Alter, Semester und Note in einem Seminar.

data <- read.csv("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

Die Aufgabe ist nun, diese Studenten automatisch in Gruppen einzuteilen, was wie bei vielen ML-Algorithmen auf Basis von Distanzen funktioniert. Dazu ist es notwendig, dass die Daten in einem numerischen Format vorliegen, wie es in diesem Beispiel der Fall ist. Für die Berechnung wird die euklidische Distanz verwendet, Beispiel Datenpunkt 1 (22,4,1) und Datenpunkt 2 (22,5,3):

\[\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

Nun kann das Ergebnis in einem Dendrogram geplottet werden.

hc <- hclust(d)
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. Die Daten stammen aus diesem Kaggle-Projekt.

mba_data <- read.csv("mba.csv")
kable(head(mba_data))
InvoiceNo StockCode Description Quantity InvoiceDate UnitPrice CustomerID Country
536365 85123A WHITE HANGING HEART T-LIGHT HOLDER 6 12/1/2010 8:26 2.55 17850 United Kingdom
536365 71053 WHITE METAL LANTERN 6 12/1/2010 8:26 3.39 17850 United Kingdom
536365 84406B CREAM CUPID HEARTS COAT HANGER 8 12/1/2010 8:26 2.75 17850 United Kingdom
536365 84029G KNITTED UNION FLAG HOT WATER BOTTLE 6 12/1/2010 8:26 3.39 17850 United Kingdom
536365 84029E RED WOOLLY HOTTIE WHITE HEART. 6 12/1/2010 8:26 3.39 17850 United Kingdom
536365 22752 SET 7 BABUSHKA NESTING BOXES 2 12/1/2010 8:26 7.65 17850 United Kingdom

Für jeden Kunden (CustomerID) wird zunächst eine Liste seiner Einkäufe erstellt:

i <- split(mba_data$Description,mba_data$CustomerID)
txn <- as(i, "transactions")
## Warning in asMethod(object): removing duplicated items in transactions

Nun werden die einzelnen Regeln identifiziert:

basket_rules <- apriori(txn, parameter = list(sup = 0.04, conf = 0.1, target="rules"))
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.1    0.1    1 none FALSE            TRUE       5    0.04      1
##  maxlen target   ext
##      10  rules FALSE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 174 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[3896 item(s), 4372 transaction(s)] done [0.06s].
## sorting and recoding items ... [419 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 done [0.01s].
## writing ... [613 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 lift count
{POPPY’S PLAYHOUSE BEDROOM } => {POPPY’S PLAYHOUSE KITCHEN} 0.0411711 0.8333333 15.63662 180
{POPPY’S PLAYHOUSE KITCHEN} => {POPPY’S PLAYHOUSE BEDROOM } 0.0411711 0.7725322 15.63662 180
{BLUE HAPPY BIRTHDAY BUNTING} => {PINK HAPPY BIRTHDAY BUNTING} 0.0441446 0.8464912 15.54983 193
{PINK HAPPY BIRTHDAY BUNTING} => {BLUE HAPPY BIRTHDAY BUNTING} 0.0441446 0.8109244 15.54983 193
{GREEN REGENCY TEACUP AND SAUCER,REGENCY CAKESTAND 3 TIER,ROSES REGENCY TEACUP AND SAUCER } => {PINK REGENCY TEACUP AND SAUCER} 0.0516926 0.8625954 11.74850 226
{FELTCRAFT PRINCESS LOLA DOLL} => {FELTCRAFT PRINCESS CHARLOTTE DOLL} 0.0413998 0.7327935 11.65008 181

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:

clean.text = function(x)
{ 
  # tolower
  x = tolower(x)
  # remove punctuation
  x = gsub("[[:punct:]]", "", x)
  # remove numbers
  x = gsub("[[:digit:]]", "", x)
  # remove tabs
  x = gsub("[ |\t]{2,}", "", x)
  # remove blank spaces at the beginning
  x = gsub("^ ", "", x)
  # remove blank spaces at the end
  x = gsub(" $", "", x)
  # remove common words
  x = removeWords(x,stopwords("en"))
  return(x)
}

cleanText <- clean.text(rawdata$Message)

# Build Corpus
corpus <- Corpus(VectorSource(cleanText))


# Build Term Document Matrix
tdm <- DocumentTermMatrix(corpus)

# Convert TDM to Dataframe
tdm.df <- as.data.frame(data.matrix(tdm),stringsAsFactors=FALSE)

# Remove features with total frequency less than 3
tdm.new <- tdm.df[,colSums(tdm.df) > 2]

# Prepare final data with TDM, NumberofChar, NumberOfDigits as features

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

# Split Data into training (80%) and testing(20%) datasets

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')
pred.linear <- predict(svm.linear, test)
linear <- confusionMatrix(pred.linear,test$Class)

## Linear Kernel
svm.poly <- svm(Class~., data=train, scale=FALSE, kernel='polynomial')
pred.poly <- predict(svm.poly, test[,-1])
poly <- confusionMatrix(pred.poly,test$Class)

## Radial Basis Kernel
svm.radial <- svm(Class~., data=train, scale=FALSE, kernel='radial')
pred.radial <- predict(svm.radial,test[,-1])
radial <- confusionMatrix(pred.radial,test$Class)
Kernels <- c("Linear","Polynomial","Radial Basis")
Accuracies <- round(c(linear$overall[1],poly$overall[1],radial$overall[1]),4)
acc <- cbind(Kernels,Accuracies)
kable(acc,row.names=FALSE)
Kernels Accuracies
Linear 0.991
Polynomial 0.9883
Radial Basis 0.974
poly
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction ham spam
##       ham  964   12
##       spam   1  137
##                                           
##                Accuracy : 0.9883          
##                  95% CI : (0.9801, 0.9938)
##     No Information Rate : 0.8662          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.948           
##                                           
##  Mcnemar's Test P-Value : 0.005546        
##                                           
##             Sensitivity : 0.9990          
##             Specificity : 0.9195          
##          Pos Pred Value : 0.9877          
##          Neg Pred Value : 0.9928          
##              Prevalence : 0.8662          
##          Detection Rate : 0.8654          
##    Detection Prevalence : 0.8761          
##       Balanced Accuracy : 0.9592          
##                                           
##        'Positive' Class : ham             
## 

Naive Bayes

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

Wo gibt es noch mehr Material?

Alle mit + markierten Link sind Affiliate-Links