---
title: "Outbrain EDA (Documents)"
output: 
  html_document: 
    code_folding: show
    fig_height: 5
    fig_width: 8
    toc: yes
    toc_depth: 4
---

Let's explore the data a little.

**NOTE:** This is incomplete. Right now it only contains a few light notes on documents.

# Background

A few notes from the [data description page]():

  1. "The dataset for this challenge contains a sample of users’ page views and clicks, as observed on multiple publisher sites in the United States between **14-June-2016** and **28-June-2016**".
  2. There are "some semantic attributes of those documents"
  3. The "dataset contains numerous sets of content recommendations served to a specific user in a specific context"
  4. "Each context (i.e. a set of recommendations) is given a display_id"
  5. "The identities of the clicked recommendations in the test set are not revealed"
  6. "In each such set, the user has clicked on at least one recommendation"
  
It's worth noting the core description:

> Each user in the dataset is represented by a unique id (uuid). A person can view a document (document_id), which is simply a web page with content (e.g.  a news article). On each document, a set of ads (ad_id) are displayed. Each ad belongs to a campaign (campaign_id) run by an advertiser (advertiser_id)
  
## Comments

It sounds like `display_id` are the _recommendations_ that Outbrain provides.  

# Data Exploration

```{r, include = F}

#' Generic function to create an htmlwidget
#'
#' This function is a generic function to create an \code{htmlwidget}
#' to allow HTML/JS from R in multiple contexts.
#'
#' @param x an object.
#' @param ... arguments to be passed to \code{\link[DT]{datatable}}
#' @export
#' @return a \code{\link[DT]{datatable}} object
as.datatable <- function(x, ...) {
  UseMethod("as.datatable")
}

#' Convert \code{formattable} to a \code{\link[DT]{datatable}} htmlwidget
#'
#' @param x a \code{formattable} object to convert
#' @param escape \code{logical} to escape \code{HTML}. The default is
#'          \code{FALSE} since it is expected that \code{formatters} from
#'          \code{formattable} will produce \code{HTML} tags.
#' @param ... additional arguments passed to to \code{\link[DT]{datatable}}
#' @return a \code{\link[DT]{datatable}} object
#' @export
as.datatable.formattable <- function(x, escape = FALSE, ...) {
  stopifnot(is.formattable(x), requireNamespace("DT"))
  DT::datatable(
    render_html_matrix.formattable(x),
    escape = escape,
    ...
  )
}
render_html_matrix.formattable <- function(x, ...) {
  stopifnot(is.formattable(x), is.data.frame(x))
  do.call(render_html_matrix.data.frame,
    c(list(x = remove_class(x, "formattable")), attr(x, "formattable")$format))
}

render_html_matrix <- function(x, ...)
  UseMethod("render_html_matrix")

render_html_matrix.data.frame <- function(x, formatters = list(), digits = getOption("digits"), ...) {
  stopifnot(is.data.frame(x))
  if (nrow(x) == 0L) formatters <- list()
  cols <- colnames(x)
  mat <- vapply(x, format, character(nrow(x)), digits = digits, trim = TRUE)
  dim(mat) <- dim(x)
  dimnames(mat) <- dimnames(x)
  for (fi in seq_along(formatters)) {
    fn <- names(formatters)[[fi]]
    f <- formatters[[fi]]
    if (is_false(f)) next
    else if (!is.null(fn) && nzchar(fn)) {
      if (fn %in% cols) {
        value <- x[[fn]]
        fv <- if (inherits(f, "formatter")) f(value, x, mat[, fn])
        else  if (inherits(f, "formula")) eval_formula(f, value, x)
        else match.fun(f)(value)
        mat[, fn] <- format(fv)
      }
    } else if (inherits(f, "formula")) {
      fenv <- environment(f)
      value <- as.matrix(if (length(f) == 2L) {
        row <- col <- TRUE
        f <- eval(f[[2L]], fenv)
        x
      } else {
        if (is.call(f[[2L]])) {
          farea <- eval(f[[2L]], fenv)
          if (inherits(farea, "area")) {
            row <- eval(farea$row, seq_list(rownames(x)), farea$envir)
            col <- eval(farea$col, seq_list(colnames(x)), farea$envir)
            f <- eval(f[[3L]], fenv)
            x[row, col]
          } else {
            stop("Invalid area formatter specification. Use area(row, col) ~ formatter instead.", call. = FALSE)
          }
        } else {
          stop("Invalid formatter specification. Use area(row, col) ~ formatter instead.", call. = FALSE)
        }
      })
      fv <-  if (inherits(f, "formatter"))
        f(value, x, mat[row, col]) else match.fun(f)(value)
      mat[row, col] <- format(fv)
    }
  }
  nulls <- get_false_entries(formatters)
  mat[, setdiff(cols, nulls), drop = FALSE]
}
base_ifelse <- getExportedValue("base", "ifelse")

as_numeric <- function(x) if (is.numeric(x)) x else as.numeric(x)

set_class <- function(x, class) {
  if (!inherits(x, class))
    class(x) <- c(class, class(x))
  x
}

create_obj <- function(x, class, attributes) {
  if (!missing(attributes)) attr(x, class) <- attributes
  set_class(x, class)
}

reset_class <- function(src, target, class) {
  if (storage.mode(target) == storage.mode(src)) target
  else set_class(unclass(target), class)
}

ifelse <- function(test, yes, no, ...) {
  base_ifelse(test, yes, no)
}

remove_class <- function(x, class) {
  cls <- class(x)
  class(x) <- cls[cls != class]
  x
}

remove_attribute <- function(x, which) {
  attr(x, which) <- NULL
  x
}

copy_obj <- function(src, target, class) {
  create_obj(target, class, attr(src, class, exact = TRUE))
}

fcreate_obj <- function(f, class, x, ...) {
  create_obj(f(remove_class(x, class), ...), class, attr(x, class, exact = TRUE))
}

cop_create_obj <- function(op, class, x, y) {
  if (inherits(x, class)) {
    if (missing(y))
      create_obj(op(remove_class(x, class)), class, attr(x, class, exact = TRUE))
    else
      create_obj(op(remove_class(x, class), unclass(y)), class, attr(x, class, exact = TRUE))
  } else if (inherits(y, class)) {
    create_obj(op(unclass(x), remove_class(y, class)), class, attr(y, class, exact = TRUE))
  } else {
    create_obj(op(x, y), class, NULL)
  }
}

call_or_default <- function(FUN, X, ...) {
  if (is.null(FUN)) X else match.fun(FUN)(X, ...)
}

eval_formula <- function(x, var, data, envir = environment(x)) {
  if (length(x) == 2L) {
    eval(x[[2L]], if (!missing(data) && is.list(data)) data else NULL, envir)
  } else if (is.symbol(symbol <- x[[2L]])) {
    eval_args <- list(var)
    names(eval_args) <- as.character(symbol)
    eval(x[[3L]], eval_args, envir)
  } else {
    stop("The formula should be either '~ expr' or 'x ~ expr'", call. = FALSE)
  }
}

get_false_entries <- function(x) {
  y <- vapply(x, is_false, logical(1L))
  y <- names(x)[y]
  y[nzchar(y)]
}

is_false <- function(x) {
  is.logical(x) && length(x) == 1L && x == FALSE
}

get_digits <- function(x) {
  ifelse(grepl(".", x, fixed = TRUE),
    nchar(gsub("^.*\\.([0-9]*).*$", "\\1", x)), 0L)
}

seq_list <- function(x = character()) {
  lst <- as.list(seq_along(x))
  names(lst) <- x
  lst
}

copy_dim <- function(src, target, use.names = TRUE) {
  if (is.array(src)) {
    dim(target) <- dim(src)
    if (use.names) dimnames(target) <- dimnames(src)
  } else {
    if (use.names) names(target) <- names(src)
  }
  target
}
```

```{r Libraries}
library(needs)
needs(readr, dplyr, tidyr, ggplot2,
      pander, formattable, DT)

list.files("../input") %>% 
    as.list() %>%
    pander
```

## Documents

Let's start with the documents. We'll load each document into its own dataframe.

```{r, message=F, warning=FALSE, comment=F}
options(readr.num_columns = 0)
for(file in c("categories", "entities", "meta", "topics")) {
    d <- read_csv(sprintf("../input/documents_%s.csv", file), progress = F)
    assign(sprintf('doc.%s', file), d)
    print(sprintf("Reading in documents_%s.csv: %s rows and %s columns", file, comma(nrow(d), 0), comma(ncol(d), 0)))
    rm(d)
}
```

OK: so now we have that data loaded. Let's take a look.

### Categories

```{r}
glimpse(doc.categories)
```

It looks like we have a list of `document_id` with a `category_id`, and a confidence level. 

Is the confidence level thresholded?

```{r}
summary(doc.categories$confidence_level) %>%
    pander
```

It doesn't look like it - the range is from very small to very high. Let's see the density.

Since there are a decent number of item, we'll sample 10%.

```{r}
doc.categories %>%
    sample_frac(.1) %>%
    ggplot(aes(confidence_level)) +
    geom_density() +
    theme_minimal()
```

We see that most categories are _unreliable_: very low certainty of it being relevant. How many documents have _more than one_ category higher than 80%?

```{r}
doc.categories %>%
    filter(confidence_level > .8) %>%
    group_by(document_id) %>%
    summarise(categories = n()) %>%
    group_by(categories) %>%
    summarise(documents = comma(n(), 0)) %>%
    formattable(align = 'l')
```

In short: basically nobody. Hmm. How many documents have more than one category _in general_?

```{r}
doc.categories %>%
    group_by(document_id) %>%
    summarise(categories = n()) %>%
    group_by(categories) %>%
    summarise(documents = comma(n(), 0)) %>%
    formattable(align = 'l')
```

Surprisingly low!

### Entities

What about the entities?

```{r}
glimpse(doc.entities)
```

Very similar - an entity ID, and a category.

How many entities per document?

```{r}
doc.entities %>%
    group_by(document_id) %>%
    summarise(entities = n()) %>%
    group_by(entities) %>%
    summarise(docs = comma(n(), 0)) %>%
    formattable(list(docs = color_bar("orange")), align = 'l')
```

So: no more than 10 entities per document. Is that the top 10?

Interesting little jump there at the end, too. Was comething cut off?

Let's take a look at the density of confidence level. 

```{r}
doc.entities %>%
    sample_frac(.1) %>%
    ggplot(aes(confidence_level)) +
    geom_density() +
    theme_minimal()
```

A fair bit different - peaks at ~25%, and basically nothing below ~20%.

How many entities are there?

```{r}
doc.entities$entity_id %>%
    unique %>%
    length %>%
    comma(0)
```

Rather a lot - how many documents do we get per entity?

```{r}
doc.entities %>%
    group_by(entity_id) %>%
    summarise(docs = n()) %>%
    group_by(docs) %>%
    summarise(entities = n()) ->
    docs_entities

docs_entities %>% 
    mutate(entities = comma(entities, 0)) %>%
    formattable(align = 'l') %>%
    as.datatable()
```

A pretty large variation - most entities only have one document, but some entities are in tens of thousands of documents.

### Meta

What meta info do we have?

```{r}
glimpse(doc.meta)
```

OK: we have a source (i.e. subdomain) and a publisher (domain), as well as a publication time.

How many sources, and how many publishers?

```{r}
doc.meta %>%
    summarise(sources = n_distinct(source_id),
              publishers = n_distinct(publisher_id)) %>%
    gather() %>%
    mutate(value = comma(value, 0)) %>%
    formattable(align = 'l')
```

Only a little more than 1,000 publishers - that's good. And around 10x as many sources, which is _interesting_. How many sources are there per publisher?

```{r}
doc.meta %>%
    group_by(publisher_id) %>%
    summarise(sources = n_distinct(source_id)) %>%
    group_by(sources) %>%
    summarise(publishers = n()) %>%
    formattable(align = 'l') %>%
    as.datatable()
```

Wow - most only have one, but one as _over 5,000 subdomains_. Amazing!

Do any publishers occur across sources? (They shouldn't)

```{r}
doc.meta %>%
    group_by(source_id) %>%
    summarise(publishers = n_distinct(publisher_id)) %>%
    group_by(publishers) %>%
    summarise(count = comma(n(), 0)) %>%
    formattable(align = 'l')
```

Nope: good.

What's the breakdown of document volume by publisher? Can we see the top 1,000 publishers?

```{r}
doc.meta %>%
    group_by(publisher_id) %>%
    summarise(docs = comma(n(), 0)) %>%
    arrange(desc(docs)) %>%
    mutate(cum_sum = percent(cumsum(docs) / sum(docs))) %>%
    head(1e3) %>%
    formattable() %>%
    as.datatable
```

So the top 10 account for > 30% of volume, and the top 100 for > 75%. Not too bad.

### Topics

Now, how about topics? Do we know how they identify topics (topic modeling?)

```{r}
glimpse(doc.topics)
```

Alright - let's see.

How many topics are three? 

```{r}
doc.topics$topic_id %>%
    unique %>%
    length %>%
    pander
```

Exactly 300 topics. That ... smells like LDA to me.

What's the distribution of confidence levels?

```{r}
doc.topics %>%
    sample_frac(.05) %>%
    ggplot(aes(confidence_level)) +
    geom_density() +
    theme_minimal()
```

That's, uh, fun. Not very confident are we?

OK: so what's the smallest confidence level?

```{r}
summary(doc.topics$confidence_level) %>%
    pander
```

A little less than 1%.

How many topics does each document get? All 300?

```{r}
doc.topics %>%
    group_by(document_id) %>%
    summarise(topics = n()) %>%
    group_by(topics) %>%
    summarise(docs = comma(n(), 0)) %>%
    formattable() %>%
    as.datatable()
```

So: most only get a single topic, some get more. 

### Conclusion

It looks like the document information is _quite_ sparse. The `confidence_level` data looks interesting, but certainly needs to be calibrated - and there may be information in the distributions of confidence level by type.

## Events

_INCOMPLETE_