library(stringi)
library(stringr)
library(tidyverse)
library(tidytext)
library(KoNLP)
library(ggplot2)
library(lubridate)
library(tm)
library(topicmodels)
library(LDAvis)
library(Rmpfr)

dics <- c('sejong, woorimalsam')
category <- c('health general')
user_d <- data.frame(term=c("치과", "레진", "임플란트", "사랑니", "보철물", "치석", "재치료", "이메일", "틀니", "치아번호", "브릿지"), tag=rep('ncn', 11))
buildDictionary(ext_dic=dics, category_dic_nms=category, user_dic=user_d, replace_usr_dic=TRUE)

articles$rec <- ymd(articles$rec)
articles$year <- year(articles$rec)

dental <- c('치과', '치아교정', '치과보증금환불', '치과병원', '임플란트 보철', '이빨', '임플란트', '치과임풀란트', '치과치료 불량', '치과진료', '페이스라인치과', '치과보철치료', '치과의료', '한울치과', '의료사고(치과)', '치과보철', '치과 보철비용', '플라스틱 치아 교정기', '치과 임프란트', '치과 교정', '치과교정', '치과 포철', '치아브릿지', '치아', '교합안정장치', '충치 치료')

dental_df <- articles %>%
  filter(cat %in% dental)

table(dental_df$cat)

dental_df$rec <- ymd(dental_df$rec)
dental_df$year <- year(dental_df$rec)

ggplot(data=as.data.frame(table(dental_df$year)/table(articles$year)), aes(x=Var1, y=Freq)) +
  geom_bar(stat='identity') +
  labs(x="Year", y="Frequency of dental complaints")

question <- as.character(unique(dental_df$main))
question <- str_replace_all(question, "[[:punct:]]", "") %>%
  str_replace_all("[임|인][플|풀|프][란|런|랜]트", "임플란트") %>%
  str_replace_all("스[켈|케일|캘]링", "스케일링") %>%
  str_replace_all("레진(치료)*", "레진") %>%
  str_replace_all("어금[이|니]", "어금니") %>%
  str_replace_all("손해자", "피해자") %>%
  str_replace_all("[0-9]+번", "치아번호 ") %>%
  str_replace_all("의사[선생]*[님]*", "의사") %>%
  str_replace_all("치아교정", "교정") %>%
  str_replace_all("없읍", "없습") %>%
  str_replace_all("[0-9]+", " ") %>%
  str_replace_all("\\s+", " ") %>%
  str_replace_all("http[a-zA-Z0-9]+", "") %>%
  str_replace_all("[ㄱ-ㅎㅏ-ㅣ]+", "이모티콘")

ko_words <- function(doc) {
  d <- as.character(doc)
  pos <- unlist(SimplePos22(d))

  extracted <- str_match(pos, '([가-힣]+)/[NP][A-Z]')

  keyword <- extracted[, 2]
  keyword[!is.na(keyword)]
}

pos <- Map(ko_words, question)

corpus <- Corpus(VectorSource(pos))

stopWords <- c("치과", "치료", "치아", "병원", "만원")

dtm <- DocumentTermMatrix(corpus, control=list(
  removePunctuation=TRUE, stopwords=stopWords,
  removeNumbers=TRUE, wordLengths=c(4, 20), weighting=weightTf))

q_lda <- LDA(dtm, k=2, seed=1234)

q_topics <- tidy(q_lda, matrix="beta")

q_top_terms <- q_topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

q_top_terms %>%
  mutate(term=reorder(term, beta)) %>%
  ggplot(aes(term, beta, fill=factor(topic))) +
  geom_col(show.legend=FALSE) +
  facet_wrap(~ topic, scales="free") +
  coord_flip() +
  theme(axis.text.y=element_text(family="Apple SD Gothic Neo"))

beta_spread <- q_topics %>%
  mutate(topic=paste0("topic", topic)) %>%
  spread(topic, beta) %>%
  filter(topic1 > .001 | topic2 > .001) %>%
  mutate(log_ratio=log(topic2 / topic1))

bind_rows(beta_spread %>% top_n(-10, log_ratio), beta_spread %>% top_n(10, log_ratio)) %>%
  ggplot(aes(reorder(term, log_ratio), log_ratio)) +
  geom_col(show.legend=FALSE) +
  labs(x="term", y="Log2 ratio of beta in topic 2 / topic 1") +
  coord_flip() +
  theme(axis.text.y=element_text(family="Apple SD Gothic Neo"))

q_documents <- tidy(q_lda, matrix="gamma")
q_documents

tidy(dtm) %>%
  filter(document == 8) %>%
  arrange(desc(count))

q2_lda <- LDA(dtm, k=4, seed=1234)

q2_topics <- tidy(q2_lda, matrix="beta")

top_terms <- q2_topics %>%
  group_by(topic) %>%
  top_n(7, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

top_terms %>%
  mutate(term=reorder(term, beta)) %>%
  ggplot(aes(term, beta, fill=factor(topic))) +
  geom_col(show.legend=FALSE) +
  theme(axis.text.y=element_text(family="Apple SD Gothic Neo")) +
  facet_wrap(~ topic, scales="free") +
  coord_flip()

harmonicMean <- function(logLikelihoods, precision=2000L) {
  llMed <- median(logLikelihoods)
  as.double(llMed - log(mean(exp(-mpfr(logLikelihoods,
                                       prec=precision) + llMed))))
}

seqk <- seq(2, 40, 1)
burnin <- 1000
iter <- 1000
keep <- 50

fitted_many <- lapply(seqk, function(k) LDA(dtm, k=k, method="Gibbs", control=list(burnin=burnin, iter=iter, keep=keep)))

logLiks_many <- lapply(fitted_many, function(L) L@logLiks[-c(1:(burnin/keep))])

hm_many <- sapply(logLiks_many, function(h) harmonicMean(h))

ggplot(data.frame(seqk, hm_many), aes(x=seqk, y=hm_many)) +
  geom_path(lwd=1.5) +
  theme(text=element_text(family=NULL),
        axis.title.y=element_text(vjust=1, size=16),
        axis.title.x=element_text(vjust=-.5, size=16),
        axis.text=element_text(size=16),
        plot.title=element_text(size=20)) +
  xlab('Number of Topics') +
  ylab('Harmonic Mean') +
  ggplot2::annotate("text", x=9, y=-199000, label=paste("The optimal number of topics is", seqk[which.max(hm_many)])) +
  labs(title="Latent Dirichlet Allocation Analysis",
       subtitle="How many distinct topics?")

q_model <- LDA(dtm, k=17, method="Gibbs", control=list(iter=2000))

q_topics <- topics(q_model, 1)
q_terms <- as.data.frame(terms(q_model, 20), stringsAsFactors=FALSE)
q_terms[1:5]

K <- 17
G <- 5000
alpha <- 0.02

fit <- LDA(dtm, k=K, method='Gibbs', control=list(iter=G, alpha=alpha))

phi <- posterior(fit)$terms %>% as.matrix
theta <- posterior(fit)$topics %>% as.matrix
vocab <- colnames(phi)
doc_length <- c()
for(i in 1:length(corpus)) {
  temp <- paste(corpus[[i]]$content, collapse=" ")
  doc_length <- c(doc_length, stri_count(temp, regex='\\S+'))
}
temp_frequency <- as.matrix(dtm)
freq_matrix <- data.frame(ST=colnames(temp_frequency),
                          Freq=colSums(temp_frequency))
rm(temp_frequency)

json_lda <- createJSON(phi=phi,
                       theta=theta,
                       vocab=vocab,
                       doc.length=doc_length,
                       term.frequency=freq_matrix$Freq)

serVis(json_lda, out.dir='2017-08-15-complaint-vis', open.browser=FALSE)