Notes

---
title: "STAT462_youtube"
author: "Maggie Zhang, Rohit Gangupantulu, Joshua Williams, Hang Nguyen, Zhenyu Wang"
date: "April 2, 2019"
output: pdf_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

``` {r warning=FALSE, message=FALSE}
library(dplyr)
library(ggplot2)
library(purrr)
library(tidytext) # text cleaning
library(tm) # text mining
library(SnowballC) # text stemming
library(keras)
library(wordcloud) # wordcloud generator
#library(RColorBrewer) # color palette generator for wordcloud
```

``` {r}
us <- read.csv('data/USvideos.csv', header=TRUE)
set.seed(123)
us_clean <- us[1:1000,]
smp_size <- floor(0.07 * nrow(us_clean))
train_ind <- sample(seq_len(nrow(us_clean)), size=smp_size)
train <- us_clean[train_ind, ]
test <- us_clean[-train_ind, ]
```

``` {r warning=FALSE}
p <- train$likes/(train$likes + train$dislikes) * 100
library(dplyr)
train$pC <- ifelse(p > 96.4, 1, 0)
train %>%
ggplot(aes(x = factor(pC), fill = pC)) +
geom_bar(alpha = 0.8) +
guides(fill = FALSE)
tags <- train$tags
max_features <- 1000
tokenizer <- text_tokenizer(num_words = max_features)
tokenizer %>%
fit_text_tokenizer(tags)
tokenizer$document_count
tokenizer$word_index %>%
head()
```

``` {r}
## NEED TO FIX.
usCorpus <- Corpus(VectorSource(us_clean$tags)
usCorpus <- tm_map(usCorpus, content_transformer(tolower))
```

``` {r}
usCorpus <- tm_map(usCorpus, removePunctuation)
usCorpus <- tm_map(usCorpus, removeWords, stopwords("english"))
usCorpus
```

``` {r}
dtm <- TermDocumentMatrix(usCorpus)
m <- as.matrix(dtm)
v <- sort(rowSums(m),decreasing=TRUE)
d <- data.frame(word = names(v), freq=v)
head(d, 15)
```


``` {r warning=FALSE, message=FALSE}
set.seed(1234)
wordcloud(words = d$word, freq = d$freq, min.freq = 1,
max.words=200, random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"))
```

```{r}
library(tidyverse)
library(tidytext)
library(glue)
library(stringr)
library(readr)
library(dplyr)
utube <- readr::read_csv('data/USvideos.csv', col_names=TRUE)
glimpse(utube)
# regex to remove unnecessary characters from tags
utube$tags <- gsub("|", "", utube$tags)
# tokenize
tag_tokens <- data_frame(text=utube$tags) %>%
tidytext::unnest_tokens(word, text)
title_tokens <- data_frame(text=utube$title) %>%
tidytext::unnest_tokens(word, text)
tag_tokens %>%
inner_join(get_sentiments("bing")) %>% # pull out only sentiment words
count(sentiment) %>% # count the # of positive & negative words
spread(sentiment, n, fill = 0) %>% # made data wide rather than narrow
mutate(sentiment = positive - negative) # # of positive words - # of negative owrds
title_tokens %>%
inner_join(get_sentiments("bing")) %>% # pull out only sentiment words
count(sentiment) %>% # count the # of positive & negative words
spread(sentiment, n, fill = 0) %>% # made data wide rather than narrow
mutate(sentiment = positive - negative) # # of positive words - # of negative owrds
library(sentimentr)
titletokens <- get_sentences(utube$title) # tokenization of title
tagtokens <- get_sentences(utube$tags) # tokenization of tags
titleSenti <- sentiment(titletokens)[1:40949] # calculate sentiment
tagSenti<- sentiment(tagtokens)[1:40949] # calculate sentiment
utube$sentimentTitle <- titleSenti$sentiment # reassignment
utube$sentimentTag <- tagSenti$sentiment # reassignment
descriptiontokens <- get_sentences(utube$description) # tokenization of description
descriSenti <- sentiment(descriptiontokens)[1:40949] # calculate sentiment
utube$sentimentDescri <- descriSenti$sentiment # reassignment
head(utube)
```


``` {r}
utube$comments_disabled <- as.integer(as.factor(utube$comments_disabled)) -1
utube$ratings_disabled <- as.integer(as.factor(utube$ratings_disabled)) -1
utube$video_error_or_removed <- as.integer(as.factor(utube$video_error_or_removed)) -1
```

``` {r}
utube$likeper <- utube$likes/(utube$likes + utube$dislikes) * 100
utube_md <- utube %>%
select(-thumbnail_link, -description, -tags, -trending_date, -video_id, -title, -likes, -dislikes)
glimpse(utube_md)
utube_md$category_id <- as.integer(as.factor(utube_md$category_id))
utube_md$channel_title <- as.integer(as.factor(utube_md$channel_title))
utube_md$publish_time <- strftime(utube_md$publish_time, format="%H")
utube_md$publish_time <- as.numeric(utube_md$publish_time)
```

## Model Fitting (Views as Response, Multiple Linear Regression)


``` {r warning=FALSE, message=FALSE}
attach(utube_md)
mod1 <- lm(views~., data=utube_md)
summary(mod1)
```

So it turns out that the sentiment is generally non-significant, however in this case we will make our
significance level 10%.

We will drop ratings_disabled (NA), video_error, sentimentTag, sentimentDescri.

```{r}
mod2 <- lm(views~channel_title+category_id+publish_time+comment_count+comments_disabled+likeper+sentimentTitle, data=utube_md)
summary(mod2)
```

We will reduce our significance level to 5%, and now we remove the last sentiment data - that of the title.

``` {r}
mod3 <- lm(views~channel_title+category_id+publish_time+comment_count+comments_disabled+likeper, data=utube_md)
summary(mod3)
```

## Model with pC as response (Well-liked video or not -> logistic regression)

## (SCRATCH THIS FOR NOW) - VERY VERY SHIT MODEL

``` {r}
utube_md$pC <- ifelse(utube_md$likeper > 96.4, 1, 0)
utube_md$pC <- as.factor(utube_md$pC)
pcm1 <- glm(pC~., data=utube_md, family="binomial")
summary(pcm1)
```

## Model Diagnostics (Views as response, mlr)



``` {r}
library(car)
```

### Outliers

``` {r}
outlierTest(mod3) # Bonferonni p-value for most extreme obs.
plot(mod3, which = 2) # qq plot for outliers
leveragePlots(mod3) # leverage plots
```


### Influential Observations

``` {r warning=FALSE}
# variable plots
avPlots(mod3)
# Cook's D plot
# Identifying D values such that D > 4/(n-k-1)
cutoff <- 4/((nrow(utube_md) - length(mod3$coefficients)-2))
plot(mod3, which=4, cook.levels=cutoff)
# Influence Plot
influencePlot(mod3, id.method="identify", main="Influence Plot",
sub="Circle size proportional to Cook's Distance")
```

### Assessing Normality

``` {r}
# qq plot for stud. residuals
qqPlot(mod3, main="QQ Plot")
# distribution of stud. residuals
library(MASS)
sdresid <- studres(mod3)
hist(sdresid, freq=FALSE,
main= "Stud. Residuals Distribution")
xf <- seq(min(sdresid), length=40)
yf <- dnorm(xf)
lines(xf, yf)
```



### Equivariance

``` {r}
# Evaluating homoscedasticity
# equivariance test
ncvTest(mod3)
# plot of stud. residuals vs. fitted values
spreadLevelPlot(mod3)
```


### Checking for Multicollinearity

``` {r}
vif(mod3) # VIFs
sqrt(vif(mod3)) > 2 # indicates a problem if VIF > 4
```

### Nonlinearity

``` {r}
# component + residual plot
crPlots(mod3)
# Ceres plots
ceresPlots(mod3)
```

### Non-independence of Errors

``` {r}
# testing for autocorrelated errors
durbinWatsonTest(fit)
```

### Additional Tests

- What this is is simply a global validation of linear regression model assumptions, and this also will perform separate evaluations for skewness, kurtosis, and heteroscedasticity.

``` {r}
# Global test of model assumptions
install.packages("gvlma")
library(gvlma)
gvmodel <- gvlma(fit)
summary(gvmodel)
```

## Model Validation

### Rechecking Model Assumptions


## Inference

### Interpretation, confidence interval, prediction interval, some comparisons



## Extension

### Sentiment Analysis Code and Interpretation Here

### Other Text Mining Errata
```