## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>"
)
set.seed(1)

## ----data---------------------------------------------------------------------
library(joinery)
library(dplyr)

data(base_example)
data(target_example)

glimpse(base_example)

## ----target-------------------------------------------------------------------
glimpse(target_example)

## ----pair---------------------------------------------------------------------
target_example |>
  filter(id_target == "T0006") |>
  select(id_target, Vorname, Nachname, Strasse, Ort)

base_example |>
  filter(id_base == "B0006") |>
  select(id_base, Vorname, Nachname, Strasse, Ort)

## ----strategy-----------------------------------------------------------------
strat <- search_strategy(
  Nachname   ~ normalize_text() + word_tokens(min_nchar = 3),
  Vorname    ~ normalize_text() + word_tokens(min_nchar = 3),
  Strasse    ~ normalize_street(lang = "de") + word_tokens(min_nchar = 3),
  Hausnummer ~ numeric_tokens,
  Ort        ~ normalize_text(),
  block_by   = "Kreis",
  threshold  = 0.8
)

strat

## ----inspect------------------------------------------------------------------
head(inspect_tokens(base_example, "id_base", strat, Vorname), 8)

## ----audit--------------------------------------------------------------------
audit_strategy(base_example, "id_base", strat)

## ----dedup--------------------------------------------------------------------
dups <- detect_duplicates(base_example, id = "id_base", strategy = strat)

dups |>
  select(duplicate_group, id, score, rank) |>
  head()

## ----dedup-collapse-----------------------------------------------------------
base_clean <- deduplicate_table(base_example, dups, id = "id_base")

nrow(base_example) - nrow(base_clean)

## ----search-------------------------------------------------------------------
matches <- search_candidates(
  base_clean,
  target_example,
  base_id   = "id_base",
  target_id = "id_target",
  strategy  = strat
)

matches |>
  select(match_id, score, source, id, Nachname, rank) |>
  head()

## ----summarise----------------------------------------------------------------
summarise_matches(matches, threshold = 0.8)

## ----explain------------------------------------------------------------------
mid <- matches |> filter(id == "T0006") |> pull(match_id) |> first()

receipt <- explain_match(
  matches, strat,
  base      = base_clean,
  id        = "id_base",
  target    = target_example,
  target_id = "id_target",
  match_id  = mid
)

receipt

## ----explain-plot, fig.alt = "Horizontal bar chart of per-token contributions to the match score, coloured by column"----
token_contribution_plot(receipt)

## ----scoring------------------------------------------------------------------
pred <- matches |>
  group_by(match_id) |>
  summarise(
    base_id = id[source == "base"][1],
    truth   = actual_link[source == "target"][1],
    .groups = "drop"
  ) |>
  mutate(correct = base_id == truth)

recoverable <- sum(target_example$actual_link %in% base_example$id_base)

c(
  pairs     = nrow(pred),
  precision = round(mean(pred$correct, na.rm = TRUE), 3),
  recall    = round(sum(pred$correct, na.rm = TRUE) / recoverable, 3)
)

## ----sweep--------------------------------------------------------------------
sweep <- bind_rows(lapply(c(0.6, 0.7, 0.8, 0.9), function(th) {
  st <- strat
  st@threshold <- th
  m <- search_candidates(base_clean, target_example,
                         base_id = "id_base", target_id = "id_target",
                         strategy = st)
  p <- m |>
    group_by(match_id) |>
    summarise(base_id = id[source == "base"][1],
              truth   = actual_link[source == "target"][1],
              .groups = "drop") |>
    mutate(correct = base_id == truth)
  tibble(
    threshold = th,
    pairs     = nrow(p),
    precision = round(mean(p$correct, na.rm = TRUE), 3),
    recall    = round(sum(p$correct, na.rm = TRUE) / recoverable, 3)
  )
}))

sweep

## ----residuals----------------------------------------------------------------
unmatched_base   <- extract_unmatched(base_clean, "id_base", matches)
unmatched_target <- extract_unmatched(target_example, "id_target", matches)

nrow(unmatched_base)
nrow(unmatched_target)

## ----staged-------------------------------------------------------------------
staged <- multi_stage_search(
  base_clean, target_example,
  base_id   = "id_base",
  target_id = "id_target",
  strategies = list(
    exact = exact_strategy(
      Nachname ~ normalize_text() + word_tokens(min_nchar = 3),
      Vorname  ~ normalize_text() + word_tokens(min_nchar = 3),
      Ort      ~ normalize_text(),
      block_by = "Kreis"
    ),
    fuzzy = strat
  )
)

table(staged$stage)