Cacher is the code snippet organizer for pro developers

---
title: "Trọng"
author: "Thanh Le"
date: "March 12, 2016"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
rm(list = ls())
if (!"pacman" %in% installed.packages()[,1])
  install.packages("pacman")
library(pacman)
p_load(XML,tm, stringr, tau, parallel, wordcloud, RColorBrewer, ggplot2)
```

Sử dụng bộ từ tiếng Việt để lọc từ 2 âm tiết
```{r vietdict}
# Bộ 74k từ việt download từ http://www.informatik.uni-leipzig.de/~duc/software/misc/wordlist.html
vietdict <- readLines('Viet74K.txt', n = -1, warn = FALSE)
#Lọc bỏ trùng lặp
vietdict <- vietdict[!duplicated(vietdict)]
```

```{r}
# Một vài dòng lệnh lấy từ @fb.com/son.nghiem.965
rds_file <- "text.rds"

if (!file.exists(rds_file)) {
  # url1 <- 'http://vnexpress.net/tin-tuc/thoi-su/tong-bi-thu-nguyen-phu-trong-bo-chinh-tri-se-vuot-qua-thach-thuc-3349334-p3.html'
  # url2 <- 'http://dangcongsan.vn/tu-lieu-van-kien/van-kien-dang/nghi-quyet-bch-trung-uong/khoa-x/doc-3925201511023546.html'
  url <- 'http://vov.vn/chinh-tri/dang/toan-van-phat-bieu-cua-tong-bi-thu-khai-mac-hoi-nghi-tu-2-khoa-xii-487616.vov'
  doc.html <- htmlTreeParse(url, useInternalNodes = TRUE)
  doc.text <- unlist(xpathApply(doc.html, '//p', xmlValue))
  saveRDS(doc.text, rds_file)
} else {
  doc.text <- readRDS(rds_file)
}
```

```{r clean_text_func}
# Hàm thay một số chữ và ký tự không có nghĩa
rms <- function(x) {
  pattern = '\\n|\\r|\\t|\\-|,|;|:|\\.|\\/|”|“|(|)|VOV.VN| {2,}|^ | $'
  x <- gsub(pattern, '', x, perl = TRUE)
  # trim space both side
  x <- str_trim(x)
  #Get indice of empty elements
  empty_element <- sapply(x, function(x) x == "")
  #Remove empty elements
  x <- x[!empty_element]
  return(x)
}
```

Xóa các kí tự vô nghĩa

```{r clean_text}
clean_text <- rms(doc.text)
```
Hàm tổ hợp từ và lọc theo dữ kiện từ điển để tách từ có nghĩa
```{r combine_words}
# Tổ hợp từ theo âm tiết 
combine_words <- function(full_vector, n=2L){
  # full_vector: vector kí tự sau xử lý với clean_text
  #n: số âm tiết
  ngram.f <- function(vector_element, n){
    w <- strsplit(vector_element, " ", fixed = TRUE)[[1L]]
    vapply(ngrams(w, n), paste, "", collapse = " ")
  }
  y <- unlist(lapply(full_vector, function(x) ngram.f(x, n)))
  y <- tolower(y)
  return(y)
}

# Hàm tìm từ có nghĩa dựa vào dữ kiện từ điển có sắn và tính frequency
count_words <- function(word, to_count_words){
  word <- str_trim(word)
  word1 <- paste("^",word, sep="")
  .s <- NA
  if (!grepl("\\(", word)){
    .r <- grep(word1, to_count_words)
    if (length(.r) > 0)
      .s <- list(word = word, count = length(.r))
  }
  return(.s)
}
```
Tổng hợp từ theo 2 âm tiết và tìm từ có nghĩa

```{r, cache=TRUE}
word2 <- combine_words(clean_text, 2L)
rs <- mclapply(vietdict, function(x) count_words(x, word2))
.le <- unlist(lapply(rs, length)) > 1
rs1 <- rs[.le]
rs12 <- as.data.frame(do.call(rbind.data.frame, rs1))
two_words <- ifelse(grepl(" ",rs12$word),T,F)
rs12 <- rs12[two_words,]
```

### Wordcloud với từ 2 âm tiết

```{r word_cloud}
# Một vài dòng lệnh lấy từ @fb.com/son.nghiem.965
pal <- rev(brewer.pal(6, "Spectral"))
wordcloud(words = rs12$word, freq = rs12$count, min.freq=2, random.order = F, colors = pal)
```

```{r}
p_load(ggthemes)
rs12$word <- as.character(rs12$word)
rs12$word <- reorder(rs12$word, rs12$count)
ggplot(rs12[rs12$count>2,], aes(x = word, y = count)) + geom_bar(stat = "identity", fill = "gray50") +xlab("Từ") + ylab("Tần suất") + coord_flip() + theme_gdocs()
```

### Wordcloud với từ 3 âm tiết

```{r, warning=FALSE}
word3 <- unlist(combine_words(clean_text, 3L))
word3.df <- as.data.frame(sort(table(word3), decreasing = T))
word3.df$word <- row.names(word3.df)
word3.df <- word3.df[,c(2,1)]
names(word3.df) <- c("word", "count")
wordcloud(words = word3.df$word, freq = word3.df$count, min.freq=5, random.order = F, colors = pal)
```