inst/tinytest/test-input.R

In praznik: Tools for Information-Based Feature Selection and Scoring

#Uncommon decisions
data.frame(A=factor(rep(1:2,each=20)))->X
rep(c(TRUE,FALSE),each=20)->Y
expect_equal(names(MIM(X,Y,1)$selection),"A")
expect_equal(MIM(X,rep(-.7,40),1),list(selection=integer(0),score=numeric(0)))

#Uncommon attributes
badfactor<-factor(c(rep(c("z","a"),each=7),letters))[1:14]
data.frame(
 bool=rep(c(TRUE,FALSE),each=7),
 int=as.integer(rep(c(-37,33),each=7)),
 badfactor=badfactor
)->X
factor(rep(letters[1:2],each=7))->Y
MIM(X,Y,3)->S
expect_true(all(names(S$selection)%in%names(X)))
expect_equal(setNames(S$score,NULL),setNames(rep(S$score[1],3),NULL))

#Errors
expect_error(MIM(list(1:3),NULL,NULL),"X must be a data.frame")
expect_error(MIM(iris[0,-5],iris[0,5]),"X has no rows")
expect_error(hScores(numeric(0)),"X has a zero length")

#Nameless data.frames 
z<-iris[,-5]
names(z)<-NULL
JMI(z,iris$Species,4)->ans
expect_null(names(ans$score))
expect_null(names(ans$selection))
expect_true(all(ans$selection%in%(1:4)))


#Constant real features work
MIM(data.frame(a=rep(1,150)),iris$Species,1)->ans
expect_equal(length(ans$selection),0)

#Numerical stressors
Y<-factor(c("a","b"))
X<-data.frame(
 a=c(0,.1),
 b=c(.Machine$double.eps,.Machine$double.neg.eps),
 c=c(.Machine$double.neg.eps,0),
 d=c(.Machine$double.eps,0),
 e=c(.Machine$double.xmax,.Machine$double.xmin),
 f=c(.Machine$double.eps,.Machine$double.xmin),
 g=c(.Machine$double.eps,.Machine$double.xmax),
 h=c(.Machine$double.neg.eps,.Machine$double.xmin),
 i=c(.Machine$double.neg.eps,.Machine$double.xmax),
 j=c(0,.Machine$double.xmin),
 k=c(0,.Machine$double.xmax),
 l=c(-1,.Machine$double.xmax)
)
expect_equal(
 miScores(X,Y),
 setNames(rep(log(2),ncol(X)),names(X))
)

#https://gitlab.com/mbq/praznik/issues/23
c(
 "CMI","MIM","JMIM","NJMIM","JMI","DISR","CMIM","MRMR",
 "cmiMatrix","cmiScores","dnmiMatrix","hScores","impScores",
 "jmiMatrix","jmiScores","miMatrix","miScores","njmiMatrix",
 "njmiScores","nmiMatrix","maxJmiScores","maxCmiScores",
 "minCmiScores"
)->algos
for(algo in algos){
  if(grepl("^h",algo)){
   z<-do.call(algo,list(c(a=1,b=2,c=3)))
  }else if(grepl("(^mi|^imp|^dnmi|^nmi|^maxJmi|^maxCmi|^minCmi)",algo)){
   z<-do.call(algo,list(c(a=1,b=2,c=3),1:3))
  }else if(grepl("(^cmi|^jmi|^njmi)",algo)){
   z<-do.call(algo,list(c(a=1,b=2,c=3),1:3,3:1))
  }else{  
   z<-do.call(algo,list(c(a=1,b=2,c=3),1:3,k=1))
  }
  if(grepl("Matrix$",algo)){
   expect_null(rownames(z))
   expect_null(colnames(z))
  }else if(grepl("Scores$",algo)){
   expect_null(names(z))
  }else{
   expect_null(names(z$selection))
   expect_null(names(z$score))
  }
}

#Magical cut works like R cut"
expect_equal(
 miScores(iris[,-5],iris$Species),
 miScores(data.frame(lapply(iris[,-5],cut,10)),iris$Species)
)
ii<-iris[c(1:14,100:112),]
expect_equal(
 miScores(ii[,-5],ii$Species),
 miScores(data.frame(lapply(ii[,-5],cut,9)),ii$Species)
)
ii<-iris[c(1:3,101:103),]
expect_equal(
 miScores(ii[,-5],ii$Species),
 miScores(data.frame(lapply(ii[,-5],cut,2)),ii$Species)
)


#Zero-score features work
expand.grid(a=c(T,F),b=c(T,F),n1=c(T,F),n2=c(T,F),n3=c(T,F))->X
X$aub<-X$a|X$b
X$anb<-X$a&X$b
Y<-X$a!=X$b
for(e in c(JMI,DISR,MRMR))
 expect_equal(sort(names(e(X,Y,ncol(X))$selection)),sort(names(X)))
for(e in c(MIM,CMIM,JMIM,NJMIM)){
 e(X,Y,ncol(X))->ans
 expect_true(all(ans$score>0))
 expect_true(all(names(ans$selection)%in%names(X)))
 expect_false(any(duplicated(ans$selection)))
}

#Tests for the following error reported by smilesun:
# https://github.com/mbq/praznik/issues/9
x<-data.frame(a=rep(1,150),b=rep(2,150),c=rep(3,150))
y<-iris$Species
expect_identical(MIM(x,y,3),DISR(x,y,3))

#Input errors
Y<-c(TRUE,TRUE,FALSE,FALSE,FALSE)
li<-data.frame(A=1:5)
li$A<-list(1,1:2,1:3,1:4,1:5)
badX<-list(
 char=data.frame(A=letters[1:5],stringsAsFactors=FALSE),
 realna=data.frame(A=c((1:4)*5.5,NA)),
 realinf=data.frame(A=c(1:4,Inf)),
 img=data.frame(A=1:5+3i),
 li=li
)
for(X in badX){
 expect_error(MIM(X,Y,1))
 expect_error(hScores(X$A))
}
for(Y in badX)
 expect_error(MIM(data.frame(A=Y),X$A,1))

#More input quirks
Y<-iris$Species; Y[3]<-NA
X<-iris[,-5]; X[12,3]<-NA
expect_error(MIM(X,iris$Species,1),"Non-finite numeric values are not allowed")
X[12,3]<-Inf
expect_error(MIM(X,iris$Species,1),"Non-finite numeric values are not allowed")
X[12,3]<-NaN
expect_error(MIM(X,iris$Species,1),"Non-finite numeric values are not allowed")
X<-iris[,"Species",drop=FALSE]; X[17,1]<-NA
expect_error(MIM(X,iris$Species,1),"NA values are not allowed")
X<-iris[,"Species",drop=FALSE]
X[,1]<-as.integer(X[,1]); X[17,1]<-NA
expect_error(MIM(X,iris$Species,1),"NA values are not allowed")

#Scorers throws bad Z size
expect_error(cmiScores(iris[,-5],iris[,5],1:10),"Z vector size mismatch")
expect_error(jmiScores(iris[,-5],iris[,5],1:10),"Z vector size mismatch")
expect_error(njmiScores(iris[,-5],iris[,5],1:10),"Z vector size mismatch")

#Threads argument is processed well
expect_error(miScores(iris[,-5],iris[,5],-17L),"Invalid threads argument")
expect_error(miScores(iris[,-5],iris[,5],NA),"Invalid threads argument")
expect_warning(miScores(iris[,-5],iris[,5],1+parallel::detectCores()),"Thread count capped")


#JMI3
pureJMI3<-function(X,Y,k=3){
 nX<-names(X)
 X<-data.frame(X)
 W<-c()
 if(k>0){
  s1<-miScores(X,Y)
  fscores<-max(s1)
  U<-X[,which.max(s1),drop=FALSE]
  X<-X[,-which.max(s1),drop=FALSE]
 }
 if(k>1){
  s2<-jmiScores(X,Y,U[,1])
  fscores<-c(fscores,max(s2))
  W<-X[,which.max(s2),drop=FALSE]
  X<-X[,-which.max(s2),drop=FALSE]
 }
 if(k>2){
  scores<-rep(0,ncol(X))
  for(e in 3:k){
   for(u in U){
    scores<-scores+jmiScores(X,Y,joinf(u,W[,1]))
   }
   U<-cbind(U,W)
   i<-which.max(scores)
   fscores<-c(fscores,scores[i])
   scores<-scores[-i]
   W<-X[,i,drop=FALSE]
   X<-X[,-i,drop=FALSE]
  }
 }
 selection<-c(names(U),names(W))
 list(
  selection=setNames(match(selection,nX),selection),
  score=setNames(fscores,selection)
 )
}

expect_error(triScores(iris[,1,drop=FALSE]),"Cannot process")
expect_error(triScores(1:10),"Cannot process")
expect_error(triScores(iris[,1:2]),"Cannot process")
expect_error(triScores(iris[1:2,rep(1,2346)]),"Too many features")

expect_equal(
 pureJMI3(iris[,-5],iris[,5],k=1),
 JMI3(iris[,-5],iris[,5],k=1)
)

expect_equal(
 pureJMI3(iris[,-5],iris[,5],k=2),
 JMI3(iris[,-5],iris[,5],k=2)
)