---
title: "Text Minining in R (on Ptt Movie)"
author: "Shen Chen Hsi & Thomas"
date: "2017/05/19"
output: 
 html_document:
    theme: cosmo
  
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_knit$set(root.dir = normalizePath(setwd("~/Documents/taipei_uni/text_mining/"))) 
```

***

## Text Mining on Ptt Movie

***

Reference: https://www.ptt.cc/bbs/movie/index.html

***
Read all the libraryies you need

```{r, include=FALSE}
library(httr)
library(jsonlite)
library(rvest)
library(stringr)
library(dplyr)
library(data.table)
library(ggplot2)
library(xml2)
library(plyr)
```

***
Read the data.

```{r}
DataAll <- read.csv('All_article.csv')
DataAll[,1] <- as.character(DataAll[,1])
DataAll[,2] <- as.character(DataAll[,2])
```

***

### Part 1: Ngram Algorithm and WordCloud

Since you're doing CHINESE text mining, you have to build your own ngram.

```{r}
myngram <- function(text,n){
WordsList <- list()
size <- n-1
for ( i in 1:(length(text)-size)) {
  WordsList[i] <- substr(text, i, i+size)
}
return(WordsList)
}
```

Then, apply your function to your dataset, generate bigram and make it clean.


```{r}
Bigram <- lapply(DataAll[,1], function(x,n) myngram(x, 2))
BigramList <- unlist(Bigram)


BigramList <- str_replace_all(BigramList, "[[:punct:]]", "")
BigramList <- str_replace_all(BigramList, "^[A-Za-z0-9]+$", "")
BigramList <- str_replace_all(BigramList,'[[:digit:]]+',"")
BigramList <- BigramList[! BigramList %in% ""]
BigramList <- BigramList[grep('[\u4e00-\u9fa5]{2}', BigramList)]

```

Lastly, count each word and sort them.

```{r}
WordCount <- data.table(table(BigramList))


WordCount <- WordCount %>%
  arrange(desc(WordCount[,2]))
```


```{r, message = FALSE}
devtools::install_github("lchiffon/wordcloud2")
library(wordcloud2)
```

And you can have your own WordCloud!

```{r}
wordcloud2(WordCount[1:100,],fontFamily = "LiHei Pro")
```

---

### Part 2: Jieba R

Jieba is an efficient and effective tool for word segmentation. JiebaR is its interface for R users.

***

#### Start with JiebaR

Use `install.pachages` for the library. `worker` is for the setting and `<=` is special for call the word segmentation tool.

```{r, message = FALSE}
# install.packages('jiebaR')
library("jiebaR")

mixseg <- worker(stop_word = 'stop_words.txt')

SegList <- list()
for (i in 1:nrow(DataAll)){
  SegList[[i]] <- mixseg <= (as.character(DataAll[i,1]))
}

SegList <- unlist(SegList)
```

With the list, we can apply the same process what we've done just now.

```{r}
SegList <- str_replace_all(SegList,'[[:digit:]]+',"")
SegList <- str_replace_all(SegList,"[[:punct:]]", "")
SegList <- str_replace_all(SegList,"^[A-Z a-z 0-9]+$", "")
SegTable <- data.table(table(SegList))

SegTable <- SegTable %>%
  arrange(desc(SegTable$N))
```

***

#### Other cool features in jiebaR

You can get some keywords.

```{r}
keys = worker("keywords",topn=20)
k <- vector_keywords(SegList,keys)
k
```

Or you can get the tag for each term.

```{r}
cutter <- worker("tag") 
tag <- cutter <= as.character(DataAll[1,1])
names(tag)
```

***

### Part 3: TF-IDF Calculation

There's no good TF-IDF function in r for CHINESE. Still, we need to create our own.

```{r}
tf <- function(feature, text){
  llply(feature, function(x) str_count(text, x)) %>%
    ldply %>%
    t %>%
    as.data.frame()
  }

df <- function(feature,text){
  llply(feature,function(x) grepl(x, text)) %>% 
    ldply %>% 
    t %>% 
    as.data.frame()
}
```

Then, let's get TF-IDF done!

```{r}
aa <- tf(WordCount$BigramList, DataAll[,1])
bb <- df(WordCount$BigramList, DataAll[,1])

dfTable <- apply(bb,MARGIN = 2,sum)



tfidfarray_ngram <- aa
tfidfarray_ngram[tfidfarray_ngram==0] <- NA 
tfidfarray_ngram <- apply(tfidfarray_ngram,MARGIN = 1,
                    FUN = function(x) (1+log(x,base = 10))*log(nrow(DataAll)/dfTable,base = 10))
tfidfarray_ngram <- as.data.frame(t(tfidfarray_ngram))
tfidfarray_ngram[is.na(tfidfarray_ngram)] <- 0 

```

```{r}
a <- tf(SegTable$SegList, DataAll[,1])
b <- df(SegTable$SegList, DataAll[,1])
dfTable <- apply(b,MARGIN = 2,sum)

tfidfarray <- a
tfidfarray[tfidfarray==0] <- NA  
tfidfarray <- apply(tfidfarray,MARGIN = 1,
                    FUN = function(x) (1+log(x,base = 10))*log(nrow(DataAll) /dfTable,base = 10))

tfidfarray[is.na(tfidfarray)] <- 0 
tfidfarray <- t(tfidfarray)
```


--- 

### Part 4: Application

#### Cosine Similarity

First, calculate the similarity between each observation.

```{r}
cosine <- function(x) {
  y <- x %*% t(x)
  res <- 1 - y / (sqrt(diag(y)) %*% t(sqrt(diag(y))))
  return(res)
}

CosSim <- cosine(tfidfarray)
CosSim <- data.table(CosSim)
```

Let's take a look at the most similar for the 50th article.

```{r}
N50 <-  which(as.numeric(CosSim[50,]) %in% sort(as.numeric(CosSim[50,]),
                                                 decreasing = F)[2:5]) 
DataAll[N50,2]

N200 <-  which(as.numeric(CosSim[200,]) %in% sort(as.numeric(CosSim[200,]),
                                                decreasing = F)[2:5]) 

DataAll[N200,2]
```

#### Clustering

Use `akmeans()`, which allows us to calculate cosine similarity in our clustering algorithms.

```{r}
library(akmeans)

k <- akmeans(tfidfarray, ths1 = 2 ,
             d.metric = 2, min.k= 7, iter.max = 100)

DataCluster <- cbind(DataAll, k$cluster)
```

#### Classification

Use `svm()` to classify '好雷' and '負雷' from the article.

#### Step 1: Variable Selection

We choose first 2000 variables based on tf-idf weight.

```{r}
Raw <- data.frame(tfidfarray)
ScoreSum <- t(apply(Raw,2,sum))

train <- rbind(Raw, ScoreSum)
colnames(train) <- SegTable$SegList

index <- train[nrow(train),] %in% sort(ScoreSum,decreasing=T)[1:2000]
train <- train[,which(index)]
train <- train[-nrow(train),]
```

#### Step 2: Train / Test Split

```{r}
train <- cbind(DataAll[,3], train)
train <- train[sample(nrow(train)),]

TrainSet <- train[c(1:round(0.7*nrow(train))),]
TestSet <- train[c((round(0.7*nrow(train))+1):nrow(train)),]
```

#### Step 3: Modeling

```{r}
library(e1071)

S <- svm(as.factor(TrainSet[,1]) ~ ., data=TrainSet, kernel = 'sigmoid', type = 'C-classification', gamma = 1/2000)

p <- predict(S, newdata = TestSet)
result <- table(TestSet[,1],p)
acc <- sum(diag(result)) / nrow(TestSet)
acc
```