tests/testthat/test-predict.R

In dbscan: Density-Based Spatial Clustering of Applications with Noise (DBSCAN) and Related Algorithms

test_that("predict", {
  set.seed(3)
  n <- 100
  x_data <- cbind(
    x = runif(5, 0, 10) + rnorm(n, sd = 0.2),
    y = runif(5, 0, 10) + rnorm(n, sd = 0.2)
  )

  x_noise <- cbind(
    x = runif(n/2, 0, 10),
    y = runif(n/2, 0, 10)
  )

  x <- rbind(x_data, x_noise)

  # check if l points with a little noise are assigned to the same cluster
  l <- 20
  newdata <- rbind(
    x_data[1:l,] + rnorm(2*l, 0, .05),
    x_noise[1:l,] + rnorm(2*l, 0, .05)
  )

  idx <- c(1:l, n + (1:l))

  #plot(x, col = rep(c("black", "gray"), each = n))
  #points(newdata, col = rep(c("red", "gray"), each = l), pch = 16)

  # DBSCAN
  res <- dbscan(x, eps = .3, minPts = 3)
  pr <- predict(res, newdata, data = x)

  rbind(true = res$cluster[idx], pred = pr)
  expect_equal(res$cluster[idx], pr)
  #plot(x, col = ifelse(res$cluster == 0, "gray", res$cluster))
  #points(newdata, col = ifelse(pr == 0, "gray", pr), pch = 16)

  # OPTICS
  res <- optics(x, minPts = 3)
  res <- extractDBSCAN(res, eps = .3)
  pr <- predict(res, newdata, data = x)

  rbind(true = res$cluster[idx], pred = pr)
  expect_equal(res$cluster[idx], pr)

  # currently no implementation for extractXi

  # HDBSCAN (note predict is not perfect for the data.)
  res <- hdbscan(x, minPts = 3)
  pr <- predict(res, newdata, data = x)

  rbind(true = res$cluster[idx], pred = pr)
  accuracy <- sum(res$cluster[idx] == pr)/length(pr)
  expect_true(accuracy > .9)

  # show misclassifications
  #plot(x, col = ifelse(res$cluster == 0, "gray", res$cluster))
  #points(newdata, col = ifelse(pr == 0, "gray", pr), pch = 16)
  #points(newdata[res$cluster[idx] != pr,, drop = FALSE], col = "red", pch = 4, lwd = 2)
})