Web scraping JSNAs

url <- "https://en.wikipedia.org/wiki/Web_scraping"  

jsna <- googlesearchR("jsna")

head(jsna)

jsna1 <- map_df(jsna, data.frame) #convert list to data frame

safe_links <- safely(get_page_links) # safe function

# extract links per page and store as a tibble
jsna2 <- jsna1 %>%
  mutate(links = map(.x..i.., ~(safe_links(.x)))) %>%
           as.tibble() 



# remove errors and filter for pages containing 'jsna'
jsna3 <- jsna2 %>%
  mutate(links = map(links, "result")) %>%
  filter(links != "NULL") %>%
  unnest() %>%
  filter(str_detect(links, "[Jj][Ss][Nn][Aa]"))

# search witin jsna pages
jsna4 <- jsna3 %>%
  mutate(links1 = map(links, ~(safe_links(.x))))



# extract pdfs and create full links to pdfs if required
pdfs <- jsna4 %>%
  mutate(links2 = map(links1, "result")) %>%
    filter(links2 != "NULL")  %>%
  unnest(links2) %>%
  filter(str_detect(links2, "pdf")) %>%
  distinct() %>%
  mutate(full_links = ifelse(!str_detect(links2, "^http"), paste0(links, links2), links2))


# safe readtext funtion NB might also try new version of pdf_tools
safe_readtext <- safely(readtext::readtext)

safe_pdf <- safely(pdftools::pdf_text)


# try and read pdfs
pdfs_text <- pdfs %>%
  mutate(text = map(full_links, ~(safe_readtext(.x))))

pdfs1_text <- pdfs %>%
  mutate(text = map(full_links, ~safe_pdf(.x)))

# tidy
pdfs_text1 <- pdfs_text %>%
  mutate(text = map(text, "result")) %>%
  filter(text != "NULL") %>%
  unnest()


# save file
pdfs_text1 %>%
  write_rds("jsna.rds")

jsna1 <- read_rds("jsna.rds")

library(quanteda)


# create corpus
corpus_jsna <- corpus(jsna1$text)

# add back full links
docvars(corpus_jsna, "link") <- pdfs_text1$full_links

# create search
multiword <- c( "phof*", "phout*",  "fingert*", "phe") # this could be a miniui shiny app reading the rds file


# run keywerds in context
kw <- kwic(corpus_jsna, pattern = phrase(multiword), window = 15)


# add id field
corp <- corpus_jsna$documents %>%
  rownames_to_column("text") %>%
  select(text, link)

# join fulllnks back to keyword table
kw %>%
  left_join(corp, by = c("docname" = "text")) %>%
  mutate(link1 = paste0("<a href =", link, ">Links</a>")) %>%
  DT::datatable(filter = "top", escape = FALSE)

jsna_dtm <- dfm(corpus_jsna, remove = stopwords("en"), ngrams = 1:2)
jsna_dtm1 <- dfm_trim(jsna_dtm, scarcity = 0.7)



dict <- create_lookup(phe = c("phe", "health_eng*"), 
                      profile = "profile*", 
                      fingertips = "fingertip*", 
                      local_health = c("localhealth", "local_health"), 
                      phof = c("phof", "health_outcomes_framework"),
                      indicator = "indicator*")

lookup1 <- dfm_lookup(jsna_dtm1, dictionary = dict)


lu<- lookup1 %>%
  convert(.,  to = "data.frame") %>%
  gather(metric, value, 2:ncol(.)) %>%
  ggplot(aes(document, metric, fill = value)) +
  geom_tile() +
  scale_fill_gradient(low = "white", high = "black") +
  scale_x_discrete(position = "top") +
  theme_phe() +
  theme(axis.text.x.top = element_text(angle = 90, hjust = 0))

lu

lookup1 %>%
  convert(.,  to = "data.frame") %>%
  gather(metric, value, 2:ncol(.)) %>%
  mutate(mention = ifelse(value == 0, 0, 1)) %>%
  group_by(metric) %>%
  summarise(`% reports with term` = round(100 * mean(mention), 2)) %>%
  knitr::kable() %>%
  kableExtra::kable_styling(full_width = TRUE)

# count frequency of keywords per document

kw %>%
  left_join(corp, by = c("docname" = "text")) %>%
  group_by(docname, link) %>%
  count() %>%
  arrange(-n) %>%
  ungroup() %>%
  select(-docname) %>%
  select(n, everything()) %>%
  distinct() %>%
  knitr::kable()