test-LOPART.R
In LOPART: Labeled Optimal Partitioning

library(testthat)
context("LOPART")

x <- c(1.1, 2.2, 5.5, 6.6)
no.labels <- data.frame(
  start=integer(),
  end=integer(),
  changes=integer())

test_that("LOPART with no labels and penalty=0", {
  out_list <- LOPART::LOPART(x, no.labels, 0)
  expect_equal(out_list$loss$changes_total, 3)
  expect_equal(out_list$loss$total_loss + sum(x*x), 0)
})

test_that("LOPART with no labels and big penalty", {
  penalty <- 100000
  out_list <- LOPART::LOPART(x, no.labels, penalty)
  expect_equal(out_list$loss$changes_total, 0)
  expect_equal(out_list$cost$mean, cumsum(x)/seq_along(x))
})
test_that("LOPART with no labels and penalty=Inf", {
  out_list <- LOPART::LOPART(x, no.labels, Inf)
  expect_equal(out_list$loss$changes_total, 0)
  expected.cost <- c(rep(Inf, 3), sum((mean(x)-x)^2-x^2))
  expect_equal(out_list$cost$cost_optimal, expected.cost)
})
test_that("LOPART_interface with no labels and penalty_unlabeled=Inf", {
  out_df <- LOPART::LOPART_interface(
    x, integer(), integer(), integer(),
    n_updates=length(x),
    penalty_unlabeled = Inf,
    penalty_labeled=Inf)
  expect_equal(out_df$mean, cumsum(x)/seq_along(x))
  n.changes <- sum(0 <= out_df$last_change)
  expect_equal(n.changes, 0)
})

test_that("LOPART with one positive label on [1,4] and penalty=0", {
  pos14.label <- data.frame(
    start=1,
    end=length(x),
    changes=1)
  out_list <- LOPART::LOPART(x, pos14.label, 0)
  expect_equal(out_list$loss$changes_total, 1)
  expect_equal(out_list$loss$penalized_cost, out_list$loss$total_loss)
})

test_that("LOPART with one positive label on [1,4] and penalty=Inf", {
  pos14.label <- data.frame(
    start=1,
    end=length(x),
    changes=1)
  out_list <- LOPART::LOPART(x, pos14.label, Inf)
  expect_equal(out_list$loss$changes_total, 1)
  expect_equal(out_list$loss$penalized_cost, Inf)
  m <- c(rep(mean(x[1:2]), 2), rep(mean(x[3:4]), 2))
  expected.loss <- sum((x-m)^2-x^2)
  expect_equal(out_list$loss$total_loss, expected.loss)
})

test_that("LOPART with one negative label on [1,4] and penalty=0", {
  neg14.label <- data.frame(
    start=1,
    end=length(x),
    changes=0)
  out_list <- LOPART::LOPART(x, neg14.label, 0)
  expect_equal(out_list$loss$changes_total, 0)
  m <- mean(x)
  expected.segs <- data.table::data.table(start=1L, end=4L, mean=m)
  expect_equal(out_list$segments, expected.segs)
  expected.cost <- sum((x-m)^2 - x^2)
  expect_equal(out_list$cost$cost_optimal, c(Inf, Inf, Inf, expected.cost))
})

pos13.label <- data.frame(
  start=1,
  end=3,
  changes=1)
test_that("LOPART with one positive label on [1,3] and penalty=0", {
  out_list <- LOPART::LOPART(x, pos13.label, 0)
  expect_equal(out_list$loss$changes_total, 2)
  expect_equal(out_list$segments$end, 2:4)
})
test_that("LOPART with one positive label on [1,3] and small penalty", {
  penalty <- 0.1
  out_list <- LOPART::LOPART(x, pos13.label, penalty)
  m <- c(rep(mean(x[1:2]), 2), x[3:4])
  expected.changes <- sum(diff(m) != 0)
  expected.loss <- sum((x-m)^2 - x^2)
  expect_equal(out_list$loss$changes_total, 2)
  expect_equal(out_list$loss$total_loss, expected.loss)
  expected.cost <- expected.loss+penalty*expected.changes
  expect_equal(out_list$loss$penalized_cost, expected.cost)
  expect_equal(out_list$segments$end, 2:4)
})
test_that("LOPART with one positive label on [1,3] and big penalty", {
  out_list <- LOPART::LOPART(x, pos13.label, 100000)
  expect_equal(out_list$segments$end, c(2, 4))
})
test_that("LOPART with one positive label on [1,3] and penalty=Inf", {
  out_list <- LOPART::LOPART(x, pos13.label, Inf)
  expect_equal(out_list$segments$end, c(2, 4))
})
test_that("LOPART_interface with one positive label on [1,3] and penalty=Inf", {
  out_df <- LOPART::LOPART_interface(
    x, pos13.label$start, pos13.label$end, pos13.label$changes,
    n_updates=length(x),
    penalty_labeled = 0,
    penalty_unlabeled = Inf)
  is.change <- 0 <= out_df$last_change
  change.vec <- out_df$last_change[is.change]
  end.vec <- c(change.vec+1, length(x))
  expect_equal(end.vec, c(2, 4))
})

two.labels <- data.frame(
  start=1:2,
  end=2:3,
  changes=1)
test_that("LOPART with two positive labels on [1,3] and big penalty", {
  out_list <- LOPART::LOPART(x, two.labels, 100000)
  expect_equal(out_list$segments$end, c(1, 2, 4))
})
test_that("LOPART with two positive labels on [1,3] and penalty=0", {
  out_list <- LOPART::LOPART(x, two.labels, 0)
  expect_equal(out_list$segments$end, 1:4)
})

three.labels <- data.frame(
  start=1:3,
  end=2:4,
  changes=c(1, 0, 1))
m <- c(x[1], rep(mean(x[2:3]), 2), x[4])
expected.loss <- sum((x-m)^2 - x^2)
test_that("LOPART with three labels and penalty=0", {
  out_list <- LOPART::LOPART(x, three.labels, 0)
  expect_equal(out_list$segments$end, c(1, 3, 4))
  expect_equal(out_list$loss$penalized_cost, expected.loss)
  expect_equal(out_list$loss$total_loss, expected.loss)
})
test_that("LOPART with three labels and big penalty", {
  penalty <- 100000
  out_list <- LOPART::LOPART(x, three.labels, penalty)
  expect_equal(out_list$segments$end, c(1, 3, 4))
  expect_equal(out_list$loss$penalized_cost, expected.loss+penalty*2)
  expect_equal(out_list$loss$total_loss, expected.loss)
})
test_that("error for negative penalty", {
  expect_error({
    LOPART::LOPART_interface(x, integer(), integer(), integer(), 1, -1)
  }, "penalty must be non-negative")
})

test_that("error for NA penalty", {
  expect_error({
    LOPART::LOPART_interface(x, integer(), integer(), integer(), 1, NA)
  }, "penalty must be non-negative")
})

test_that("error for label with start=end", {
  expect_error({
    LOPART::LOPART_interface(x, 1, 1, 1, 1, 1)
  }, "each label start must be less than its end")
})    

test_that("error for label with start>end", {
  expect_error({
    LOPART::LOPART_interface(x, 2, 1, 1, 1, 1)
  }, "each label start must be less than its end") 
})    

test_that("error for label changes not 0/1", {
  expect_error({
    LOPART::LOPART_interface(x, 1, 2, 5, 1, 1)
  }, "labeled number of changes must be 0 or 1")
})    

test_that("error for label start < prev label end", {
  expect_error({
    LOPART::LOPART_interface(x, c(1, 2), c(3, 4), c(1, 1), 1, 1)
  }, "each label start must be on or after previous end")
})

test_that("error for start/changes sizes that do not match", {
  expect_error({
    LOPART::LOPART_interface(x, c(1, 2), c(3, 4), 1, 1, 1)
  }, "input_label_start and input_label_changes sizes must match")
})

test_that("error for end/changes sizes that do not match", {
  expect_error({
    LOPART::LOPART_interface(x, 1, c(3, 4), 1, 1, 1)
  }, "input_label_end and input_label_changes sizes must match")
})

test_that("error for end equal to n data", {
  expect_error({
    LOPART::LOPART_interface(x, 1, 4, 1, 1, 1)
  }, "label end must be less than n data")
})

test_that("error for end > n data", {
  expect_error({
    LOPART::LOPART_interface(x, 1, 400, 1, 1, 1)
  }, "label end must be less than n data")
})

test_that("error for start < 0", {
  expect_error({
    LOPART::LOPART_interface(x, -1, 2, 1, 1, 1)
  }, "label start must be zero or larger")
})

test_that("error for no data", {
  expect_error({
    LOPART::LOPART_interface(numeric(), integer(), integer(), integer(), 1, 1)
  }, "no data")
})

test_that("error for NA data", {
  expect_error({
    LOPART::LOPART_interface(NA, integer(), integer(), integer(), 1, 1)
  }, "data must be finite")
})

test_that("error for Inf data", {
  expect_error({
    LOPART::LOPART_interface(Inf, integer(), integer(), integer(), 1, 1)
  }, "data must be finite")
})

test_that("error for -Inf data", {
  expect_error({
    LOPART::LOPART_interface(-Inf, integer(), integer(), integer(), 1, 1)
  }, "data must be finite")
})