empirical_analysis.Rmd

---
title: "Ransomware Payments in the Bitcoin Ecosystem"
author: "Bernhard Haslhofer, Masarah Paquet-Clouston"
date: "`r Sys.Date()`"
output:
  beamer_presentation:
    slide_level: 2
---

```{r libs_and_functions, echo=FALSE, message=FALSE, warning=FALSE}

# install libraries (if not available)
list.of.packages <- c("tidyverse", "xtable")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)

# load libraries
library(tidyverse)
library(xtable)

# include source files
source("util/util.R")
source("util/load_data.R")

# set dataset path
dataset.path <- "./dataset/"

# make sure plot path exists
dir.create(file.path("./plots"), showWarnings = FALSE)

```

## Research Objectives
- Develop a method for identifying and gathering Bitcoin transactions that goes beyond known clustering heuristics.

- Implement this method on-top-of the Graph-Sense Open-Source Analytics Platform.

- Apply the method on 35 ransomware families and find new addresses related to each ransomware family, distinguish collectors from payment addresses and, when possible, track where the money is cashed out.

- Quantify the lower financial impact bounds for each ransomware family.
 
- Show how ransom payments evolve over time.

- Estimate the minimum worth of the ransomware market.


## Terminology


Typical ransomware payment workflow:

- **Payment address**: an address generated by some ransomware attacker for receiving payments from victims (= the initial seed file).
- **Collector address**: an address used to collect or aggregate payments from

# Dataset overview

```{r blockchain_stats, echo=FALSE, message=FALSE}

# Load blockchain stats
blockchain.stats <- load_blockchain_stats(paste0(dataset.path, "blockchain/blockchain_stats.csv"))

```

# Methodology

## Blockchain Status

- Blocks: `r prettyNum(blockchain.stats$blocks,big.mark=",",scientific=FALSE)`

- Transactions: `r prettyNum(blockchain.stats$transactions,big.mark=",",scientific=FALSE)`

- Addresses: `r prettyNum(blockchain.stats$addresses,big.mark=",",scientific=FALSE)`

- Clusters: `r prettyNum(blockchain.stats$clusters,big.mark=",",scientific=FALSE)` (with number of addresses >= 2)

- Address Graph Relations: `r prettyNum(blockchain.stats$addressRel,big.mark=",",scientific=FALSE)`

- Cluster Graph Relations: `r prettyNum(blockchain.stats$clusterRel,big.mark=",",scientific=FALSE)`

## Families, Addresses, and Clusters

```{r dataset_summary, echo=FALSE, message=FALSE}

# Load seed and expanded addresses
seed.addresses <- load_addresses(paste0(dataset.path, "blockchain/seed_addresses.csv"))
expanded.addresses <- load_addresses_stats(paste0(dataset.path, "blockchain/expanded_addresses_stats.csv"))

family.seedAddresses.count <- seed.addresses %>% 
  group_by(family) %>%
  dplyr::summarise(seedAddresses = n())

family.clusters.count <- expanded.addresses %>%
  filter(!is.na(cluster)) %>%
  group_by(family) %>%
  dplyr::summarise(noClusters = n_distinct(cluster))

family.expandedAddresses.count <- expanded.addresses %>% 
  group_by(family) %>% 
  dplyr::summarise(expandedAddresses = n())

dataset.summary <- family.seedAddresses.count %>%
  merge(family.clusters.count, by = "family", all.x = TRUE) %>%
  merge(family.expandedAddresses.count, by = "family", all.x = TRUE)
  
dataset.summary[is.na(dataset.summary)] <- 0

dataset.summary <- dataset.summary[order(-dataset.summary$seedAddresses), ]

ggplot(gather(dataset.summary, key, value, -family), aes(family, value + 1)) +   
  geom_bar(aes(fill = key), position = "dodge", stat="identity", na.rm = TRUE) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0)) +
  scale_y_log10(labels = scales::comma) +
  labs(x = "Ransomware Family", y = "Count (log scale)", title = "Ransomware Dataset Overview")
ggsave("plots/dataset_characteristics.pdf", plot = last_plot())
```

## Cluster Overlaps

```{r cluster_overlaps, echo=FALSE, message=FALSE, results="asis"}

expanded.addresses %>% 
  filter(!is.na(cluster)) %>%
  group_by(cluster) %>% 
  dplyr::summarise(
    familyCount = n_distinct(family),
    families = paste(unique(family), collapse = " ")) %>%
  filter(familyCount > 1) %>%
  arrange(desc(familyCount)) %>%
  xtable %>%
  print(comment = FALSE, include.rownames = FALSE)
```


## Observations

* Out dataset contains `r nrow(seed.addresses)` seed addresses belonging to `r length(unique(seed.addresses$family))` ransomware families
* `r nrow(merge(seed.addresses, expanded.addresses))` (`r length(unique(merge(seed.addresses, expanded.addresses)$family))` families) of those addresses were found in the blockchain
* All Locky addresses belong to the same cluster => we already received the extended dataset for that family

# Analysis of Ransom Payments

```{r load_expanded_addresses, echo=FALSE, message=FALSE}

# Load exchange rates
exchangeRates <- read_delim(paste0(dataset.path, "exchange_rates.csv"), delim = ",", quote = '"') %>%
  mutate(date = as.Date(date))

# Load incoming transactions dataset
expanded.tx.incoming <- load_transactions(paste0(dataset.path, "blockchain/expanded_txs_incoming.csv"))

# Merge with exchange rates
expanded.tx.incoming <- expanded.tx.incoming %>%
  mutate(date = as.Date(format(as.Date(as.POSIXct(timestamp, origin="1970-01-01"), tz = "UTC"), "%Y-%m-%d"))) %>%
  # mutate(date = as.Date(paste0(format(as.Date(as.POSIXct(timestamp, origin="1970-01-01"), tz = "UTC"), "%Y-%m"), "-01"))) %>%
  merge(exchangeRates, all.x = TRUE, by = "date") %>%
  mutate(valueUSD = to_btc(valueSATOSHI) * price) %>%
  select(address, txHash, family, date, valueSATOSHI, valueUSD)

```

## Data Filtering

- Time based filtering

```{r filtering, echo=FALSE, message=FALSE, results="asis"}

filter.time <- read.csv("./dataset/time_filter.csv", stringsAsFactors = FALSE) %>%
  gather(key = type, value = date, -family, na.rm = TRUE) %>%
  filter(date != "") %>%
  mutate(
    startDate = as.Date(date, "%m/%d/%Y"),
    type = as.factor(sub("start_", "", type))
  ) %>%
  select(family, startDate, type)

filter.time %>%
  mutate(startDate = as.character(startDate)) %>%
  xtable %>%
  print(comment = FALSE, scalebox = '0.4', include.rownames = FALSE)  

```

## Expanded Address Dataset

```{r seeed_dataset_statistics_table, echo=FALSE, message=FALSE, results="asis"}

expanded.tx.incoming.filtered <- expanded.tx.incoming %>%
  mutate(family = as.character(family)) %>%
  inner_join(select(filter.time, family, startDate)) %>%
  # mutate(startDate = ifelse(is.na(startDate), date, startDate)) %>%
  filter(date >= startDate)

expanded.addr.count <- expanded.tx.incoming %>%
  mutate(family = as.character(family)) %>%
  group_by(family) %>%
    dplyr::summarise(expAddresses = n_distinct(address))

expanded.addr.tf.count <- expanded.tx.incoming.filtered %>%
  mutate(family = as.character(family)) %>%
  group_by(family) %>%
    dplyr::summarise(tfAddresses = n_distinct(address))

expanded.dataset.summary <- dataset.summary %>% 
  select(family, seedAddresses, noClusters) %>%
  mutate(family = as.character(family)) %>%
  left_join(expanded.addr.count, by = c("family")) %>%
  left_join(expanded.addr.tf.count, by = c("family"))

expanded.dataset.summary[is.na(expanded.dataset.summary)] <- 0

expanded.dataset.summary %>% 
  arrange(-tfAddresses) %>%
  mutate(
    seedAddresses = prettyNum(seedAddresses, big.mark = ","),
    noClusters = prettyNum(noClusters, big.mark = ","),
    expAddresses = prettyNum(expAddresses, big.mark = ","),
    tfAddresses = prettyNum(tfAddresses, big.mark = ",")
  ) %>%
  head(15) %>%
  xtable %>%
  print(comment = FALSE, scalebox = '0.6', include.rownames = TRUE)

```

## Expanded Addresses | Applied time filters

```{r applied_time_filters, echo=FALSE, message=FALSE, results="asis"}

expanded.dataset.summary %>% 
  arrange(-tfAddresses) %>%
  head(15) %>%
  select(family) %>%
  inner_join(filter.time) %>%
  mutate(
    startDate = as.character(format(startDate, "%Y-%m")),
    type = as.character(type),
    type = replace(type, type %in% c("googleTrend"), "Google Trends"),
    type = replace(type, type %in% c("articles"), "Manual search")
  ) %>%
  xtable %>%
  print(comment = FALSE, scalebox = '0.6', include.rownames = TRUE)

```


## Expanded Addresses | Received Payments per family


```{r expanded_addresses_received_payments, echo=FALSE, message=FALSE}

# Collector addresses
collector.addresses <- load_addresses(paste0(dataset.path, "blockchain/collector_addresses.csv"))

top.addresses <- expanded.tx.incoming.filtered %>%
  anti_join(select(collector.addresses, address)) %>%
  group_by(family) %>%
  dplyr::summarise(
    Addresses = n_distinct(address),
    BTC = to_btc(sum(valueSATOSHI)),
    USD = sum(valueUSD, na.rm = TRUE)
  ) %>%
  arrange(-USD) %>%
  head(15)

```

```{r expanded_addresses_received_payments_table, echo=FALSE, message=FALSE, results="asis"}

top.addresses %>%
  mutate(
    Addresses = prettyNum(Addresses, big.mark = ","),
    BTC = prettyNum(round(BTC,2), big.mark = ","),
    USD = prettyNum(round(USD,0), big.mark = ",")
  ) %>%
  xtable %>%
  print(comment = FALSE, scalebox = '0.75',include.rownames = TRUE)

```

## Expanded Addresses | Overall Revenue

```{r overall_revenue, echo = FALSE, message=FALSE, results="asis"}

options(scipen = 999)

expanded.tx.incoming.filtered %>%
  anti_join(select(collector.addresses, address)) %>%
  select(valueSATOSHI, valueUSD) %>%
  summarise_each(funs(sum)) %>%
  mutate(
    valueBTC = prettyNum(to_btc(valueSATOSHI), big.mark = ","),
    valueUSD = prettyNum(valueUSD, big.mark = ",")
  ) %>%
  select(valueBTC, valueUSD) %>%
  xtable %>%
  print(comment = FALSE, scalebox = '0.75',include.rownames = TRUE)  

```


## Expanded Addresses | Payment Amounts (USD)

```{r payment_amounts_boxplot_USD, echo = FALSE, message=FALSE}

expanded.tx.incoming.filtered %>%
  select(family, valueUSD) %>%
  right_join(select(top.addresses, family)) %>%
  ggplot(aes(x = family, y = (valueUSD + 1))) +
  geom_boxplot(alpha = .1) +
  scale_y_log10(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0)) +
  labs(x = "", y = "USD (log scale)", title = "Amount of payment per family.")
ggsave("plots/expanded_addresses_payment_amounts_bp_USD.pdf", plot = last_plot())

```

## Expanded Addresses | Payment Amounts (BTC)

```{r payment_amounts_boxplot_BTC, echo = FALSE, message=FALSE}

expanded.tx.incoming.filtered %>%
  select(family, valueSATOSHI) %>%
  right_join(select(top.addresses, family)) %>%
  ggplot(aes(x = family, y = (to_btc(valueSATOSHI) + 1))) +
  geom_boxplot(alpha = .1) +
  scale_y_log10(labels = scales::comma) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0)) +
  labs(x = "", y = "BTC (log scale)")
ggsave("plots/expanded_addresses_payment_amounts_bp_BTC.pdf", plot = last_plot())

```


## Expanded Addresses | Mean Payment Amounts (USD)

```{r payment_amounts_means, echo = FALSE, message=FALSE}

expanded.tx.means <- expanded.tx.incoming.filtered %>%
  select(family, valueUSD) %>%
  right_join(select(top.addresses, family)) %>%
  group_by(family) %>%
    filter(n() > 1) %>%
    dplyr::summarise(
      mean = mean(valueUSD),
      sd = sd(valueUSD),
      sem = sd(valueUSD)/sqrt(length(valueUSD))
    )

expanded.tx.means %>%
  ggplot(aes(x = family, y = mean)) +
  geom_errorbar(width=.2, aes(ymin=mean-1.96*sem, ymax=mean+1.96*sem), colour="red") +
  scale_y_continuous(labels = scales::dollar) +
  geom_point(shape=21, size=2, fill="white") +
  geom_text(aes(label=as.character(round(mean))),
            position = position_dodge(width=0.9),
            hjust=-0.4, colour="gray28",
            size=2.5) +
  theme_light() +
  theme(
    axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0)
  ) +
  labs(x = "", y = "") +

ggsave("plots/mean_payment_amounts.pdf", plot = last_plot())

```


## Ransom Payments (USD)


```{r expanded_addresses_payments, echo = FALSE, message = FALSE}

payment.trends <- expanded.tx.incoming.filtered %>%
  select(family, date, valueUSD) %>%
  right_join(select(top.addresses, family)) %>%
  group_by(family, date) %>%
    dplyr::summarise(
      dailySum = sum(valueUSD)
    ) %>%
  group_by(family) %>%
    mutate(dailyCumSum = cumsum(dailySum))

```


```{r ransom_payments_, echo = FALSE, message = FALSE}

payment.trends %>%
    filter(family %in% c("CryptoLocker", "Locky", "SamSam", "WannaCry")) %>%
    ggplot(aes(x = date, group = family)) +
    geom_point(aes(y = dailySum), colour="lightblue", size = .2) +
    geom_line(aes(y = dailyCumSum), colour="red") +
    scale_x_date(date_labels = "%m/%Y") +
    scale_y_continuous(labels = scales::dollar) +
    labs(x = "", y = "") +
    facet_wrap(~family, nrow = 4, scales="free") +
    theme_light()

ggsave("plots/ransomware_payments.pdf", width=4, height=7, dpi=300)

```