GA: Genetic Algorithm

context("Test select()")
library(GA)


test_that("set-up for select function",{
  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])
  data <- dt_wine
  target <- 'quality'
  y <- data[, target]
  x <- data[, names(data) != target]
  C <- dim(x)[2]  # chromosome_length (# of features)
  P <- C * 10  # population size
  mutation_rate <- 1 / C
  repetition <- 30

  # Testing the type of each
  expect_type(y,"double")
  expect_type(x,"list")
  expect_type(C, "integer")
  expect_type(P,"double")
})

test_that("initialize_gene function input and output",{

  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])
  data <- dt_wine
  target <- 'quality'
  y <- data[, target]
  x <- data[, names(data) != target]
  C <- dim(x)[2]  # chromosome_length (# of features)
  P <- C * 10  # population size
  mutation_rate <- 1 / C
  repetition <- 30
  gene_mat <- matrix(rep(initialize_gene(C), P), ncol = C, nrow = P)

  ## TESTING THE INITIALIZE GENE FUNCTION
  expect_type(gene_mat, "logical")
  expect_equal(2,length(dim(gene_mat)))
  expect_error(initialize_gene("a"), "vector size cannot be NA/NaN")

})


# Testing in example 2 that no errors throw
# Testing that the result has the proper dimensions
# Testing that invalid inputs don't continue to run the function
# Testing for a proper output
test_that("select function",{

  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])

  # Checking for any errors
  expect_error(select(dt_wine, 'quality', fit_method = 'lm', metric = 'aic'), NA)
  result_wine <- select(dt_wine, 'quality', fit_method = 'lm', metric = 'aic')

  # test the type, size, etc of result
  expect_type(result_wine, "character")
})


# Next test section:
test_that("selection inputs and outputs are valid", {

  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])
  data <- dt_wine
  target <- 'quality'
  y <- data[, target]
  x <- data[, names(data) != target]
  C <- dim(x)[2]  # chromosome_length (# of features)
  P <- C * 10  # population size
  mutation_rate <- 1 / C
  repetition <- 30
  gene_mat <- matrix(rep(initialize_gene(C), P), ncol = C, nrow = P)
  temp <- selection(gene_mat, x, y, 'lm','aic')

  # Tests
  expect_type(temp,"list")
  expect_error(selection(gene_mat, x),"argument \"y\" is missing, with no default")

})


# Next test section:
test_that("crossover inputs and outputs are valid, without error", {

  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])
  data <- dt_wine
  target <- 'quality'
  y <- data[, target]
  x <- data[, names(data) != target]
  C <- dim(x)[2]  # chromosome_length (# of features)
  P <- C * 10  # population size
  mutation_rate <- 1 / C
  repetition <- 30
  gene_mat <- matrix(rep(initialize_gene(C), P), ncol = C, nrow = P)

  # Check the following:
  temp <- selection(gene_mat, x, y, "lm", "aic")
  parent_gene <- temp[[1]]
  gene_mat <- cross_over(parent_gene, P)

  # Tests
  typeof(temp)
  expect_type(temp,"list")
  expect_error(selection(),"argument \"gene_mat\" is missing, with no default")
  expect_error(selection("random_string","Error in 1:P : argument of length 0"))

})

# Next test section:
test_that("final select data structure inputs and outputs are valid, without error", {

  # Setting up the test
  dt_wine <- read.csv(file = "data_wine.csv")
  dt_wine[, "quality"] <- as.numeric(dt_wine[, "quality"])
  data <- dt_wine
  target <- 'quality'
  y <- data[, target]
  x <- data[, names(data) != target]
  C <- dim(x)[2]  # chromosome_length (# of features)
  P <- C * 10  # population size
  mutation_rate <- 1 / C
  repetition <- 30
  gene_mat <- matrix(rep(initialize_gene(C), P), ncol = C, nrow = P)
  temp <- selection(gene_mat, x, y, 'lm', 'aic')
  parent_gene <- temp[[1]]
  gene_mat <- cross_over(parent_gene, P)

  # Check the following:
  result_column_boolean <- parent_gene[1, ]
  result_column_names <- names(x)[result_column_boolean]

  # Tests:
  expect_type(result_column_boolean,"logical")
  expect_type(result_column_names, "character")

})