tests/testthat/test-R_binding.R

In mlpack: 'Rcpp' Integration for the 'mlpack' Library

# Test that when we run the binding correctly (with correct input parameters),
# we get the expected output.
test_that("TestRunBindingCorrectly", {
  output <- test_r_binding(4.0, 12, "hello",
                           flag1=TRUE)

  expect_true(output$double_out == 5.0)
  expect_true(output$int_out == 13)
  expect_true(output$string_out == "hello2")
})

# If we forget the mandatory flag, we should get wrong results.
test_that("TestRunBindingNoFlag", {
  output <- test_r_binding(4.0, 12, "hello")

  expect_true(output$double_out != 5.0)
  expect_true(output$int_out != 13)
  expect_true(output$string_out != "hello2")
})

# If we give the wrong string, we should get wrong results.
test_that("TestRunBindingWrongString", {
  output <- test_r_binding(4.0, 12, "goodbye",
                          flag1=TRUE)

  expect_true(output$string_out != "hello2")
})

# If we give the wrong int, we should get wrong results.
test_that("TestRunBindingWrongInt", {
  output <- test_r_binding(4.0, 15, "hello",
                           flag1=TRUE)

  expect_true(output$int_out != 13)
})

# If we give the wrong double, we should get wrong results.
test_that("TestRunBindingWrongDouble", {
  output <- test_r_binding(2.0, 12, "hello",
                           flag1=TRUE)

  expect_true(output$double_out != 5.0)
})

# If we give the second flag, this should fail.
test_that("TestRunBadFlag", {
  output <- test_r_binding(4.0, 12, "hello",
                          flag1=TRUE,
                          flag2=TRUE)

  expect_true(output$double_out != 5.0)
  expect_true(output$int_out != 13)
  expect_true(output$string_out != "hello2")
})

# The matrix we pass in, we should get back with the third dimension doubled and
# the fifth forgotten.
test_that("TestMatrix", {
  x <- matrix(rexp(500, rate = .1), ncol = 5)

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_in=x)

  expect_identical(dim(output$matrix_out), as.integer(c(100, 4)))
  for (i in c(1, 2, 4)) {
    for (j in 1:100) {
      expect_true(output$matrix_out[j, i] == x[j, i])
    }
  }

  for (j in 1:100) {
    expect_true(output$matrix_out[j, 3] == 2 * x[j, 3])
  }
})

# The data.frame we pass in, we should get back with the third dimension doubled
# and the fifth forgotten.
test_that("TestDataFrame", {
  y <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), nrow = 3)
  x <- data.frame(y)

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_in=x)

  expect_identical(dim(output$matrix_out), as.integer(c(3, 4)))
  for (i in c(1, 2, 4)) {
    for (j in 1:3) {
      expect_true(output$matrix_out[j, i] == x[j, i])
    }
  }

  for (j in 1:3) {
    expect_true(output$matrix_out[j, 3] == 2 * x[j, 3])
  }
})

# Same as TestMatrix but with an unsigned matrix.
test_that("TestUMatrix", {
  x <- matrix(as.integer(rexp(500, rate = .1)), ncol = 5)

  output <- test_r_binding(4.0, 12, "hello",
                           umatrix_in=x)

  expect_identical(dim(output$umatrix_out), as.integer(c(100, 4)))
  for (i in c(1, 2, 4)) {
    for (j in 1:100) {
      expect_true(output$umatrix_out[j, i] == x[j, i])
    }
  }

  for (j in 1:100) {
    expect_true(output$umatrix_out[j, 3] == 2 * x[j, 3])
  }
})

# Test a transposed matrix.
test_that("TestTransMatrix", {
  x <- matrix(rexp(500, rate = .1), ncol = 5)

  output <- test_r_binding(4.0, 12, "hello",
                           tmatrix_in=x,
                           matrix_in=x)
  # If the binding succeeds, the output double will be 10.
  expect_true(output$double_out == 10.0)
})

# Test a column vector input parameter.
test_that("TestCol", {
  x <- matrix(rexp(100, rate = .1), nrow = 1)

  output <- test_r_binding(4.0, 12, "hello",
                           col_in=x)

  expect_identical(dim(output$col_out), as.integer(c(1, 100)))
  expect_identical(output$col_out, 2 * x)
})

# Test an unsigned column vector input parameter.
test_that("TestUCol", {
  x <- matrix(as.integer(rexp(100, rate = .1)), nrow = 1) + 1

  output <- test_r_binding(4.0, 12, "hello",
                           ucol_in=x)

  expect_identical(dim(output$ucol_out), as.integer(c(1, 100)))
  expect_identical(output$ucol_out, 1 + x)
})

# Test a row vector input parameter.
test_that("TestRow", {
  x <- matrix(rexp(100, rate = .1), ncol = 1)

  output <- test_r_binding(4.0, 12, "hello",
                           row_in=x)

  expect_identical(dim(output$row_out), as.integer(c(100, 1)))
  expect_identical(output$row_out, 2 * x)
})

# Test an unsigned row vector input parameter.
test_that("TestURow", {
  x <- matrix(as.integer(rexp(100, rate = .1)), ncol = 1) + 1

  output <- test_r_binding(4.0, 12, "hello",
                           urow_in=x)

  expect_identical(dim(output$urow_out), as.integer(c(100, 1)))
  expect_identical(output$urow_out, 1 + x)
})

# Test that we can pass a matrix with all numeric features.
test_that("TestMatrixAndInfo", {
  x <- matrix(rexp(500, rate = .1), ncol = 5)

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_and_info_in=x)

  expect_identical(dim(output$matrix_and_info_out), as.integer(c(100, 5)))
  expect_identical(output$matrix_and_info_out, 2 * x)
})

# Test that we can pass a data.frame with all numeric features.
test_that("TestDataFrameWithNoInfo", {
  y <- matrix(rexp(500, rate = .1), ncol = 5)
  x <- data.frame(y)

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_and_info_in=x)

  expect_identical(dim(output$matrix_and_info_out), as.integer(c(100, 5)))

  for (i in 1:100) {
    for (j in 1:5) {
      expect_true(output$matrix_and_info_out[i, j] == 2 * x[i, j])
    }
  }
})

# Test that we can pass a data.frame with numeric and categorical features.
test_that("TestDataFrameWithInfo", {
  y <- matrix(rexp(90, rate = .1), ncol = 9)
  x <- data.frame(y, "e" = letters[1:10])

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_and_info_in=x)

  expect_identical(dim(output$matrix_and_info_out), as.integer(c(10, 10)))

  for (i in 1:9) {
    for (j in 1:10) {
      expect_true(output$matrix_and_info_out[j, i] == 2 * x[j, i])
    }
  }

  for (j in 1:10) {
    expect_true(output$matrix_and_info_out[j, 10] == j)
  }
})

# Test that we can pass a data.frame with numeric and categorical features.
test_that("TestDataFrameWithLogicalInfo", {
  y <- matrix(rexp(90, rate = .1), ncol = 9)
  x <- data.frame(y)
  x["e"] <- c(T, F, F, T, T, F, F, F, F, T)

  output <- test_r_binding(4.0, 12, "hello",
                           matrix_and_info_in=x)

  expect_identical(dim(output$matrix_and_info_out), as.integer(c(10, 10)))

  for (i in 1:9) {
    for (j in 1:10) {
      expect_true(output$matrix_and_info_out[j, i] == 2 * x[j, i])
    }
  }
  expect_identical(output$matrix_and_info_out[, 10], as.numeric(x[, "e"]))
})

# Test that we can pass a vector of ints and get back that same vector but with
# the last element removed.
test_that("TestIntVector", {
  x <- c(1, 2, 3, 4, 5)

  output <- test_r_binding(4.0, 12, "hello",
                           vector_in=x)

  expect_identical(output$vector_out, c(1:4))
})

# Test that we can pass a vector of strings and get back that same vector but
# with the last element removed.
test_that("TestStringVector", {
  x <- letters[1:5]

  output <- test_r_binding(4.0, 12, "hello",
                           str_vector_in=x)

  expect_identical(output$str_vector_out, letters[1:4])
})

# If we give data other than matrix/data.frame in matrix_in/matrix_and_info_in,
# we should get an error.
test_that("TestNotMatrix", {
  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_in="wrong"))

  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_in=12))

  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_in=1e6))

  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_and_info_in="wrong"))

  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_and_info_in=12))

  expect_error(test_r_binding(4.0, 12, "hello",
                              matrix_and_info_in=1e6))
})

# If we pass labels that start from 0, we should get an error.
test_that("TestZeroLabels", {
  x <- vector(mode="integer", 10)
  expect_error(test_r_binding(4.0, 12, "hello", urow_in=x))

  y <- matrix(0, 10, 1)
  expect_error(test_r_binding(4.0, 12, "hello", ucol_in=y))
})

# First create a GaussianKernel object, then send it back and make sure we get
# the right double value.
test_that("TestModel", {
  output1 <- test_r_binding(4.0, 12, "hello",
                            build_model=TRUE)

  output2 <- test_r_binding(4.0, 12, "hello",
                            model_in=output1$model_out)

  expect_true(output2$model_bw_out == 20)
})

# Test that we can serialize a model to disk and then use it again.
test_that("TestSerialization", {
  output1 <- test_r_binding(4.0, 12, "hello",
                            build_model=TRUE)

  Serialize(output1$model_out, "model.bin")

  new_model <- Unserialize("model.bin")
  unlink("model.bin")

  output2 <- test_r_binding(4.0, 12, "hello", model_in=new_model)

  expect_true(output2$model_bw_out == 20)
})