tests/testthat/test-selectGene.R

In xegaSelectGene: Selection of Genes and Gene Representation Independent Functions

library(testthat)
library(xegaSelectGene)

FitnessRange<-1000

test_that("NewlFselectGenes OK",
          {lF<-NewlFselectGenes()
	   expect_identical(lF$SelectionContinuation(), TRUE)
           expect_equal(lF$Max(), 1)
           expect_equal(lF$Offset(), 1)
           expect_equal(lF$Eps(), 0.01)
           expect_equal(lF$TournamentSize(), 2)
           expect_equal(lF$SelectionBias(), 1.5)
          }
)

test_that("SelectPropFitOnln OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFitOnln(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectPropFitOnln(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFitOnln((fit^2), lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectPropFit OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFit(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectPropFit(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFit(fit^2, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectPropFitM OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFitM(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectPropFitM(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFitM(fit^2, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectPropFitDiffOnln OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFitDiffOnln(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectPropFitDiffOnln(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFitDiffOnln((mean(fit)+fit)^2, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectPropFitDiff OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFitDiff(fit, lF)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   f2<-SelectPropFitDiff(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFitDiff((fit+mean(fit))^2, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectPropFitDiffM OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectPropFitDiffM(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectPropFitDiffM(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectPropFitDiffM((fit+mean(fit))^2, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectUniform OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectUniform(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectUniform(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectUniform(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit)-sqrt(var(fit)))
           expect_lt(mean(fit[f100]), mean(fit)+sqrt(var(fit)))
          }
)

test_that("SelectUniformP OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectUniformP(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectUniformP(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectUniformP(fit, lF, 100)
           expect_identical(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectDuel OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectDuel(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectDuel(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectDuel(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectTournament 2 OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectTournament(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectTournament(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectTournament(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectTournament 5 OK",
          {lF<-NewlFselectGenes()
	   lF$TournamentSize<-parm(5)
           expect_equal(lF$TournamentSize(), 5)
           fit<-sample(FitnessRange, 100, replace=TRUE)
           fit<-fit - mean(fit)
           f1<-SelectTournament(fit, lF)
           expect_identical(fit[f1]%in%fit, TRUE)
           fit<-sample(FitnessRange, 100, replace=TRUE)
           f2<-SelectTournament(fit, lF, 2)
           expect_identical(fit[f2]%in%fit, rep(TRUE,2))
           f100<-SelectTournament(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectSUS (negative fitness) OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectSUS(fit, lF)
	   expect_identical(fit[f1]%in%fit, TRUE)
	  })

test_that("SelectSUS OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   f2<-SelectSUS(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectSUS(fit^2, lF, 10)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)


test_that("SelectLRSelective OK",
          {lF<-NewlFselectGenes()
	   lF$SelectionBias<-parm(2)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectLRSelective(fit, lF)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   f2<-SelectLRSelective(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectLRSelective(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectLinearRankTSR OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   fit<-fit - mean(fit)
	   f1<-SelectLinearRankTSR(fit, lF)
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   expect_identical(fit[f1]%in%fit, TRUE)
	   f2<-SelectLinearRankTSR(fit, lF, 2)
	   expect_identical(fit[f2]%in%fit, rep(TRUE,2))
	   f100<-SelectLinearRankTSR(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("TransformSelect SelectSUS OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-TransformSelect(fit, lF, SelectSUS)
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory() OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory()
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory Uniform OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory(method="Uniform")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit)-sqrt(var(fit)))
           expect_lt(mean(fit[f100]), mean(fit)+sqrt(var(fit)))
          }
)

test_that("SelectGeneFactory UniformP OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory(method="UniformP")
	   f100<-cSelect(fit, lF, 100)
           expect_equal(mean(fit[f100]), mean(fit))
	   f110<-cSelect(fit, lF, 110)
           expect_identical((mean(fit[f110])==mean(fit)), FALSE)
          }
)

test_that("SelectGeneFactory ProportionalOnln OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory(method="ProportionalOnln")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory Proportional OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory(method="Proportional")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory ProportionalM OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("ProportionalM")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory PropFitDiffOnln OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("PropFitDiffOnln")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory PropFitDiff OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("PropFitDiff")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory PropFitDiffM OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("PropFitDiffM")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory Duel OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("Duel")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory Tournament OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("Tournament")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory STournament OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("STournament")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory LRSelective OK",
          {lF<-NewlFselectGenes()
	   lF$SelectionBias<-function() {1.99}
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("LRSelective")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory LRTSR OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("LRTSR")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory SUS OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   cSelect<-SelectGeneFactory("SUS")
	   f100<-cSelect(fit, lF, 100)
           expect_gt(mean(fit[f100]), mean(fit))
          }
)

test_that("SelectGeneFactory HUGO OK",
          {lF<-NewlFselectGenes()
	   fit<-sample(FitnessRange, 100, replace=TRUE)
	   expect_error(SelectGeneFactory("HUGO")) 
          }
)