---
title: "Code for Session 7"
author: "Dr. Richard M. Crowley"
date: ""
output:
  html_notebook
---

Note that the directories used to store data are likely different on your computer, and such references will need to be changed before using any such code.

```{r helpers, warning=FALSE, message=F}
library(knitr)
library(kableExtra)
html_df <- function(text, cols=NULL, col1=FALSE, full=F) {
  if(!length(cols)) {
    cols=colnames(text)
  }
  if(!col1) {
    kable(text,"html", col.names = cols, align = c("l",rep('c',length(cols)-1))) %>%
      kable_styling(bootstrap_options = c("striped","hover"), full_width=full)
  } else {
    kable(text,"html", col.names = cols, align = c("l",rep('c',length(cols)-1))) %>%
      kable_styling(bootstrap_options = c("striped","hover"), full_width=full) %>%
      column_spec(1,bold=T)
  }
}
```

```{r}
library(tidyverse)

```

```{r, message=F}
# Note: read_csv is like read.csv, but loads as dplyr's format (tibble)
df_long <- read_csv("../../Data/general-business-expectations-by-detailed-services-industry-quarterly.csv")
df_long[1:3,c(1,4:5)]
```

```{r, message=F}
# Note: read_csv is like read.csv, but loads as dplyr's format (tibble)
df_wide <- read_csv("../../Assignments/Assignment_1/Zip_Zhvi_SingleFamilyResidence.csv")
df_wide[1:3,c(1,8:10)]
```

```{r}
# Read text from a .txt file using read_file()
doc <- read_file("../../Data/0001104659-14-015152.txt")
# str_wrap is from stringr from tidyverse
cat(str_wrap(substring(doc,1,500), 80))
```

```{r, message=F, warning=F}
library(httr)
library(XML)

httpResponse <- GET('https://coinmarketcap.com/currencies/ethereum/')
html = httr::content(httpResponse, "text")
paste0('...', str_wrap(substring(html, 135418, 135480), 80), '...')
xpath <- '//*[@id="__next"]/div/div[1]/div[2]/div/div[1]/div[2]/div/div[2]/div[1]/div/text()'
hdoc = htmlParse(html, asText=TRUE)  # from XML
price <- xpathSApply(hdoc, xpath, xmlValue)
print(paste0("Ethereum was priced at $", price,
             " when these slides were compiled"))
```

```{r}
# The actual version I use (with caching to avoid repeated lookups) is in the appendix
cryptoMC <- function(name) {
  httpResponse <- GET(paste('https://coinmarketcap.com/currencies/',name,'/',sep=''))
  html = httr::content(httpResponse, "text")
  xpath <- '//*[@id="__next"]/div/div[1]/div[2]/div/div[1]/div[2]/div/div[2]/div[1]/div/text()'
  hdoc = htmlParse(html, asText=TRUE)
  plain.text <- xpathSApply(hdoc, xpath, xmlValue)
  plain.text
}
```

```{r}
paste("Ethereum was priced at", cryptoMC("ethereum"))
paste("Litecoin was priced at", cryptoMC("litecoin"))
```

```{r}
cat(str_wrap(str_sub(doc, 9896, 9929), 80))
cat(str_wrap(str_sub(doc, 28900,29052), 80))
```

```{r}
sentence <- str_sub(doc, 9896, 9929)
str_to_lower(sentence)
str_to_upper(sentence)
str_to_title(sentence)
```

```{r}
board <- c("Michael L. Corbat", "Michael E. O?Neill", "Anthony M. Santomero",
           "William S. Thompson, Jr.", "Duncan P. Hennes", "Gary M. Reiner",
           "Joan E. Spero", "James S. Turley", "Franz B. Humer",
           "Judith Rodin", "Robert L. Ryan", "Diana L. Taylor",
           "Ernesto Zedillo Ponce de Leon", "Robert L. Joss")
titles <- c("CEO", "Chairman", "Former president, Fed (Philidelphia)",
            "CEO, Retired, PIMCO", "Co-Founder/Partner, Atrevida Partners",
            "Operating Partner, General Atlantic",
            "Senior Research Scholar, Columbia University",
            "Former Chairman & CEO, E&Y", "Chairman, Roche",
            "President, Rockefeller Foundation", "CFO, Retired, Medtronic",
            "MD, Wolfensohn Fund Management", "Professor, Yale University",
            "Professor/Dean Emeritus, Stanford GSB")
```

```{r}
# board is a list of director names
# titles is a list of the director's titles
paste(board, titles, sep=", ")
cat(str_wrap(paste0("Citi's board consists of: ",
                    paste(board[1:length(board)-1], collapse=", "),
                    ", and ", board[length(board)], "."), 80))
```

```{r}
sentence
str_replace_all(sentence, "\\$13.5", "over $10")
```

```{r}
paragraphs <- str_split(doc, '\n')[[1]]

# number of paragraphs
length(paragraphs)

# Last paragraph
cat(str_wrap(paragraphs[206], 80))
```

```{r}
str_locate_all(str_to_lower(doc), "net income")
```

```{r}
x <- str_detect(str_to_lower(paragraphs), "net income")
x[1:10]
sum(x)
```

```{r}
x <- str_count(str_to_lower(paragraphs), "net income")
x[1:10]
max(x)
```

```{r}
str_locate(str_to_lower(doc), "net income")
```

```{r}
str_extract(str_to_lower(doc), "net income")
```

```{r}
# Extract all emails from the annual report
str_extract_all(doc,'[:graph:]+@[:alnum:]+\\.[.[:alnum:]]+')
```

```{r}
text <- c("abcde", 'ABCDE', '12345', '!?!?.', 'ABC123?', "With space", "New\nline")
html_df(data.frame(
  text=text,
  alpha=str_detect(text,'[:alpha:]'),
  lower=str_detect(text,'[:lower:]'),
  upper=str_detect(text,'[:upper:]'),
  digit=str_detect(text,'[:digit:]'),
  alnum=str_detect(text,'[:alnum:]')
))

```

```{r}
text <- c("abcde", 'ABCDE', '12345', '!?!?.', 'ABC123?', "With space", "New\nline")
html_df(data.frame(
  text=text,
  punct=str_detect(text,'[:punct:]'),
  graph=str_detect(text,'[:graph:]'),
  space=str_detect(text,'[:space:]'),
  blank=str_detect(text,'[:blank:]'),
  period=str_detect(text,'.')
))

```

```{r}
df_RE <- read.csv("../../Data/Session_2-1.csv")
RE_names <- unique(df_RE$conm)
```

```{r}
# Real estate firm names with 3 vowels in a row
str_subset(RE_names, '[AEIOU]{3}')
# Real estate firm names with no vowels
str_subset(RE_names, '^[^AEIOU]+$')
# Real estate firm names with at least 12 vowels
str_subset(RE_names, '([^AEIOU]*[AEIOU]){11,}')
# Real estate firm names with a repeated 4 letter pattern
str_subset(RE_names, '([:upper:]{4}).*\\1')
```

```{r}
# Compustat firm names example
df_RE_names <- df_RE %>%
  group_by(isin) %>%
  slice(1) %>%
  mutate(SG_in_name = str_detect(conm, "(SG|SINGAPORE)"),
         name_length = str_length(conm),
         SG_firm = ifelse(fic=="SGP",1,0)) %>%
  ungroup()

df_RE_names %>%
  group_by(SG_firm) %>%
  mutate(pct_SG = mean(SG_in_name) * 100) %>%
  slice(1) %>%
  ungroup() %>%
  select(SG_firm, pct_SG)
```

```{r, warning=F}
library(DT)
df_RE_names %>%
  group_by(fic) %>%
  mutate(avg_name_length = mean(name_length)) %>%
  slice(1) %>%
  ungroup() %>%
  select(fic, avg_name_length) %>%
  arrange(desc(avg_name_length), fic) %>%
  datatable(options = list(pageLength = 5))
```

```{r, message=F}
library(quanteda)
library(quanteda.textstats)
textstat_readability(doc, "Flesch.Kincaid")
```

```{r}
textstat_readability(doc, "FOG")
```

```{r}
textstat_readability(doc, "Coleman.Liau.short")
```

```{r, eval=T, warning=F}
# Example of "tokenizing"
library(tidytext)
df_doc <- data.frame(ID=c("0001104659-14-015152"), text=c(doc)) %>%
  unnest_tokens(word, text)
# word is the name for the new column
# text is the name of the string column in the input data
```

```{r}
html_df(head(df_doc))
```

```{r, warning=F}
# get a list of stopwords
stop_en <- stopwords::stopwords("english")  # Snowball English
paste0(length(stop_en), " words: ", paste(stop_en[1:5], collapse=", "))
stop_SMART <- stopwords::stopwords(source="smart")  # SMART English
paste0(length(stop_SMART), " words: ", paste(stop_SMART[1:5], collapse=", "))
stop_fr <- stopwords::stopwords("french")  # Snowball French
paste0(length(stop_fr), " words: ", paste(stop_fr[1:5], collapse=", "))
```

```{r}
df_doc_stop <- df_doc %>%
  anti_join(data.frame(word=stop_SMART))
nrow(df_doc)
nrow(df_doc_stop)
```

```{r, warning=F, message=F}
terms <- df_doc_stop %>%
  count(ID, word, sort=TRUE) %>%
  ungroup()
total_terms <- terms %>% 
  group_by(ID) %>% 
  summarize(total = sum(n))
tf <- left_join(terms, total_terms) %>% mutate(tf=n/total)
tf
```

```{r, warning=F, error=F, message=F}
terms_ns <- df_doc %>%
  count(ID, word, sort=TRUE) %>%
  ungroup()
total_terms_ns <- terms_ns %>% 
  group_by(ID) %>% 
  summarize(total = sum(n))
tf_no_stop <- left_join(terms_ns, total_terms_ns) %>% mutate(tf=n/total)
```

```{r}
# Need to install the `textdata` package for the below to work
get_sentiments("afinn") %>%
  group_by(value) %>%
  slice(1) %>%
  ungroup()
```

```{r}
get_sentiments("bing") %>%
  group_by(sentiment) %>%
  slice(1) %>%
  ungroup()
```

```{r}
get_sentiments("nrc") %>%
  group_by(sentiment) %>%
  slice(1) %>%
  ungroup()
```

```{r}
get_sentiments("loughran") %>%
  group_by(sentiment) %>%
  slice(1) %>%
  ungroup()
```

```{r}
tf_sent <- tf %>% left_join(get_sentiments("loughran"))
tf_sent[1:5,]
tf_sent[!is.na(tf_sent$sentiment),][1:5,]
```

```{r}
tf_sent %>%
  spread(sentiment, tf, fill=0) %>%
  select(constraining, litigious, negative, positive, superfluous, uncertainty) %>%
  colSums()
```

```{r, warning=F, message=F}
#library(plotly)
tf_sent %>%
  filter(!is.na(sentiment)) %>%
  group_by(sentiment) %>%
  arrange(desc(n)) %>%
  mutate(row = row_number()) %>%
  filter(row < 10) %>%
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(y=n, x=word)) + geom_col() + theme(axis.text.x = element_text(angle=90, hjust=1)) + 
  facet_wrap(~sentiment, ncol=3, scales="free_x")
#ggplotly(p)
```

```{r, message=F, warning=F, fig.height=4.5}
library(quanteda.textplots)
corp <- cast_dfm(tf, ID, word, n)
textplot_wordcloud(dfm(corp), color = RColorBrewer::brewer.pal(9, "Set1"))
```

```{r, message=F, warning=F, fig.height=4.5}
corp_no_stop <- cast_dfm(tf_no_stop, ID, word, n)
textplot_wordcloud(dfm(corp_no_stop), color = RColorBrewer::brewer.pal(9, "Set1"))
```

