tests/test_score_simple.R

In reclin2: Record Linkage Toolkit

library(reclin2)
library(parallel)
source("helpers.R")

pairs <- data.table(
    .x = c(1L, 1L, 2L, 3L),
    .y = c(1L, 2L, 1L, 2L),
    a  = c(1.0, 0.0, 1.0, 0.0),
    b  = c(0.5, 1.0, 0.0, 1.0),
    c  = c(0.0, NA,  0.5, NA)
  )
class(pairs) <- c("pairs", "data.table")

# === Basic functionality
tmp <- score_simple(pairs, "score", on = c("a", "b", "c"))
expect_equal(names(tmp), c(names(pairs), "score"))
expect_equal(tmp$score, c(1.5, 1.0, 1.5, 1.0))

tmp <- score_simple(pairs, "score", on = c("c", "b"))
expect_equal(names(tmp), c(names(pairs), "score"))
expect_equal(tmp$score, c(0.5, 1.0, 0.5, 1.0))

# === Specifying weights
tmp <- score_simple(pairs, "score", on = c("a", "b", "c"), 
  w1 = c(2, 1, 0.5))
expect_equal(tmp$score, c(2.5, 1.0, 2.25, 1.0))

tmp <- score_simple(pairs, "score", on = c("a", "b", "c"), 
  w1 = c(b = 1, c = 0.5, a = 2.0))
expect_equal(tmp$score, c(2.5, 1.0, 2.25, 1.0))

tmp <- score_simple(pairs, "score", on = c("a", "b", "c"), 
  w1 = list(b = 1, c = 0.5, a = 2.0))
expect_equal(tmp$score, c(2.5, 1.0, 2.25, 1.0))

tmp <- score_simple(pairs, "score", on = c("a", "b", "c"), 
  w1 = list(b = 1, c = 0.5, a = 2.0),
  w0 = c(-1, -2, -3))
expect_equal(tmp$score, c(-1.5, 0.0, -1.25, 0.0))

tmp <- score_simple(pairs, "score", on = c("a", "b", "c"), 
  w1 = list(b = 1, c = 0.5, a = 2.0),
  w0 = c(-1, -2, -3),
  wna = c(b = -1, a = 0, c = -1))
expect_equal(tmp$score, c(-1.5, -1.0, -1.25, -1.0))

tmp <- score_simple(pairs, "score", on = c("a", "b", "c"),
  wna = NA)
expect_equal(tmp$score, c(1.5, NA, 1.5, NA))

# === Edge cases
tmp <- score_simple(pairs, "score", on = character(0))
expect_equal(tmp$score, c(0.0, 0.0, 0.0, 0.0))

tmp <- score_simple(pairs[FALSE,], "score", on = c("a", "b", "c"))
expect_equal(tmp$score, numeric(0))

# === IN PLACE
tmp <- copy(pairs)
score_simple(tmp, "score", on = c("a", "b", "c"), 
  w1 = list(b = 1, c = 0.5, a = 2.0),
  w0 = c(-1, -2, -3),
  wna = c(b = -1, a = 0, c = -1), inplace = TRUE)
expect_equal(tmp$score, c(-1.5, -1.0, -1.25, -1.0))

tmp <- copy(pairs)
score_simple(tmp, "score", on = character(0), inplace = TRUE)
expect_equal(tmp$score, c(0.0, 0.0, 0.0, 0.0))

# === CLUSTER
x <- data.table(a = c(1,1,2,2), b = c(1,2,1,2))
y <- data.table(a = c(3,3,2,2), b = c(1,2,1,2))

cl <- makeCluster(2)

set.seed(103)
pairs <- cluster_pair_blocking(cl, x, y, on = "a")
compare_pairs(pairs, c("a", "b"))

score_simple(pairs, on = c("a", "b"), variable = "score")
tmp <- cluster_collect(pairs)
expect_equal(tmp$score, c(1,2,2,1))

score_simple(pairs, on = c("a", "b"), variable = "score", 
  w1 = c(4,1), w0 = c(-1, -2))
tmp <- cluster_collect(pairs)
expect_equal(tmp$score, c(2, 5, 5, 2))


stopCluster(cl)