---
title: "Code for Session 7"
author: "Dr. Richard M. Crowley"
format:
  html:
    code-tools: true
    code-link: true
    embed-resources: true
---

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)

#' Pretty formatted HTML tables
#' 
#' @param df The dataframe to format as a table
#' @param names Names to use for columns if not using the df column names. Vector
#' @param highlight_cols Columns to highlight. Default is c(1) for highlighting the first row. Use c() to remove.
#' @param highlight_rows Rows to highlight. Default is c() to not highlight any rows.
#' @param color_rows Rows to highlight in color. Default is c() to not highlight any rows.
#' @param highlight_end_rows Rows to highlight. Uses a reverse indexing where 1 is the last row, 2 is second to last, etc.
#' @param full Use to span the full width of a slide. FALSE by default.
#' @param fixed_header Whether the first row should be treated as a header row. TRUE by default.
html_df <- function(df, names=NULL, highlight_cols=c(1), highlight_rows=c(), color_rows=c(), highlight_end_rows=c(), full=F, fixed_header=T) {
  if(!length(names)) {
    names=colnames(df)
  }
  kbl(df,"html", col.names = names, align = c("l",rep('c',length(cols)-1))) %>%
    kable_paper(c("striped","hover"), full_width=full, fixed_thead=F, html_font = "\"Source Sans Pro\", Helvetica, sans-serif") %>%
    {if(length(highlight_cols)) column_spec(., highlight_cols,bold=T, background = "#ffffff99") else .} %>%
    {if(length(highlight_rows)) row_spec(., highlight_rows,bold=T, background = "#ffffff99") else .} %>%
    {if(length(color_rows)) row_spec(., color_rows,bold=T, background = "#aaaaff99") else .} %>%
    {if(length(highlight_end_rows)) row_spec(., nrow(df) + 1 - highlight_end_rows,bold=T, background = "#ffffff99") else .}
}

library(tidyverse)
```

```{r}
#| include: false
options(downlit.attached = c("knitr", "kableExtra", "tidyverse"))
```

```{r}
# Read text from a .txt file using read_file()
doc <- read_file("../../Data/0001564590-21-039151.txt")
# str_wrap is from stringr from tidyverse
# The first 500 characters of the second paragraph
cat(str_wrap(substring(doc,1728,2228), 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, 11305, 11363), 80), '...')
xpath <- '//*[@id="section-coin-overview"]/div[2]/span/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="section-coin-overview"]/div[2]/span/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, 138177, 138384), 80))
cat(str_wrap(str_sub(doc, 144162 , 144476), 80))
```

```{r}
sentence <- str_sub(doc, 138287, 138384)
str_to_lower(sentence)
str_to_upper(sentence)
str_to_title(sentence)
```

```{r}
board <- c("Reid Hoffman", "Hugh Johnston", "Teri List", "Satya Nadella", "Sandra E. Peterson", "Penny Pritzker", "Carlos Rodriguez", "Charles W. Scharf", "John W. Stanton", "John W. Thompson", "Emma Walmsley", "Padmasree Warrior")
titles <- c("Partner, Greylock Partners", "Vice Chairman and Chief Financial Officer, PepsiCo", "Former Executive Vice President and Chief Financial Officer, Gap Inc.", "Chairman and Chief Executive Officer", "Lead Independent Director", "Founder and Chairman, PSP Partners", "Executive Chair, ADP, Inc.", "CEO and President, Wells Fargo & Company", "Chairman, Trilogy Partnerships", "Partner, Lightspeed Venture Partners", "CEO, GSK", "Founder, President and CEO, Fable Group Inc.")
```

```{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("Microsoft's board consists of: ",
                    paste(board[1:length(board)-1], collapse=", "),
                    ", and ", board[length(board)], "."), 80))
```

```{r}
sentence
str_replace_all(sentence, "digital transformation", "data science")
```

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

# number of paragraphs
length(paragraphs)

# First paragraph of the MD&A
cat(str_wrap(paragraphs[206], 80))
```

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

```{r}
x <- str_detect(str_to_lower(paragraphs), "revenue")
x[51:60]
sum(x)
```

```{r}
x <- str_count(str_to_lower(paragraphs), "revenue")
x[51:60]
max(x)
```

```{r}
str_locate(str_to_lower(doc), "revenue")
```

```{r}
str_extract(str_to_lower(doc), "revenue")
```

```{r}
# Extract all sentences mentioning COVID from the annual report
str_extract_all(doc, '(?<=^|\\.\\s{1,5})[^.]*?COVID[^.]*?\\.')
```

```{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("0001564590-21-039151"), 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, echo=T}
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")
```

```{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"))
```

