Skip to content

Instantly share code, notes, and snippets.

@josefslerka
Created April 9, 2012 07:27
Show Gist options
  • Save josefslerka/2342124 to your computer and use it in GitHub Desktop.
Save josefslerka/2342124 to your computer and use it in GitHub Desktop.
Počítání matice souvýskytů a jejich klastrování
mydata.vectors <- character(0)
mydata.vectors <- c("RT @LukasGren: Mam v telefonu @Vodafone_CZ a v iPadu O2. Temer vzdy a vsude je na tom Vodafone lepe s datovym pokrytim.", mydata.vectors)
mydata.vectors <- c("@LukasGren @Vodafone_CZ Co jsem nedavno presel, tak #O2 ma ve vlaku z Ostravy do Brna pokryti lepsi, a to i na prerovce. ", mydata.vectors)
mydata.vectors <- c("Mam v telefonu @Vodafone_CZ a v iPadu O2. Temer vzdy a vsude je na tom Vodafone lepe s datovym pokrytim.", mydata.vectors)
mydata.vectors <- c("@predraz_volani s timto ted utoci O2, 300min + neomezene sms do vlastni site a 500MB FUP za 350kc (O2 kul), kdyz prejdete!", mydata.vectors)
mydata.vectors <- c("@TheMoleCZ Zmenu je mozne provest na zakaznicke lince 800 020 202, nebo vam ji muzeme zajistit (http://t.co/t3ZH0g5V). Jarda, O2 Guru", mydata.vectors)
mydata.vectors <- c("@dluckyb No nevim, Strakonice nejsou zase tak male. Ale to same co ty jsem mel u o2. To si nevyberes.", mydata.vectors)
mydata.vectors <- c("@mrkvi celkem ujde? :D ja mam O2 a je to strasne pomaly. :D", mydata.vectors)
mydata.vectors <- c("Je to marne, O2 3G ve Vrbne pod Pradedem je proste demo sit, nefunguje v zadne budove, pokud nejsem do 100 m od BTS.", mydata.vectors)
mydata.vectors <- c("Konkurence: O2 u vybranych mobilu garantuje nejnizsi cenu - ChannelWorld.cz - http://t.co/8mdVy2aZ ", mydata.vectors)
mydata.vectors <- c("Zde se muzete podivat, jak se pripravuje antukovy kurt v O2 arene. Pro me bylo velkym prekvapenim, ze jsme... http://t.co/KJmug31q ", mydata.vectors)
mydata.vectors <- c("RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("RT @wpcentral O2 offering Lumia 710 and 800 for free on contract for this week only http://t.co/DbF8H2Vp #wp7 Na nasem specifickem trhu sen", mydata.vectors)
mydata.vectors <- c("RT @cermak: Libi se mi, kdyz volam zene a O2 mi oznami, ze je nedostupna. A pak prijdu domu, reknu ledabyle: Cau, kote!, a pripadam si ...", mydata.vectors)
mydata.vectors <- c("clovek ty kluky z O2 musi mit rad: nejen ze si za zapujceni modemu na tejden na zkousku o kterym mi tvrdili, ze je... http://t.co/6n9ltNtW", mydata.vectors)
mydata.vectors <- c("JayDieselWorld","RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("Moucha13","@PetrKalab myslel jsem, ze mas O2 :)", mydata.vectors)
mydata.vectors <- c("Libi se mi, kdyz volam zene a O2 mi oznami, ze je nedostupna. A pak prijdu domu, reknu ledabyle: Cau, kote!, a pripadam si jako chlapak!", mydata.vectors)
mydata.vectors <- c("RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("Queeni v O2 Arene hrali bez Freddieho Mercuryho, Srbove zase nastoupi bez Novaka Djokovice. Bude to zhruba stejny zazitek...", mydata.vectors)
mydata.vectors <- c("@Baryho Hezky den, informace pro vas zjistim a dam vedet. Petr, O2 Guru", mydata.vectors)
mydata.vectors <- c("RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("RT @ANenadal: Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) js ...", mydata.vectors)
mydata.vectors <- c("Chris's Diary: Today I'm grateful for o2 !!! http://t.co/XDpTEXxi", mydata.vectors)
mydata.vectors <- c("Djokovic neni v nominaci na Davis Cup proti Cesku. Lidi, ktery vyprodali O2 arenu (listky byly v rozmezi 450 - 2490 Kc) jsou urcite nadseny.", mydata.vectors)
mydata.vectors <- c("@O2GuruCZ dobry den, mam dotaz ohledne novych telefonu Sony (S, U, P, Sola). budou v nabidce O2 eshopu? Zejmena Sola me zajima. Diky ", mydata.vectors)
mydata.vectors <- c("Hmm, tak to v O2 arene bude pekna kosa, kdyz Djoker nedojede a nikdo neprijde. To tam na te lajne zkosnu. #daviscup #tennis", mydata.vectors)
mydata.vectors <- c("@w0lf_cz Aspon se muze uzivatel podivat na utratu pohodlne i z mobilu. V pripade O2 je to jedina funkce i jejich plne verze." , mydata.vectors)
mydata.vectors <- c("Djokovic do Prahy na Davis Cup neprijede. To je na vraceni vstupnyho!!! Plna O2 Arena uvidi brejlouna Tipsarevice s upocenym Stepcem!", mydata.vectors)
require(tm)
# build a corpus
mydata.corpus <- Corpus(VectorSource(mydata.vectors))
# make each letter lowercase
mydata.corpus <- tm_map(mydata.corpus, tolower)
# remove punctuation
mydata.corpus <- tm_map(mydata.corpus, removePunctuation)
# remove generic and custom stopwords
my_stopwords <- c(stopwords('english'), 'se', 'na', 'v', 'co', 'ze', 'o', 'je', 'k', 'z',
'si', 'dnes', 'cz', 'timto', 'budes', 'budem', 'byli', 'jses', 'muj', 'svym', 'ta', 'tomto', 'tohle', 'tuto', 'tyto', 'jej', 'zda', 'proc', 'mate', 'tato', 'kam', 'tohoto', 'kdo', 'kteri', 'mi', 'nam', 'tom', 'tomuto', 'mit', 'nic', 'proto', 'kterou', 'byla', 'toho', 'protoze', 'asi', 'ho', 'nasi', 'napiste', 're', 'rt', 'coz', 'tim', 'takze', 'svych', 'jeji', 'svymi', 'jste', 'aj', 'tu', 'tedy', 'teto', 'bylo', 'kde', 'ke', 'prave', 'ji', 'nad', 'nejsou', 'ci', 'pod', 'tema', 'mezi', 'pres', 'ty', 'pak', 'vam', 'ani', 'kdyz', 'vsak', 'ne', 'jsem', 'tento', 'aby', 'jsme', 'pred', 'pta', 'jejich', 'byl', 'jeste', 'az', 'bez', 'take', 'pouze', 'prvni', 'vase', 'ktera', 'nas', 'novy', 'pokud', 'muze', 'jeho', 'sve', 'jine', 'zpravy', 'nove', 'neni', 'vas', 'jen', 'podle', 'zde', 'clanek', 'uz', 'byt', 'vice', 'bude', 'jiz', 'nez', 'ktery', 'by', 'ktere', 'co', 'nebo', 'ten', 'tak', 'ma', 'pri', 'od', 'po', 'jsou', 'jak', 'dalsi', 'ale', 'si', 've', 'to', 'jako', 'za', 'zpet', 'ze', 'do', 'pro', 'je',
'na')
mydata.corpus <- tm_map(mydata.corpus, removeWords, my_stopwords)
# build a term-document matrix
mydata.dtm <- TermDocumentMatrix(mydata.corpus)
# inspect the document-term matrix
mydata.dtm
# inspect most popular words
findFreqTerms(mydata.dtm, lowfreq=10)
#
#
# remove sparse terms to simplify the cluster plot
# Note: tweak the sparse parameter to determine the number of words.
# About 10-30 words is good.
mydata.dtm2 <- removeSparseTerms(mydata.dtm, sparse=0.95)
# convert the sparse term-document matrix to a standard data frame
mydata.df <- as.data.frame(inspect(mydata.dtm2))
# inspect dimensions of the data frame
nrow(mydata.df)
ncol(mydata.df)
#
# vykreslaní hierarchickeho dendrogramu
mydata.df.scale <- scale(mydata.df)
d <- dist(mydata.df.scale, method = "euclidean") # distance matrix
fit <- hclust(d, method="ward")
plot(fit) # display dendogram?
groups <- cutree(fit, k=5) # cut tree into 5 clusters
# draw dendogram with red borders around the 5 clusters
rect.hclust(fit, k=5, border="red")
#
# neigbhours-joining
library(ape)
tr <- nj(d)
plot(tr, "u")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment