Diese Pakete müssen nur beim allerersten Mal installiert werden!
install.packages("SnowballC")
install.packages("tau")
install.packages("tm")
install.packages("readr")
install.packages("tidytext")
install.packages("wordcloud")
install.packages("dplyr")
Hier werden schon mal einige Libraries geladen
library("SnowballC")
library("tm")
Loading required package: NLP
library("tidytext")
library("dplyr")
Attaching package: ‘dplyr’
The following objects are masked from ‘package:stats’:
filter, lag
The following objects are masked from ‘package:base’:
intersect, setdiff, setequal, union
Der Stemmer SnowballC stemmt leider nur das letzte Wort eines Ausdrucks; das Problem hatten auch schon andere bemerkt und dann diese kleine Funktion geschrieben, die jedes Wort in einem Ausdruck stemmt. Hier laden wir erst mal nur diese Funktion, sie wird erst später genutzt
require(tau)
Loading required package: tau
stem_text<- function(text) {
# stem each word in a block of text
stem_string <- function(str) {
str <- tokenize(x = str)
str <- wordStem(str, language = "german")
str <- paste(str, collapse = "")
return(str)
}
# stem each text block in turn
x <- lapply(X = text, FUN = stem_string)
# return stemed text blocks
return(unlist(x))
}
Einmal testen, ob das auch funktioniert :-) Du kannst zwischen den Gänsefüschen eintragen was Du willst und dann selber testen
stem_text("erfahrener Programmierer")
[1] "erfahr Programmi"
Jetzt lesen wir unseren Corpus ein
goethe <- read.csv("goethe.csv")
Dies ist eine kleine Funktion, die uns davor bewahrt, dass wir Müll verarbeiten, sie wird später aufgerufen
cleanThis <- function(x) {
Encoding(x) <- "UTF-8"
x <- iconv(x, "UTF-8", "UTF-8",sub='')
return(x)
}
Nun gehts richtig los
goetheCorp <- paste(goethe$title,goethe$gedicht,sep=" ") # Wir schmeißen Titel und Inhalt zusammen
review_corpus = Corpus(VectorSource(goetheCorp)) # lesen das in den Corpus ein
review_corpus = tm_map(review_corpus, cleanThis) # verhindern, dass wir Müll verarbeiten
review_corpus = tm_map(review_corpus, content_transformer(tolower)) # machen alle Begriffe klein
review_corpus = tm_map(review_corpus, removeNumbers) # entfernen Zahlen
review_corpus = tm_map(review_corpus, removePunctuation) # entfernen Punkte etc
review_corpus = tm_map(review_corpus, stripWhitespace) # leere Zeichen werden entfernt
review_corpus = tm_map(review_corpus, removeWords, c(stopwords("german"))) #Stopwörter werden entfernt
#review_corpus = tm_map(review_corpus, stem_text)
inspect(review_corpus[1]) # Was hat das jetzt mit unserem ersten Dokument gemacht?
<<SimpleCorpus>>
Metadata: corpus specific: 1, document level (indexed): 0
Content: documents: 1
[1] zweite epistel leichter geholfen versetz wohl andrer denken möchte mädchen gut gerne schaffen gib schlüssel keller weine vaters besorge sobald winzer kaufmann geliefert weiten gewölbe bereichern schaffen mädchen vielen gefäße leere fässer flaschen reinlicher ordnung halten betrachtet oft schäumenden mostes bewegung gießt fehlende wallenden blasen leicht öffnung fasses erreichen trinkbar helle endlich edelste saft künftigen jahren vollende unermüdet alsdann füllen schöpfen stets geistig trunk rein tafel belebe laß küche reich gibt wahrhaftig arbeit genug tägliche mahl sommer winter schmackhaft stets bereiten beschwerde beutels frühjahr sorget schon hofe küchlein bald erziehen bald schnatternden enten füttern jahrszeit gibt bringt beizeiten tisch weiß jeglichem tage speisen klug wechseln reift eben sommer früchte denkt vorrat schon winter kühlen gewölbe gärt kräftige kohl reifen essig gurken luftige kammer bewahrt gaben pomonens gerne nimmt lob vater geschwistern mißlingt ists größeres unglück schuldner entläuft wechsel zurückläßt immer mädchen beschäftigt reifet stillen häuslicher tugend entgegen klugen mann beglücken wünscht endlich lesen wählt gewißlich kochbuch deren hunderte schon eifrigen pressen gaben schwester besorget garten schwerlich wildnis wohnung romantisch feucht umgeben verdammt zierliche beete geteilt vorhof küche nützliche kräuter ernährt jugendbeglückende früchte patriarchalisch erzeuge kleines gedrängtes königreich bevölkre haus treuem gesinde hast töchter mehr lieber sitzen stille weibliche arbeit verrichten ists besser nadel ruht jahre leicht häuslich hause mögen öffentlich gern müßige damen erscheinen nähen flicken vermehrt waschen biegeln hundertfältig seitdem weißer arkadischer hülle mädchen gefällt langen röcken schleppen gassen kehret gärten staub erreget tanzsaal wahrlich wären mädchen dutzend hause niemals wär verlegen arbeit arbeit selber genug buch laufe jahres schwelle kommen bücherverleiher gesendet
Aus unserem Corpur wird eine DokumentTermMatrix gebaut
review_dtm <- DocumentTermMatrix(review_corpus)
#review_dtm = removeSparseTerms(review_dtm, 0.95) # wir verzichten darauf, dass die Sparse Terms entfernt werden
review_dtm
<<DocumentTermMatrix (documents: 124, terms: 4567)>>
Non-/sparse entries: 8303/558005
Sparsity : 99%
Maximal term length: 24
Weighting : term frequency (tf)
Aus der DokumentTermMatrix bauen wir uns einen Dataframe
DTM <- tidy(review_dtm)
Und nun kommen wir zum spannenden Teil :-) Wir rechnen TF, IDF, WDF etc alles selbst aus :-)
So würde man das in R normalerweise nicht bauen, ABER so ist es zumindest nachvollziehbar für jeden. Der Code ist weder elegant noch performant.
AllWeightings_DTM <- data.frame()
N <- length(unique(DTM$document)) # total number of documents
allUniqueTerms <- unique(DTM$term) #unique terms
docIDs <- unique(DTM$document) # Die Dokumentennummern, die wir haben; wichtig, falls wir doch die Sparse Terms rausnehmen, da dann evtl Dokumente rausfliegen
i <- 1
for (i in docIDs) {
uniqueTerms <- unique(DTM$term[DTM$document == i]) # eine Liste alle unique Begriffe in diesem Dokument
numOfTermsInDocument <- sum(DTM[DTM$document == i, "count"]) # eine Liste aller Terme in dem Dokument
for (term in uniqueTerms) {
tf <- DTM$count[DTM$document == i & DTM$term == term] # wir berechnen die einfache Termfrequenz
relDocs <- nrow(DTM[ which(DTM$term == term),]) # wie viele Dokumente im Corpus beinhalten noch diesen Begriff?
idf <- log2((N/relDocs)) # einmal IDF bitte
tf_idf <- tf*idf # einfaches tf/idf
normalized_tf <- (tf/numOfTermsInDocument) #normalisiertes TF
normalized_tf_idf <- normalized_tf*idf #TF/IDF mit TF normalsiert
wdfidf <- (log2(tf+1)/log2(numOfTermsInDocument))*idf # zum Schluß einmal WDF/IDF
# jetzt packen wir noch alles in einen Data Frame
theWeight <- data.frame(i,term,tf,numOfTermsInDocument,normalized_tf,relDocs,idf,tf_idf,normalized_tf_idf,wdfidf)
AllWeightings_DTM <- rbind(theWeight,AllWeightings_DTM)
}
}
# wir erstellen mal einen Dataframe für einen Begriff und geben ihn aus
(maedchen <- AllWeightings_DTM %>% #
filter(term == "mädchen") %>%
arrange(desc(wdfidf)))
Jetzt machen wir alles noch mal, aber dieses Mal stemmen wir die Begriffe!
review_corpus = tm_map(review_corpus, stem_text)
review_dtm <- DocumentTermMatrix(review_corpus)
DTM <- tidy(review_dtm)
AllWeightings_DTM_stemmed <- data.frame()
N <- length(unique(DTM$document))
allUniqueTerms <- unique(DTM$term)
docIDs <- unique(DTM$document)
i <- 1
for (i in docIDs) {
uniqueTerms <- unique(DTM$term[DTM$document == i])
numOfTermsInDocument <- sum(DTM[DTM$document == i, "count"])
for (term in uniqueTerms) {
tf <- DTM$count[DTM$document == i & DTM$term == term]
relDocs <- nrow(DTM[ which(DTM$term == term),])
idf <- log2((N/relDocs))
tf_idf <- tf*idf # einfaches tf/idf
normalized_tf <- (tf/numOfTermsInDocument)
normalized_tf_idf <- normalized_tf*idf
wdfidf <- (log2(tf+1)/log2(numOfTermsInDocument))*idf
theWeight <- data.frame(i,term,tf,numOfTermsInDocument,normalized_tf,relDocs,idf,tf_idf,normalized_tf_idf,wdfidf)
AllWeightings_DTM_stemmed <- rbind(theWeight,AllWeightings_DTM_stemmed)
}
}
# wir erstellen mal einen Dataframe für den gleichen Begriff
(maedchen_stemmed <- AllWeightings_DTM_stemmed %>% #
filter(term == "mädchen") %>%
arrange(desc(wdfidf)))