Created
April 9, 2012 07:27
-
-
Save josefslerka/2342124 to your computer and use it in GitHub Desktop.
Počítání matice souvýskytů a jejich klastrování
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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