#load files into corpus #get listing of .txt files in directory #names<-removeExt(filenames) Line not used #read files into a character vector #load text mining library library(tm) library(SnowballC) library(wordcloud) library("factoextra") library(ggplot2) #set working directory setwd("/Users/zahra/Dropbox/0Publications/2017/RE17 Data Track/Iteration2/Clustering") #load files into corpus #get listing of .txt files in directory filenames <- list.files(getwd(),pattern="*.txt") #read files into a character vector files <- lapply(filenames,readLines) #create corpus from vector docs <- Corpus(VectorSource(files)) docs <- tm_map(docs, content_transformer(function(x) iconv(x, to='UTF-8-MAC', sub='byte')), mc.cores=1) #start preprocessing #Transform to lower case docs <-tm_map(docs,content_transformer(tolower)) #remove potentially problematic symbols toSpace <- content_transformer(function(x, pattern) { return (gsub(pattern, ' ', x))}) toReplace <- content_transformer(function(x, y, pattern) { return (gsub(pattern, y, x))}) #remove HTML formatting and tags docs <- tm_map(docs, toSpace, "<.*?>") #remove punctuation docs <- tm_map(docs, removeWords, c("user", "id", "requirements", "part", "movie", "software", "the", "shall", "every", "shall", "event", "activity", "on", "must", "be", "able", "can", "MDI", "events", "of", "projected", "distance", "contacts", "reports", "appointments", "criteria", "able", "cma", "report", "internet", "connection", "device", "button", "buttons", "navigation", "search", "classes", "clinicals", "final", "class", "scheduling", "statement", "database", "transaction", "disputes", "letters", "letter", "user reports", "standards", "standard", "credit card", "dispute", "navigate", "navigating", "screen", "cases", "dbms", "located", "machine", "cycle", "accounting", "claims", "repair facility", "language", "java runtime", "html browser", "email", "user ids", "reservations", "conference", "rooms", "room", "building maps", "design patterns", "coding practice", "training", "animation", "home", "sales", "prepaid", "pre-paid", "card", "administration", "pin number", "email", "website", "pear", "pins", "excel", "stream", "buffer", "velkat staff", "lead", "cycle time", "evaluation", "leads", "ship", "sink", "sunk", "shot", "hit", "target", "miss", "sea", "offensive", "grid", "african", "guideline", "response", "advertise", "empty time slots", "ensure", "that", "browser", "depaul teleservices center", "responce", "messages", "message", "between", "csr", "eam", "ibm", "computer", "operating system", "windows", "rfs system", "bdw", "budgeting process", "city", "chicago", "application", "development", "guide", "framework", "monitoring", "services", "monitoring", "error", "tracking", "united states", "ccr", "wcs", "branding","logo", "resolution", "navigation", "mouse", "keyboard", "developer", "queries", "w3", "league", "button", "nfl season", "network", "player", "architecture", "hard", "disk", "space", "pcg", "hierarchy", "roles", "enet", "budget", "budgeting", "revenue", "expense", "formula", "pcg", "finance", "time", "part", "without", "survey", "via", "market", "file", "week", "day", "month", "one", "system", "product", "user", "Product", "intranet", "information", "User", "role", "roles", "can", "projectidrequirementsclassid", "requirements","class", "ID", "within", "file", "let", "provide", "detail", "number", "will", "year")) docs <- tm_map(docs, removePunctuation) #Strip digits docs <- tm_map(docs, removeNumbers) #remove stopwords docs <- tm_map(docs, removeWords, stopwords("english")) #remove whitespace docs <- tm_map(docs, stripWhitespace) # pre stem replace words #docs <- tm_map(docs, toReplace, ' ffunctional ', " functional ") #Stem document docs <- tm_map(docs, toReplace, 'easy', "easily") docs <- tm_map(docs,stemDocument) #post stem replace # docs <- tm_map(docs, toReplace, 'implement', "build") # docs <- tm_map(docs, toReplace, 'implement', "creat") # docs <- tm_map(docs, toReplace, 'model', "user stori") # docs <- tm_map(docs, toReplace, 'model', "use case") docs <- tm_map(docs, removeWords, c("user", "case", "year", "data", "day", "per", "customer", "hour", "busi", "store")) #Create document-term matrix dtm <- DocumentTermMatrix(docs) freq <- colSums(as.matrix(dtm)) #wordcloud(docs, max.words = 200, random.order = FALSE) #write.csv(freq[ord],"word_freq.csv") m <- as.matrix(dtm) rownames(m) <- paste(substring(rownames(m),1,3),rep("",nrow(m)), substring(rownames(m), nchar(rownames(m))-12,nchar(rownames(m))-4)) d <- dist(m, method = "euclidean") #------------------------------------- Tendency Assessment ---------------------------------------------- library("cluster") library("factoextra") pdf("Tendency.pdf",width=7,height=6) get_clust_tendency(m, n = 150, gradient = list(low = "steelblue", high = "blue")) dev.off() #-------------------------------------------------------------------------------------------------------- #------------------------------------- Hierarchical clustering---------------------------------------------- # library(ape) # library(ggplot2) # library(dendextend) # d <- dist(m, method = "euclidean") # # Hierarchical clustering using Ward's method # res.hc <- hclust(d, method = "ward.D2") # dend <- as.dendrogram(res.hc) # # Cut tree into 4 groups # grp <- cutree(res.hc, k = 10) # # Visualize # pdf("HVL.pdf",width=10,height=10) # #plot(res.hc, hang=-1, cex = 0.6) # plot tree # # colors = c("red", "blue", "green", "black", "orange", "white") # clus4 = cutree(res.hc, 10) # plot(as.phylo(res.hc), type = "fan", tip.color = colors[clus4], # label.offset = 1, cex = 0.7) # # plot(as.phylo(res.hc), type = "radial") # # #rect.hclust(res.hc, k = 10, border = 2:5) # add rectangle # dend <- res.hc %>% as.dendrogram %>% # set("branches_k_color", k=11)%>% set("branches_lwd", 1.2) %>% # set("labels_colors") %>% set("labels_cex", c(.9,1.2)) %>% # set("leaves_pch", 19) %>% set("leaves_col", c("blue", "red", "green", "orange", "yellow")) # # plot the dend in usual "base" plotting engine: # # ggd1 <- as.ggdend(dend) # # ggplot(ggd1, labels = FALSE) + # scale_y_reverse(expand = c(0.2, 0)) + # coord_polar(theta="x") # # # # # # dev.off() # write.csv(grp, file="Hierarchical.csv") #------------------------------------- K-means clustering---------------------------------------------- km.res <- eclust(m, "kmeans", k = 10, nstart = 100, graph = FALSE) write.csv(km.res$cluster, file="Kmeans.csv") # k-means group number of each observation library("factoextra") fviz_cluster(km.res, frame.type = "norm", frame.level = 0.8) library(cluster) km <- kmeans(dtm,10) dissE <- daisy(dtm) sk2 <- silhouette(km$cl, dissE) pdf("Kmeans.pdf",width=3.95,height=6) plot(sk2, col="blue", border=NA ) plot(sk2, col=c("#6A4577", "#141A4E","#6A5672", "#171A3C", "#3B3F64","#6A4577","#64688D","#9093B0","#B6B8CD", "#C4BFC6"), main=NULL,border=0, max.strlen =3, do.n.k =FALSE, do.clus.stat = TRUE) dev.off() #----- Hierarchical----------- d <- dist(m, method = "euclidean") # # Hierarchical clustering using Ward's method res.hc <- hclust(d, method = "ward.D2") si3 <- silhouette(cutree(res.hc, k = 10), # k = 4 gave the same as pam() above daisy(m)) pdf("HCL.pdf",width=3.95,height=6) plot(sk2, col=c("#6A4577", "#141A4E","#6A5672", "#171A3C", "#3B3F64","#6A4577","#64688D","#9093B0","#B6B8CD", "#C4BFC6"), main=NULL,border=0, max.strlen =3, do.n.k =FALSE, do.clus.stat = TRUE) dev.off() #----------------Hybrid-------- res.hc <- eclust(m, "hclust", k = 10, method = "ward.D2", graph = FALSE) grp <- res.hc$cluster clus.centers <- aggregate(m, list(grp), mean) clus.centers clus.centers <- clus.centers[, -1] clus.centers km.res2 <- eclust(m, "kmeans", k = clus.centers, graph = FALSE) write.csv(km.res2$cluster, file="Hybrid.csv") dissE <- daisy(m) sk2 <- silhouette(km.res2$cl, dissE) pdf("HB.pdf",width=3.95,height=6) plot(sk2, col=c("#6A4577", "#141A4E","#6A5672", "#171A3C", "#3B3F64","#6A4577","#64688D","#9093B0","#B6B8CD", "#C4BFC6"), main=NULL,border=0, max.strlen =3, do.n.k =FALSE, do.clus.stat = TRUE) dev.off()