dissertation.Rmd

---
title: "dissertation"
author: "Jung"
output: html_document
---

```{r setup}
# rm(list=ls())
library(knitr)
library(dplyr)
library(stringr)
library(data.table)
library(RSQLite)
library(parallel)
library(doSNOW)
library(quanteda)
library(tidytext)
library(textstem)
library(rvest)
library(ggplot2)
library(tidyr)
library(reshape2)
library(stringi)
library(hunspell)
library(textstem)
library(tidyquant)
library(tm)
library(koRpus)
library(koRpus.lang.en)
library(stm)
```


```{r custom function}
# make progress bar 
optionSnow <- function (iterations) {
  i <- iterations
  pb <- txtProgressBar(max = i, style = 3)
  progress <- function(n) setTxtProgressBar(pb, n)
  opts <- list(progress = progress)
  return(opts)
}

# fetch data from back up database
loaddf <- function (dbname, dfname) {
  con <- dbConnect(RSQLite::SQLite(), paste0(dbname,".db"))
  df <- dbGetQuery(con, paste("SELECT * FROM", dfname))
  dbDisconnect(con)
  return(df)
}

# save data to back up database
backup <- function (dbname, dfname, df) {
  con <- dbConnect(SQLite(), paste0(dbname, ".db"))
  dbWriteTable(con, dfname, df, overwrite=TRUE)
  print(paste("Dataframe", dfname, "has been written to back up database!"))
  print(dbListTables(con))
  dbDisconnect(con)
}

# check the database tables
dbcheck <- function (dbname) {
  con <- dbConnect(SQLite(), paste0(dbname, ".db"))
  print((dbListTables(con)))
  dbDisconnect(con)
}

# decode unicodes
normalise_unicode <- function (unicode_review) {
  # decode unicodes in the reviews
  # cld2 result = NA includes unicodes
  # if not successful remove all unicodes
  normalised <- c(stri_trans_nfc(unicode_review), stri_trans_nfd(unicode_review),
                  stri_trans_nfkd(unicode_review),  stri_trans_nfkc(unicode_review),
                  stri_trans_nfkc_casefold(unicode_review))
  
  for (i in 1:length(normalised)) {
    if (grepl("en", cld2::detect_language(normalised[i])) == TRUE) {
      normalised_review <- normalised[i]
      normalised_review <- iconv(normalised_review, "latin1", "ASCII", sub="")
      break
    }
  }
  
  # if normalisation does not work
  # remove all the non-english characters (i.e. unicodes)
  if (exists("normalised_review") == FALSE) {
    normalised_review <- iconv(unicode_review, "latin1", "ASCII", sub="")
  }
  
  return(normalised_review)
}

postagging <- function (tokens, doc_list) {
  # my customised postagging function
  
  opts <- optionSnow(length(doc_list))
  # make clusters for parallel processing
  cl <- makePSOCKcluster(detectCores()-1)
  registerDoSNOW(cl)
  clusterEvalQ(cl, {
    library(dplyr)
    library(tidyr)
    library(data.table)
    library(koRpus)
    library(koRpus.lang.en)
  }
  )
  
  words_postagged <- foreach(i = 1:length(doc_list), .options.snow = opts, .combine = rbind) %dopar% {
    # pick one id
    this_id <- as.character(doc_list[i])
    this_word <- tokens %>% filter(id == this_id) %>% select(word) %>% pull()
    
    # save only words as txt file
    # to be tagged by treetagger engine
    fwrite(list(this_word), file = paste0("./text/",this_id,".txt"))
    
    # perform POS tagging
    text.tagged <- treetag(paste0("./text/",this_id,".txt"),
                           treetagger = "manual", 
                           lang = "en", 
                           doc_id = this_id,
                           TT.options = list(path = "C:/TreeTagger", preset = "en"))
    
    # get text.tagged result
    tokens_tagged <- text.tagged@TT.res
    
    tokens_tagged <- tokens_tagged %>% 
      filter(wclass == "noun") %>%
      select(doc_id, token) %>%
      rename(word = token)
    
    # remove txt files after finishing pos tagging
    unlink(paste0("./text/",this_id,".txt"))
    rm(text.tagged)
    
    return(tokens_tagged)
  }
  
  doParallel::stopImplicitCluster()
  stopCluster(cl)
  rm(cl)
  gc()
  
  return(words_postagged)
}


clean_language <- function (tokens_df) {
  
  cl <- makePSOCKcluster(detectCores()-4)
  registerDoSNOW(cl)
  
  tokens_df$word <- parSapply(cl=cl,
                              tokens_df$word, 
                              function(x) {
                                iconv(x, "latin1", "ASCII", sub="")
                                }
                              )
  
  tokens_df <- tokens_df %>% 
    group_by(word, id) %>%
    summarise(n = sum(n)) %>% ungroup()
  
  stopCluster(cl)
  rm(cl)
  gc()
  
  return(tokens_df)
}

combine_tokens <- function (x, y, df) {
  ### df must have columns of word, id, n, token_length
  
  xy_id <- df %>% 
  filter(word == x) %>%
  select(id) %>% 
  pull()

  xy_id <- df %>%
    filter(id %in% xy_id, word == y) %>%
    select(id) %>%
    pull()
  
  for (i in 1:length(xy_id)) {
    
    this_xy_id <- xy_id[i]
  
    x_and_y <- df %>%
      filter(id == this_xy_id) %>%
      filter(word %in% c(x, y))
    
    no_of_x <- x_and_y %>% filter(word == x) %>% select(n) %>% pull()
    no_of_y <- x_and_y %>% filter(word == y) %>% select(n) %>% pull()
    
    if (no_of_x <= no_of_y) {
      # update index and n values
      ind <- which(df$word %in% c(x,y) & df$id == this_xy_id)
      
      # update x and y
      df[ind,] <- df[ind,] %>% mutate(n = n - no_of_x) 
    
      # add xy
      df <- df %>%
        rbind(tibble(
          word = paste0(x,y),
          id = this_xy_id,
          n = no_of_x,
          token_length = nchar(paste0(x,y))
        )
        )

    } else {
      # update index and n values
      ind <- which(df$word %in% c(x,y) & df$id == this_xy_id)
      
      # update x and y
      df[ind,] <- df[ind,] %>% mutate(n = n - no_of_y) 
    
      # add xy
      df <- df %>%
        rbind(tibble(
          word = paste0(x,y),
          id = this_xy_id,
          n = no_of_y,
          token_length = nchar(paste0(x,y))
        )
        )
    }
  }
  
  df <- df %>% filter(n > 0)
  
  return(df)
} 

```

# Text pre-processing

## Load reviews data and prepare stopwords

```{r}
df <- loaddf("appstore", "reviews")

data("stop_words")
# keep competitors like spotify or apple
stop_words <- rbind(stop_words,
                    tibble(word=c("tidal","music", "love","app",
                                  "isn", "aren", "ain", "ive",
                                  "don", "doesn", "im", "apps"),lexicon="custom"))

negation1 <- gsub("'","’",stop_words$word[grepl("'t",stop_words$word)])

stop_words <- rbind(stop_words,
                    tibble(word=negation1, lexicon="custom"))

negation2 <- gsub("'","",stop_words$word[grepl("'t",stop_words$word)])

stop_words <- rbind(stop_words,
                    tibble(word=negation2, lexicon="custom"))

# stop_words <- stop_words %>%
#   filter(!word == "hi")

stop_words <- rbind(stop_words,
                    tibble(word=c("lol", "yall", "tho", 
                                  "def", "lot", "alot",
                                  "lover", "bit", "guy",
                                  "tidals"), lexicon="custom"))
```

## Drop too meaningless reviews

```{r}
# drop rows with extreme number of characters
df$review_length_chars <- nchar(df$review)

df <- df %>% 
  filter(review_length_chars > 30)
```

## Language processing

```{r}
# general language detection on review texts
df <- df %>% 
  mutate(review_language = cld2::detect_language(review))

# extract reviews with NA languages
# clean and normalise the text 
# to check whether it can be interpreted as a plain english text
unicode_review <- df %>% 
  filter(is.na(review_language))

unicode_review$review <- sapply(unicode_review$review, normalise_unicode, USE.NAMES = FALSE)

unicode_review$review <- unicode_review$review %>% trimws()

unicode_review$review_length_chars <- nchar(unicode_review$review)
unicode_review <- unicode_review %>% 
  filter(review_length_chars > 30)

unicode_review <- unicode_review %>% 
  mutate(review_language = cld3::detect_language(review)) %>%
  filter(review_language == "en")

# combine only english texts  
df <- df %>% 
  filter(review_language == "en") %>%
  rbind(unicode_review)

rm(unicode_review)
gc()

```

## Tokenisation

```{r}
# tokenisation and remove stop words
# negation handling (e.g. arent -> are not) -> stop words do this
tokens <- df %>% 
  unnest_tokens(word,review) %>%
  count(word,id) %>%
  anti_join(stop_words)
```


## Clean non-English words

```{r}
# non english (latin1) token detection in words
# this may cause duplicate rows by removing non-english words
# e.g. adaâ	-> ada will become same with the word originally ada
# and remove digits and puntuations
tokens <- clean_language(tokens)

tokens$word <- gsub('[[:punct:]]+','', tokens$word)
tokens$word <- gsub('[[:digit:]]+','', tokens$word)

# remove empty strings
tokens <- tokens %>% 
  filter(word != "")

tokens <- tokens %>% 
    group_by(word, id) %>%
    summarise(n = sum(n)) %>% ungroup()
```

## clean repetitive patterns of words

```{r}
# deal with repetitive characters or patterns of characters
# at least three times
# e.g. aaaa or wowwowwowwow

repititive_stopwords <- tokens %>% 
  filter(grepl("\\b(\\S+?)\\1\\1\\S*\\b", tokens$word)) %>% 
  select(word) %>%
  pull() %>%
  unique()

tokens <- tokens %>%
  filter(!word %in% repititive_stopwords)

rm(repititive_stopwords)
gc()

```

## drop extreme length of words

```{r}
# drop characters with abnormal length

tokens$token_length <- nchar(tokens$word)

# there could be domain specific words less than 3 chracters
# music related: dj, cd, tv, pc, ft (featuring), hi, fi, ... 
# app related: ui, ux ...
# I decided to keep words that appears over 30 times and remove unnecessary words amongst them
# remove im, ve: appears more than 1000 times but those are from I'm and I've (useless)

lessthan_3 <- tokens %>% 
  filter(token_length < 3) %>% 
  count(word) %>%
  filter(n >= 30) %>% 
  select(word) %>%
  pull()

domain_lessthan_3 <- c("ad","cd", "dj", "hd", "hq", "id","os", "tv", "pc","ui", "ux", "uk", "wi", "hi", "fi")
```

```{r}
domain_for_rbind <- tokens %>% 
  filter(token_length < 3) %>%
  filter(word %in% domain_lessthan_3)


domain_for_rbind <- combine_tokens("hi","fi",domain_for_rbind)
domain_for_rbind <- combine_tokens("wi","fi", domain_for_rbind)

```

```{r}
# length 3 to 17
tokens <- tokens %>% 
  filter(token_length >= 3) %>%
  filter(token_length <= 17) %>%
  rbind(domain_for_rbind)

tokens <- tokens %>% 
    group_by(word, id) %>%
    summarise(n = sum(n)) %>% ungroup()
```

## Lemmatisation

```{r}
# lemma

lemma_dictionary_tt <- make_lemma_dictionary(tokens$word, engine = 'treetagger')
tokens$word <- lemmatize_words(tokens$word, lemma_dictionary_tt)

```

## TF-IDF

```{r}
# tf_idf for word trimming
tokens_tf_idf <- tokens %>%
  bind_tf_idf(word,id,n) 

tokens_tf_idf %>%
  arrange(tf_idf) %>%
  View()

hist(tokens_tf_idf$tf_idf,breaks = 200,main="TF-IDF plot")

## trimming
# remove too rare terms
tokens_tf_idf <- tokens_tf_idf %>% 
  filter(tf_idf<4)

hist(tokens_tf_idf$tf_idf,breaks = 100,main="TF-IDF plot")

save(tokens_tf_idf, file = "tokens_tf_idf.rda")
```

## Visualise top 20 words

```{r}
# visualise
top_20 <- tokens_tf_idf %>%
  group_by(word) %>%
  summarise(n = sum(n)) %>%
  arrange(desc(n)) %>%
  top_n(20) %>%
  mutate(rank = row_number())

ggplot(top_20, 
       aes(x = reorder(word, n), y = n)) + 
  geom_bar(stat = "identity") + 
  coord_flip() +
  ylab("frequency") +
  xlab("top 20 word")
```

## Pos-tagging

Pos-tagging takes longer time than other processes. Therefore, it has been implemented through `shell scripting` for faster process.

```{r}

```


# Structural Topic Modelling (STM)

## Prepare data for STM

```{r}
df <- loaddf("appstore", "reviews")
postag_tokens <- loaddf("postag_tokens", "postag_tokens")


# last filtering of stop words
postag_tokens <- postag_tokens %>%
  anti_join(stop_words)

# combine hip and hop together
# to represent word hiphop properly 
hiphop_id <- postag_tokens %>% 
  filter(word == "hip") %>%
  select(doc_id) %>% 
  pull()

hiphop_id <- postag_tokens %>%
  filter(doc_id %in% hiphop_id, word == "hop") %>%
  select(doc_id) %>%
  pull()

for (i in 1:length(hiphop_id)) {
  this_id <- hiphop_id[i]
  
  postag_tokens <- postag_tokens %>%
  rbind(tibble(
    doc_id = this_id,
    word = "hiphop"
    )
    )
  
  ind <- which(postag_tokens$word %in% c("hip","hop") & postag_tokens$doc_id == this_id) 
  postag_tokens <- postag_tokens[-ind,]
  
}
rm(i, ind, this_id, hiphop_id)
gc()

# additional lemmatisation

# playlist
postag_tokens$word[grepl("playlist", postag_tokens$word)] <- "playlist"

# podcast
postag_tokens$word[grepl("podcast", postag_tokens$word)] <- "podcast"

# download
postag_tokens$word[grepl("download", postag_tokens$word)] <- "download"

# headphone
postag_tokens$word[grepl("headphone", postag_tokens$word)] <- "headphone"

postag_tokens <- postag_tokens[!duplicated(postag_tokens),]

```

```{r}

annotated_text <- postag_tokens %>% group_by(doc_id) %>%
  summarise(annotated_text = paste(word,collapse = " "),
            total_text = n())

data_for_stm <- annotated_text %>%
  filter(total_text >= 2) %>%
  select(-total_text) %>%
  mutate(doc_id = as.integer(doc_id)) %>%
  left_join(., df, by = c("doc_id" = "id"))

data_for_stm$date <- zoo::as.Date(data_for_stm$date)
data_for_stm$date_numeric <- as.numeric(data_for_stm$date)

# process annotated comments
processed_data <- textProcessor(data_for_stm$annotated_text,
                                metadata = data_for_stm,
                                stem = F)

# keep only the vocabulary that appears at the 0.5% of all documents (at least 265 documents)
# setting the threshold for this
threshold <- round(1/200 * length(processed_data$documents),0)

# prepare documents for structural topic model (stm)
out <- prepDocuments(processed_data$documents,
                     processed_data$vocab,
                     processed_data$meta,
                     lower.thresh = threshold)
```

## Implement STM

```{r}
# K =0 to figure out the optimal number of topics quickly
tidal <- stm(documents = out$documents,
                     vocab = out$vocab,
                     K = 0,
                     prevalence =~ origin + rating + s(date_numeric),
                     max.em.its = 75, 
                     data = out$meta,
                     reportevery=3,
                     # gamma.prior = "L1",
                     sigma.prior = 0.7,
                     init.type = "Spectral")

# visualise the topics
# topicQuality(tidal, documents = out$documents)
# plot(tidal,labeltype = "prob")

```

## Labelling Topics

```{r}
topic_summary <- summary(tidal)
topic_proportions <- colMeans(tidal$theta)

table_towrite_labels <- data.frame()

# make summary table for topic results
for(i in 1:length(topic_summary$topicnums)){
  
  row_here <- tibble(topicnum= topic_summary$topicnums[i],
                     topic_label = paste(topic_summary$frex[i,],
                                        collapse = "_"),
                     proportion = 100*round(topic_proportions[i],4),
                     frex_words = paste(topic_summary$frex[i,],
                                        collapse = ", "))
  table_towrite_labels <- rbind(row_here,table_towrite_labels)
}

table_towrite_labels <- table_towrite_labels %>% arrange(topicnum)

# save(tidal, out, table_towrite_labels, file = "tidal.rda")
```

## Visualisation

```{r}

# covariate -> origin, rating, date
# s(date_filed) for spline function
# enables more smoothe curve of the time series

effects <- estimateEffect(~ origin + rating + s(date_numeric),
                          stmobj = tidal,
                          metadata = out$meta)

# back up
save(effects, file =  "effects.rda")
```

```{r}
## apple = 1, android = 2

plot(effects, 
     covariate = "origin",
     topics = 1:length(topic_summary$topicnums),
     model = tidal, method = "difference",
     cov.value1 = "100", cov.value2 = "0",
     xlab = "appstore_origin",
     # xlim = c(-0.01,0.01),
     main = "Marginal change on topic probabilities for origin",
     custom.labels = table_towrite_labels$topicnum,
     labeltype = "custom")

# apple -> 33,9,22,6,29,28,1,8 ...
# android -> 13,34,25,24,12,5,23,3 ...

# linear relationship between each topic and origin

for(i in 1:length(topic_summary$topicnums)){
  plot(effects, covariate = "origin",
       topics = i,
       model = tidal, method = "continuous",
       # For this plotting we get the uper quantile
       # and low quantile of the price 
       xlab = "appstore_origin",
       # xlim = c(0,1000),
       main = table_towrite_labels$topicnum[i],
       printlegend = FALSE,
       custom.labels =table_towrite_labels$topicnum[i],
       labeltype = "custom")
}

# summary(effects, topics = 33)$tables[[1]][2,]
```

```{r}
plot(effects, 
     covariate = "rating",
     topics = 1:length(topic_summary$topicnums),
     model = tidal, method = "difference",
     cov.value1 = "100", cov.value2 = "0",
     xlab = "rating",
     # xlim = c(-0.01,0.01),
     main = "Marginal change on topic probabilities for rating",
     custom.labels = table_towrite_labels$topicnum,
     labeltype = "custom")
```

# Ranking model (Total)

## Origin

```{r}
theta <- as.data.frame(tidal$theta)

# use topic number not label 
# for convenience
colnames(theta) <- table_towrite_labels$topic_label

meta_theta <- cbind(out$meta,theta)
```

```{R}
origin_theta <- meta_theta %>%
  select(origin, 9:44) %>%
  group_by(origin) %>%
  summarise_at(vars(all_of(colnames(theta))), mean) %>%
  t(.) %>%
  as_tibble() %>%
  janitor::row_to_names(row_number = 1) %>%
  mutate(topic_label = table_towrite_labels$topic_label)

# apple
origin_theta %>% select(topic_label, `1`) %>% arrange(desc(`1`))
# google
origin_theta %>% select(topic_label, `2`) %>% arrange(desc(`2`))
```

## Topic Volume

```{r}
# calculate topic volume
data_for_rank <- tibble()
for (i in 1:nrow(table_towrite_labels)) {
  this_topic_volume <- tibble(
    topic_labels = table_towrite_labels$topic_label[i],
    volume = sum(theta[,i])
  )
  data_for_rank <- rbind(data_for_rank, this_topic_volume)
  rm(i, this_topic_volume)
  gc()
}
```

## Topic Polarity

```{r}
data_for_rank$polarity <- NA
data_for_rank$direction <- NA

for (i in 1:nrow(table_towrite_labels)) {
  rating_theta_productsum <- meta_theta[,5] %*% theta[,i] %>% .[1,1]
  data_for_rank$polarity[i] <- ((rating_theta_productsum / data_for_rank$volume[i])-3)^2
  
  if ((rating_theta_productsum / data_for_rank$volume[i])-3 < 0) {
    data_for_rank$direction[i] <- -1
  } else if ((rating_theta_productsum / data_for_rank$volume[i])-3 > 0) {
    data_for_rank$direction[i] <- 1
  } else {
    data_for_rank$direction[i] <- 0
  }
}
```

## Topic Timeliness

```{r}
meta_theta <- meta_theta %>%
  mutate(month = cut.Date(date, "month"))

timeframe <- levels(meta_theta$month)

data_for_rank$timeliness <- NA
topic_timewindow <- tibble()

for (i in 1:nrow(table_towrite_labels)) {
  print(paste("let's get it topic", i))
  this_topic_label <- table_towrite_labels$topic_label[i]
  
  this_topic_timewindow <- tibble()
  
  for (k in 1:length(timeframe)) {
    v_Wk <- meta_theta %>%
      filter(as.integer(month) == k) %>%
      count() %>%
      pull()
      
    v_t_Wk <- meta_theta %>%
      filter(as.integer(month) == k) %>%
      summarise(sum(eval(as.name(this_topic_label)))) %>%
      pull()
    
    p_t_Wk <- (v_t_Wk/v_Wk)
      
    l_k <- 2*k
    
    k_timewindow <- tibble(
      timewindow = timeframe[k],
      v_Wk = v_Wk,
      v_t_Wk = v_t_Wk,
      p_t_Wk = p_t_Wk,
      l_k = l_k,
      topic = this_topic_label
    )
    
    this_topic_timewindow <- rbind(this_topic_timewindow, k_timewindow)
  }
  print(paste("ok now I got timewindow data for topic",i))
  
  p_t <- this_topic_timewindow %>%
    summarise(sum(p_t_Wk)) %>%
    pull()
  
  data_for_rank$timeliness[i] <- ((pull(this_topic_timewindow[,4]) %*% pull(this_topic_timewindow[,5]) %>% .[1,1])/p_t)
  topic_timewindow <- rbind(topic_timewindow, this_topic_timewindow)
  
  print(paste("yeeeee got timeliness for topic",i))
}

rm(i,k,v_Wk, v_t_Wk, p_t_Wk, l_k, k_timewindow, this_topic_label, p_t, this_topic_timewindow)
gc()

# save(data_for_rank,data_for_rank_norm, topic_timewindow, file = "ranking_model_result.rda")

```

## Ranking

```{r}
w_v <- 0.2
w_p <- 0.4
w_t <- 0.4

data_for_rank <- data_for_rank %>% 
  mutate(score = w_v*volume + w_p*polarity + w_t*timeliness)

# resclae -> (x - min(x)) / (max(x) - min(x)) * desired_max

data_for_rank_norm <- data_for_rank %>%
  mutate_at(c("volume", "polarity", "timeliness"), ~(scales::rescale(., to = c(0, 100)) %>% as.vector)) %>%
  mutate(score_norm = w_v*volume + w_p*polarity + w_t*timeliness)

# negative ranking
data_for_rank_norm %>% 
  filter(direction < 0) %>%
  arrange(desc(score_norm)) %>% View()

# positive ranking
data_for_rank_norm %>% 
  filter(direction > 0) %>%
  arrange(desc(score_norm)) %>% View()

```

# Ranking model (Origin)

## Topic Volume

```{r}

data_for_rank_apple <- tibble()
data_for_rank_google <- tibble()

meta_theta_a <- meta_theta %>% filter(origin==1)
meta_theta_g <- meta_theta %>% filter(origin==2)

for (i in 1:nrow(table_towrite_labels)) {
  this_topic_label <- table_towrite_labels$topic_label[i]
  
  this_topic_volume_a <- tibble(
    topic_labels = this_topic_label,
    volume = meta_theta_a %>%
      summarise(sum(eval(as.name(this_topic_label)))) %>%
      pull()
    )
  this_topic_volume_g <- tibble(
    topic_labels = this_topic_label,
    volume = meta_theta_g %>%
      summarise(sum(eval(as.name(this_topic_label)))) %>%
      pull()
  )
  
  data_for_rank_apple <- rbind(data_for_rank_apple, this_topic_volume_a)
  data_for_rank_google <- rbind(data_for_rank_google, this_topic_volume_g)
}

rm(this_topic_label, this_topic_volume_a, this_topic_volume_g)
gc()
```

## Topic Polarity

```{r}

data_for_rank_apple$polarity <- NA
data_for_rank_apple$direction <- NA

data_for_rank_google$polarity <- NA
data_for_rank_google$direction <- NA

for (i in 1:nrow(table_towrite_labels)) {
  
  rating_theta_productsum_a <- meta_theta_a[,5] %*% meta_theta_a[,i+8] %>% .[1,1]
  rating_theta_productsum_g <- meta_theta_g[,5] %*% meta_theta_g[,i+8] %>% .[1,1]
  
  data_for_rank_apple$polarity[i] <- ((rating_theta_productsum_a / data_for_rank_apple$volume[i])-3)^2
  data_for_rank_google$polarity[i] <- ((rating_theta_productsum_g / data_for_rank_google$volume[i])-3)^2
  
  if ((rating_theta_productsum_a / data_for_rank_apple$volume[i])-3 < 0) {
    data_for_rank_apple$direction[i] <- -1
  } else if ((rating_theta_productsum_a / data_for_rank_apple$volume[i])-3 > 0) {
    data_for_rank_apple$direction[i] <- 1
  } else {
    data_for_rank_apple$direction[i] <- 0
  }
  
  if ((rating_theta_productsum_g / data_for_rank_google$volume[i])-3 < 0) {
    data_for_rank_google$direction[i] <- -1
  } else if ((rating_theta_productsum_g / data_for_rank_google$volume[i])-3 > 0) {
    data_for_rank_google$direction[i] <- 1
  } else {
    data_for_rank_google$direction[i] <- 0
  }
}

rm(rating_theta_productsum_a, rating_theta_productsum_g)
gc()
```

## Topic Timeliness

```{r}

meta_theta_a <- meta_theta_a %>%
  mutate(month = cut.Date(date, "month"))
meta_theta_g <- meta_theta_g %>%
  mutate(month = cut.Date(date, "month"))

timeframe_a <- levels(meta_theta_a$month)
timeframe_g <- levels(meta_theta_g$month)

data_for_rank_apple$timeliness <- NA
data_for_rank_google$timeliness <- NA

topic_timewindow <- tibble()

for (i in 1:nrow(table_towrite_labels)) {
  print(paste("let's get it topic", i))
  this_topic_label <- table_towrite_labels$topic_label[i]
  
  this_topic_timewindow <- tibble()
  
  for (k in 1:length(timeframe_a)) {
    v_Wk_a <- meta_theta_a %>%
      filter(as.integer(month) == k) %>%
      count() %>%
      pull()

    v_t_Wk_a <- meta_theta_a %>%
      filter(as.integer(month) == k) %>%
      summarise(sum(eval(as.name(this_topic_label)))) %>%
      pull()

    p_t_Wk_a <- (v_t_Wk_a/v_Wk_a)
    
    l_k <- 2*k
    
    k_timewindow_a <- tibble(
      timewindow = timeframe_a[k],
      v_Wk = v_Wk_a,
      v_t_Wk = v_t_Wk_a,
      p_t_Wk = p_t_Wk_a,
      l_k = l_k,
      topic = this_topic_label,
      origin = 1
    )
    
    this_topic_timewindow <- rbind(this_topic_timewindow, k_timewindow_a)
  }
  
  for (k in 1:length(timeframe_g)) {
    v_Wk_g <- meta_theta_g %>%
      filter(as.integer(month) == k) %>%
      count() %>%
      pull()
    
    v_t_Wk_g <- meta_theta_g %>%
      filter(as.integer(month) == k) %>%
      summarise(sum(eval(as.name(this_topic_label)))) %>%
      pull()
    
    p_t_Wk_g <- (v_t_Wk_g/v_Wk_g)
    
    l_k <- 2*k

    k_timewindow_g <- tibble(
      timewindow = timeframe_g[k],
      v_Wk = v_Wk_g,
      v_t_Wk = v_t_Wk_g,
      p_t_Wk = p_t_Wk_g,
      l_k = l_k,
      topic = this_topic_label,
      origin = 2
    )
    
    this_topic_timewindow <- rbind(this_topic_timewindow, k_timewindow_g)
  }
  
  print(paste("ok now I got timewindow data for topic",i))
  
  this_topic_timewindow_a <- this_topic_timewindow %>%
    filter(origin == 1)
  this_topic_timewindow_g <- this_topic_timewindow %>%
    filter(origin == 2)
  
  p_t_a <- this_topic_timewindow_a %>%
    summarise(sum(p_t_Wk)) %>%
    pull()
  p_t_g <- this_topic_timewindow_g %>%
    summarise(sum(p_t_Wk)) %>%
    pull()

  data_for_rank_apple$timeliness[i] <- ((pull(this_topic_timewindow_a[,4]) %*% pull(this_topic_timewindow_a[,5]) %>% .[1,1])/p_t_a)
  data_for_rank_google$timeliness[i] <- ((pull(this_topic_timewindow_g[,4]) %*% pull(this_topic_timewindow_g[,5]) %>% .[1,1])/p_t_g)
  
  topic_timewindow <- rbind(topic_timewindow, this_topic_timewindow)
}

rm(i,k,v_Wk_a, v_t_Wk_a, p_t_Wk_a, v_Wk_g, v_t_Wk_g, p_t_Wk_g,
   l_k, k_timewindow_a, k_timewindow_g, this_topic_label, p_t_a, p_t_g, 
   this_topic_timewindow_a, this_topic_timewindow_g)
gc()

```

## Ranking Score

```{r}
w_v <- 0.2
w_p <- 0.4
w_t <- 0.4

data_for_rank_apple <- data_for_rank_apple %>% 
  mutate(score = w_v*volume + w_p*polarity + w_t*timeliness)
data_for_rank_google <- data_for_rank_google %>% 
  mutate(score = w_v*volume + w_p*polarity + w_t*timeliness)

data_for_rank_norm_apple <- data_for_rank_apple %>%
  mutate_at(c("volume", "polarity", "timeliness"), ~(scales::rescale(., to = c(0, 100)) %>% as.vector)) %>%
  mutate(score_norm = w_v*volume + w_p*polarity + w_t*timeliness)
data_for_rank_norm_google <- data_for_rank_google %>%
  mutate_at(c("volume", "polarity", "timeliness"), ~(scales::rescale(., to = c(0, 100)) %>% as.vector)) %>%
  mutate(score_norm = w_v*volume + w_p*polarity + w_t*timeliness)

# negative ranking
data_for_rank_norm_apple %>% 
  filter(direction < 0) %>%
  arrange(desc(score_norm)) %>% View()
data_for_rank_norm_google %>% 
  filter(direction < 0) %>%
  arrange(desc(score_norm)) %>% View()

# positive ranking
data_for_rank_norm_apple %>% 
  filter(direction > 0) %>%
  arrange(desc(score_norm)) %>% View()
data_for_rank_norm_google %>% 
  filter(direction > 0) %>%
  arrange(desc(score_norm)) %>% View()

# topic_timewindow_origin <- topic_timewindow
# save(data_for_rank_apple, data_for_rank_google, 
#      data_for_rank_norm_apple, data_for_rank_norm_google,
#      topic_timewindow_origin, file = "ranking_model_origin_result.rda")
```