---
title: "Blocking records for deduplication"
author: "Maciej Beręsewicz"
output: 
    html_vignette:
        df_print: kable
        toc: true
        number_sections: true
        fig_width: 6
        fig_height: 4
vignette: >
  %\VignetteIndexEntry{Blocking records for deduplication}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  warning = FALSE,
  message = FALSE,
  comment = "#>"
)
data.table::setDTthreads(1)
```

# Setup

Read required packages.

```{r setup}
library(blocking)
library(data.table)
```

Read the `RLdata500` data (taken from the [RecordLinkage](https://CRAN.R-project.org/package=RecordLinkage) package).

```{r}
data(RLdata500)
setDT(RLdata500)
head(RLdata500)
```
This dataset contains `r nrow(RLdata500)` rows with `r NROW(unique(RLdata500$ent_id))` entities.

# Blocking for deduplication

Now we create a new column that concatenates the information in each row. 

```{r}
RLdata500[, id_count :=.N, ent_id] ## how many times given unit occurs
RLdata500[, bm:=sprintf("%02d", bm)] ## add leading zeros to month
RLdata500[, bd:=sprintf("%02d", bd)] ## add leading zeros to day
RLdata500[, txt:=tolower(paste0(fname_c1,fname_c2,lname_c1,lname_c2,by,bm,bd))]
head(RLdata500)
```

In the next step we use the newly created column in the `blocking` function. If we specify verbose, we get information about the progress.

```{r}
df_blocks <- blocking(x = RLdata500$txt, ann = "nnd", verbose = 1, graph = TRUE, seed = 2024)
```

```{r, echo = FALSE}
blocks_tab <- table(df_blocks$result$block)
block_ids <- rep(as.numeric(names(blocks_tab)), blocks_tab+1)
block_size <- as.numeric(names(table(table(block_ids))))
block_count <- as.vector(table(table(block_ids)))
```

Results are as follows:

+ based on `rnndescent` we have created `r NROW(unique(df_blocks$result$block))` blocks,
+ `r NROW(unique(df_blocks$colnames))` 2-character shingles have been created for the blocking,
+ we have `r format(block_count[1], big.mark = ",")` blocks of `r block_size[1]` elements, `r format(block_count[2], big.mark = ",")` blocks of `r block_size[2]` elements, ..., `r format(block_count[NROW(block_count)], big.mark = ",")` block of `r block_size[NROW(block_size)]` elements.

```{r}
df_blocks
```

Structure of the object is as follows:

+ `result` -- a `data.table` with identifiers and block IDs,
+ `method` -- the method used,
+ `deduplication` -- whether deduplication was applied,
+ `representation` -- whether shingles, a custom matrix, or vectors were used,
+ `metrics` -- standard metrics and based on the `igraph::compare` methods for comparing graphs (here NULL),
+ `confusion` -- confusion matrix (here NULL),
+ `colnames` -- column names used for the comparison,
+ `graph` -- an `igraph` object mainly for visualisation.

```{r}
str(df_blocks,1)
```
Plot connections.

```{r}
plot(df_blocks$graph, vertex.size=1, vertex.label = NA)
```

The resulting `data.table` has four columns:

+ `x` -- reference dataset (i.e. `RLdata500`) -- this may not contain all units of `RLdata500`,
+ `y` - query (each row of `RLdata500`) -- this may not contain all units of `RLdata500`,
+ `block` -- the block ID,
+ `dist` -- distance between objects.

```{r}
head(df_blocks$result)
```

Create long `data.table` with information on blocks and units from original dataset.

```{r}
df_block_melted <- melt(df_blocks$result, id.vars = c("block", "dist"))
df_block_melted_rec_block <- unique(df_block_melted[, .(rec_id=value, block)])
head(df_block_melted_rec_block)
```

We add block information to the final dataset.

```{r}
RLdata500[df_block_melted_rec_block, on = "rec_id", block_id := i.block]
head(RLdata500)
```

We can check in how many blocks the same entities (`ent_id`) are observed. In our example, all the same entities are in the same blocks. 

```{r}
RLdata500[, .(uniq_blocks = uniqueN(block_id)), .(ent_id)][, .N, uniq_blocks]
```

We can visualise the distances between units stored in the `df_blocks$result` data set. Clearly we have a mixture of two groups: matches (close to 0) and non-matches (close to 1). 

```{r}
hist(df_blocks$result$dist, xlab = "Distances", ylab = "Frequency", breaks = "fd",
     main = "Distances calculated between units")
```

Finally, we can visualise the result based on the information whether block contains matches or not.

```{r}
df_for_density <- copy(df_block_melted[block %in% RLdata500$block_id])
df_for_density[, match:= block %in% RLdata500[id_count == 2]$block_id]

plot(density(df_for_density[match==FALSE]$dist), col = "blue", xlim = c(0, 0.8), 
     main = "Distribution of distances between\nclusters type (match=red, non-match=blue)")
lines(density(df_for_density[match==TRUE]$dist), col = "red", xlim = c(0, 0.8))
```