library(rvest)
library(stringi)
library(tidyverse)
library(tidytext)
library(rJava)
library(wordVectors)
library(tsne)
library(ggplot2)
library(ggdendro)

base_url_prefix <- "http://www.1372.go.kr/contents/include.ccn?gSiteCode=2&gMenuCode=4&nMenuCode=13&mPart=&startCount="
base_url_suffix <- "0&impbcd=380000"
article_list <- c()

for(i in 1:177) {
  temp <- read_html(paste0(base_url_prefix, i, base_url_suffix))
  new_article <- temp %>%
    html_nodes(xpath='//table[@class="boardList"]/tbody/tr/td[@class="subject"]/a/@href') %>%
    html_text()
  article_list <- c(article_list, new_article)
}

# Getting items
base_url ="http://www.1372.go.kr"
pb <- txtProgressBar(min=0, max=length(article_list), style=3)
articles <- data_frame(title=character(), id=character(), rec=character(), cat=character(), main=character(), man=character(), ans=character())

for(i in 1:length(article_list)) {
  temp <- read_html(paste0(base_url, article_list[i]))

  temp_t <- temp %>%
    html_nodes(xpath='//th[@id="contentsViewTitle"]') %>%
    html_text()

  temp_b <- temp %>%
    html_nodes(xpath='//table[@class="boardView mgT10"]/tbody/tr/td') %>%
    html_text()

  setTxtProgressBar(pb, i)

  temp_d <- data_frame(title=temp_t, id=temp_b[1], rec=temp_b[2], cat=temp_b[3], main=temp_b[4], man=temp_b[5], ans=temp_b[6])
  articles <- bind_rows(articles, temp_d)
}

as_tibble(articles)

# Building test data: Using morpheme extractor

question <- as.character(unique(articles$main))
question <- stri_replace_all_regex(stri_trans_nfkc(question), "[[:punct:]]", "") %>%
  stri_replace_all_regex("[임|인]플[란|런|랜]트", "임플란트") %>%
  stri_replace_all_regex("스[켈|케일|캘]링", "스케일링") %>%
  stri_replace_all_regex("레진(치료)*", "레진") %>%
  stri_replace_all_regex("[0-9]+개월", "<DUR> ") %>%
  stri_replace_all_regex("[월|화|수|목|금|토|일]+요일", "<WK> ") %>%
  stri_replace_all_regex("[0-9]+년", "<YR> ") %>%
  stri_replace_all_regex("[0-9]+월", "<MON> ") %>%
  stri_replace_all_regex("[0-9]+일", "<DAY> ") %>%
  stri_replace_all_regex("[아침|오전|점심|저녁]*[0-9]+시", "<HR> ") %>%
  stri_replace_all_regex("[0-9]+분", "<MIN> ") %>%
  stri_replace_all_regex("[0-9]+원", "<PAY> ") %>%
  stri_replace_all_regex("[0-9]+개", "<NUM> ") %>%
  stri_replace_all_regex("[0-9]+(회|번)", "<TIM> ") %>%
  stri_replace_all_regex("[0-9]+", "") %>%
  stri_replace_all_regex("\\s+", " ") %>%
  stri_replace_all_regex("http[a-zA-Z0-9]+", "") %>%
  stri_replace_all_regex("[ㄱ-ㅎㅏ-ㅣ]+", "<UNK> ")

# tokenization, remove tokens with 1 occurrence

questions <- data_frame(text=question)
questions$tag <- sapply(questions$text, function(x) { get_token_komoran(x) })
questions$concat <- sapply(questions$tag, function(x) { paste0(as.character(unlist(x)), collapse=" ") })

texts <- data_frame(text=questions$concat)

tokens <- texts %>%
  unnest_tokens(word, text, token=stringr::str_split, pattern=" ", drop=FALSE) %>%
  rownames_to_column()

word_count <- tokens %>%
  count(word) %>%
  arrange(desc(n))

# 불용어 처리: 1회만 나타난 단어 또는 다빈도 130 순위까지에서 중요 단어 제외하여 선정
stop_words <- word_count[, 1]
# stop_words <- bind_rows(stop_words, word_count[1:130, 1]) # 실제로는 10개 정도씩 확인해가면서 필요없는 단어를 불용어 목록에 포함시켰습니다.
stop_words <- bind_rows(stop_words, filter(word_count, n == 1)[, 1])

token <- anti_join(tokens, stop_words, by="word")
token <- arrange(token, as.numeric(rowname))

tidy_question <- token %>%
  group_by(text) %>%
  mutate(tidy_text = paste0(word, collapse=" "))

tidy_questions <- as.character(unique(tidy_question$tidy_text)) %>%
  stri_replace_all_regex("\\+[a-z]+", "")

tidy_questions[1]

writeLines(tidy_questions, '1372_question_tag.txt')

# Best model을 위한 hyperparameter tuning을 좀 더 고민해봐야 할 것 같습니다.
w2v_model <- train_word2vec('1372_question_tag.txt', '1372_question_vectors_tag.bin',
                            vectors=200, threads=4, window=10, iter=10, negative_samples=4, force=TRUE)

# 다음 번에 다시 불러오려면
# w2v_model <- read.vectors('1372_question_vectors_tag.bin')

w2v_model %>% closest_to('임플란트')

w2v_model %>% closest_to('교정')

w2v_model %>% closest_to('스케일링')

w2v_model %>%
  closest_to(w2v_model[[c('치과', '치아', '아말감', '레지', '신경', '크라운', '잇몸', '교정', '발치', '스케일링')]], 50)

restoration <- closest_to(w2v_model, w2v_model[[c('아말감', '레지', '신경', '코아')]], 100)
rest <- w2v_model[[restoration$word, average=F]]
vectors <- stats::predict(stats::prcomp(rest))[ ,1:2]
graphics::plot(vectors, type='n')
graphics::text(vectors, labels=rownames(vectors), cex=0.7, family="Apple SD Gothic Neo")

centers <- 200
clustering <- kmeans(w2v_model, centers=centers, iter.max = 40)

sapply(c(2:3, 11, 19, 28, 35:37, 46:47), function(n) {
  names(clustering$cluster[clustering$cluster==n][1:10])
})

# 10 words closest to each of 4 different kinds of words
domain <- c("임플란트", "교정", "레지", "크라운")

term_set <-  lapply(domain, function(area) {
  nearest_words = w2v_model %>% closest_to(w2v_model[[area]], 10)
  nearest_words$word }) %>%
  unlist

subset <- w2v_model[[term_set, average=F]]

subset %>%
  cosineDist(subset) %>%
  as.dist %>%
  hclust %>%
  ggdendrogram(rotate=TRUE, theme_dendro=FALSE) +
  theme(text=element_text(family="Apple SD Gothic Neo"))

anesthesia <- w2v_model[[c("치과", "마취"), average=F]]

# 모형에 상위 2000번째 단어까지만 사용합니다.
dental_anesthesia <- w2v_model[1:2000, ] %>%
  cosineSimilarity(anesthesia)

# 관련 상위 20등까지의 단어만 추출합니다.
dental_anesthesia <- dental_anesthesia[
  rank(-dental_anesthesia[ ,1]) < 20 | rank(-dental_anesthesia[ ,2]) < 20,
]
plot(dental_anesthesia, type='n', family="Apple SD Gothic Neo")
text(dental_anesthesia, labels=rownames(dental_anesthesia), family="Apple SD Gothic Neo", cex=0.7)

# Shrink down to 3 dimensions
areas <- w2v_model[[c("임플란트", "교정", "크라운"), average=F]]

common_similarities_areas <- w2v_model[1:2000, ] %>%
  cosineSimilarity(areas)
common_similarities_areas[30:40, ]

# filter down to 50 words
high_similarities_to_areas <- common_similarities_areas[rank(-apply(common_similarities_areas, 1, max)) < 75, ]
high_similarities_to_areas %>%
   prcomp %>%
   biplot(main="Fifty words in a\nprojection of dental space", expand=5, family="Apple SD Gothic Neo", cex=0.5)

temp <- as.matrix(w2v_model)
short <- temp[1:100, ]
m <- tsne(short, perplexity=50)
tsne.out <- data.frame(x=m[,1], y=m[,2])
ggplot(tsne.out) +
  geom_text(aes(x=x, y=y, label=rownames(short), size=((100:1)/400)^(1/2)), family="Apple SD Gothic Neo") +
  theme(legend.position="none")