---
title: "PoolTogether Analysis <br> <br> <br> <br> <br>"
author: "Omni Analytics Group"
output:
  xaringan::moon_reader:
    includes:
      after_body: insert-logo.html
    css: [default, default-fonts, classroom.css]
    lib_dir: libs
    nature:
      ratio: 16:9
      highlightStyle: github
      highlightLines: true
      countIncrementalSlides: false
      
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.align = "center", fig.width=14, dpi=300)

library(knitr)
library(kableExtra)
```

## PoolTogether

PoolTogether is a fun, open sourced and decentralized protocol for “no-loss” lotteries where users transfer their crypto into a shared pool that acts as a “prize-linked savings account”. These deposits double as lottery tickets that give the depositor a chance to win proportional to the amount of the pool they claim. Just like traditional savings accounts, all money in the pool earns a yield and each user can withdraw at their discretion.

#### Prizes

At the time of this writing, \$3,801,856 worth of prizes have been awarded. Also, based on current deposits, the platform has been generating \$93,558 in interest per week for its users. Interested in earning? You can participate in PoolTogether on the Ethereum, xDai, Matic, and Binance Smart Chain networks.


#### Proposals

True to the spirit of decentralization, the PoolTogether protocol is managed by holders of the $POOL governance token who draft and vote on proposals that control the prize creation tools and prize pools. Proposals are ratified through a voting process and are then implemented by the community.

---

## Data

To begin, we need to scrape the data. The code is provided below, if desired. The procedure for data scraping is:

1. Retrieve the network/chain pool data from the pool together API json files.
2. Parse the JSON / nested list structure into an R dataframe.
3. Retrieve the rewards / prize history by making a GraphQL call to TheGraph's API.
4. Retrieve information on the holders by making a GraphQL call to TheGraph's API.
5. Save the three objects as R Data Files.

We accomplish this using a custom R-based routine and the following libraries:

```{r}
library(tidyverse)
library(httr)
library(jsonlite)
library(lubridate)
library(ghql)
```

---

## Data Loading

Next, with the data successfully scraped, we read in the R data objects into our local environment and take a look at the raw data. To the rewards data, we add an indicator of the pool name for each.

```{r}
# Read the objects into the environment
pools_data <- readRDS("data/pools_data.RDS")
holders_data <- readRDS("data/holders_data.RDS")
rewards_data <- readRDS("data/rewards_data.RDS")

# Store the pool name int he rewards data
for (i in 1:length(rewards_data)) {
    if (nrow(rewards_data[[i]]) > 0) {
        rewards_data[[i]]$Pool <- pools_data$Name[i]
    }
}
```

---

## Pools Data

We can take a look at the first few rows of the pool data:

```{r, echo=FALSE}
pools_data %>% head(n = 4) %>% kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
```

---

## Holders Data

The holders of the first pool:

```{r, echo=FALSE}
holders_data[[1]] %>% head(n = 4) %>% kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
```

---

## Rewards Data

The past rewards for the first pool:

```{r, echo=FALSE}
rewards_data[[1]] %>% head(n = 3) %>% kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
```

---

## Holder Balances

With the pre-processed data, the first thing we can look at is a distribution of the balances of holders. Here we use free scales, which allows us to better see each panel individually despite the large difference between the different pools. We can clearly see that most of the balances fall in the $100 - $10,000 across the various pools, but there a few holders have very large balances.

```{r}
## Flatten holders data
have_holders <- which(sapply(holders_data,nrow)>0)

h_names <- pools_data$Name[have_holders]
h_val <- pools_data$Ticket_Val_Base_Tok[have_holders]
h_valusd <- pools_data$Ticket_Val_USD[have_holders]
h_dec <- pools_data$Base_Tok_Decimals[have_holders]
h_holders <- holders_data[have_holders]

holders_flat <- do.call(rbind,mapply(function(x,y,z,w,xx) cbind(x,Pool_Name=y,Value=z,USD=w,Dec=xx),h_holders,h_names,h_val,h_valusd,h_dec,SIMPLIFY=FALSE)) %>%
    as_tibble() %>%
    mutate(across(c(balance, Value, USD, Dec), as.numeric)) %>%
    mutate(Price = USD / Value) %>%
    mutate(Bal = balance / (10^Dec) * Price)

my_dollars <- function(x) {
    ifelse(x < .01, paste0("$", x), scales::dollar(x))
}
```

---

```{r, fig.height=5}
ggplot(holders_flat, aes(x = Bal)) +
    geom_histogram(aes(fill = Pool_Name), bins=100) +
    scale_x_log10(labels = my_dollars, breaks = c(1e-16, 1e-14, 1e-12, 1e-10, 1e-8, 1e-6, 1e-4, 1e-2, 1, 100, 10000, 1000000, 100000000)) +
    facet_wrap(~Pool_Name, scales = "free") +
    theme(
        axis.text.x = element_text(angle = 40, hjust = 1),
        legend.position = "off"
    )
```

---

## Holder Balances (Fixed X Axis)

If we fix the x scales, we can now compare across the pools a little better, when stacking the graph like so. We can see that COMP, UNI, and others tend to have larger balances than the USDC or GUSD pools for example.

```{r, fig.height=6, eval=FALSE}
ggplot(holders_flat, aes(x = Bal)) +
    geom_histogram(aes(fill = Pool_Name), bins=100) +
    scale_x_log10(labels = my_dollars, breaks = c(1e-16, 1e-14, 1e-12, 1e-10, 1e-8, 1e-6, 1e-4, 1e-2, 1, 100, 10000, 1000000, 100000000)) +
    facet_wrap(~Pool_Name, scales = "free_y", ncol = 1) +
    theme(
        axis.text.x = element_text(angle = 20, hjust = 1),
        legend.position = "off"
    )
```

---

```{r, fig.height=8, echo=FALSE}
ggplot(holders_flat, aes(x = Bal)) +
    geom_histogram(aes(fill = Pool_Name), bins=100) +
    scale_x_log10(labels = my_dollars, breaks = c(1e-16, 1e-14, 1e-12, 1e-10, 1e-8, 1e-6, 1e-4, 1e-2, 1, 100, 10000, 1000000, 100000000)) +
    facet_wrap(~Pool_Name, scales = "free_y", ncol = 1) +
    theme(
        axis.text.x = element_text(angle = 20, hjust = 1),
        legend.position = "off"
    )
```

---

## Average time between rewards

We can compute the mean and median time between rewards by arranging the award time, and then computing the difference between subsequent rows:

```{r}
rewards_data1 <- rewards_data %>%
    bind_rows() %>%
    as_tibble() %>%
    arrange(Awarded_Time) %>%
    mutate(TimeBetween = c(NA, diff(Awarded_Time)))

mean(rewards_data1$TimeBetween, na.rm = TRUE)
median(rewards_data1$TimeBetween, na.rm = TRUE)
```

---

One method to visualize this data is to plot a histogram of the distribution. This allows us to clearly see that the typical time between rewards is around 1500 minutes, or just about a day.

```{r, fig.height=3.5}
ggplot(rewards_data1, aes(x = TimeBetween)) +
    geom_histogram() +
    scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
    labs(
        title = "Time between Subsequent Awards",
        x = "Time (minutes)",
    )
```

---

## Time between rewards over time

But, this obscures how the time has decreased since the start. Here we order the rewards from first to last, and plot the time between to see both the oscillating pattern as of late, and how this has settled into the ~1 day value that it is today.

```{r, fig.height=4.5}
ggplot(rewards_data1 %>% mutate(ID = 1:nrow(.)), aes(x = ID, y = TimeBetween)) +
    geom_point() +
    geom_line()
```

---

## How many holders in more than one pool?

We can perform some data manipulation in order to compute how many holders are in more than one pool. Doing so shows that about 2000 holders are in more than one pool:

```{r}
have_holders <- which(sapply(holders_data,nrow)>0)
h_names <- pools_data$Name[have_holders]
n_tokens <- pools_data$Base_Tok_Name[have_holders]
h_holders <- holders_data[have_holders]


flat <- do.call(rbind,mapply(function(x,y,z) cbind(x,Pool_Name=y, Token_Name=z),h_holders,h_names,n_tokens,SIMPLIFY=FALSE)) %>%
    as_tibble()

more_than_one <- flat %>%
    group_by(id) %>%
    summarise(Pools = length(unique(Pool_Name))) %>%
    filter(Pools > 1)

more_than_one %>% count() %>% pull
```

---

## How many in exactly one pool?

By checking how many are in exactly one pool, we see that this represents the majority of holders, a bit over 7000 of them.

```{r}
flat %>%
    group_by(id) %>%
    summarise(Pools = length(unique(Pool_Name))) %>%
    filter(Pools == 1) %>%
    count() %>%
    pull()
```

---

## Most Pools

Certain holders are in a large number of pools. At the time of this writing, the addresses below are those in the most pools. One particular holder is in 9 of the pools, and many others are in 8 of them.

```{r}
flat %>%
    group_by(id) %>%
    summarise(Pools = length(unique(Pool_Name))) %>%
    arrange(desc(Pools)) %>%
    head(n = 5) %>%
    kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
```

---

## Computing Pool Diversity

We can compute a metric of pool diversity by, for every holder in more than one pool, seeing the incidence that they occur with one another. From there, we can measure how similar the pools themselves are. The POOL Pool and the DAI pool have a fairly strong similarity, whereas (for example) the DAi pool and the BADGER Pool have very little similarity.

```{r, results='asis'}
incidence <- flat %>% select(Address = id, Pool_Name) %>%
    filter(Address %in% more_than_one$id) %>%
    mutate(Count = 1) %>%
    spread(key = Pool_Name, value = Count)
incidence[is.na(incidence)] <- 0

inci <- 1 - dist(incidence %>% select(-Address) %>% t, method = "binary", 
                 upper = TRUE, diag = TRUE) %>% 
  as.matrix
``` 

---

```{r}
inci %>%
    as_tibble() %>%
    mutate(Pool = rownames(inci)) %>%
    select(Pool, everything()) %>%
    kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"), font_size = 14)
```

---

## Tokens in Reward Pools

Finally, we can see the occurrences of particular tokens within each reward pool:

```{r}
res <- sapply(1:nrow(rewards_data1), function(i) {
    x <- rewards_data1$Prize_External_ERC20[i]
    do.call(rbind, strsplit(gsub("\\[|\\]", "", 
                                 strsplit(x, "][", fixed = TRUE)[[1]]), ";")) %>%
        as_tibble() %>%
        mutate(Pool = rewards_data1$Pool[i])
}) %>% bind_rows() %>%
    rename(Address = V1, Amount = V2, Name = V3, Ticker = V4) %>%
    mutate(Amount = readr::parse_number(Amount))

final <- res %>% group_by(Pool, Ticker) %>% summarise(Count = n()) %>% 
  spread(key = Ticker, value = Count)
final[is.na(final)] <- 0
```

---

```{r}
final %>% head(n = 10) %>% select(1:12) %>%
    kable() %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
```


