Nothing
tests/testthat/test-kernel_functions.R
In kerntools: Kernel Functions and Tools for Machine Learning Applications
X <- matrix( c(1,5,2,4,2,8,1,4,-2,6,-3,4 ),ncol=4,nrow=3,byrow = TRUE)
# Linear kernel
test_that("Linear kernel works", {
K <- Linear(X)
Kmanual <- matrix( c(46,60,38,60,85,57,38,57,65),ncol=3,nrow=3) ## calculat a mà
expect_equal(K,Kmanual)
## amb cos-normalització
K <- Linear(X,cos.norm = TRUE)
Kmanual <- matrix( c(1.00, 0.96, 0.69, 0.96, 1.00, 0.77, 0.69, 0.77,1.00),
ncol=3,nrow=3)
expect_equal(round(K,digits=2),Kmanual)
## amb coeficients (a mà)
Xcoef <- matrix( c(0.6708204,2.738613, 0.7745967,1.264911,
1.3416408,4.381780, 0.3872983,1.264911,
-1.3416408, 3.286335, -1.1618950, 1.264911),ncol=4,nrow=3,byrow = TRUE)
K <- Linear(X,coeff = c(.45,.3,.15,.1))
Kmanual <- Linear(Xcoef)
expect_equal(round(K,digits=4),round(Kmanual,digits=4))
})
test_that("Linear kernel throws errors", {
expect_error( Linear(X,coeff = c(.45,.3,.15,.1,0.2)),"should be equal to")
})
# Gaussian RBF kernel
test_that("Gaussian RBF kernel works", {
D <- RBF(X)
D2 <- as.matrix(stats::dist(X,method="euclidean"))
dimnames(D2) <- NULL
expect_equal(sqrt(D),D2)
expect_equal(D,RBF(X,g=0))
K <- RBF(X,g=0.05)
expect_equal(K,exp(-0.05*D))
Kmanual <- matrix(c(1.0000000,0.5769498,0.1737739, 0.5769498,1.0000000,0.1652989,
0.1737739,0.1652989,1.0000000),nrow=3,ncol=3)
expect_equal(round(K,digits=4),round(Kmanual,digits=4))
})
# Laplacian kernel
test_that("Laplace kernel works", {
D <- Laplace(X)
D2 <- matrix(c(0,5,9, 5,0,10,9,10,0),nrow=3,ncol=3)
colnames(D2) <- rownames(D2) <- 1:3
expect_equal(D,D2)
expect_equal(D,Laplace(X,g=0))
K <- Laplace(X,g=0.1)
expect_equal(K,exp(-0.1*D))
Kmanual <- matrix(c( 1.0000000,0.6065307,0.4065697 ,
0.6065307,1.0000000,0.3678794 ,
0.4065697,0.3678794,1.0000000),nrow=3,ncol=3)
# colnames(Kmanual) <- rownames(Kmanual) <- 1:3
expect_equal(round(K,digits=4),round(Kmanual,digits=4),ignore_attr = TRUE)
})
# Frobenius kernel
test_that("Frobenius kernel throws errors", {
DATA <- list(X1=X,X2=matrix( c(1,5,2,4,2,8,1,4),ncol=4,nrow=2),
X3=matrix( c(0,4,2,-1,5,-1,-2,1,7,7,8,3 ),ncol=4,nrow=3))
expect_error(Frobenius(DATA),"should have the same dimensions")
})
test_that("Frobenius kernel works", {
DATA <- list(X1=X,X2=matrix( c(1,5,2,4,2,8,1,4,-2,6,-3,4 ),ncol=4,nrow=3),
X3=matrix( c(0,4,2,-1,5,-1,-2,1,7,7,8,3 ),ncol=4,nrow=3),X4=X)
frob <- Frobenius(DATA,feat_space=TRUE)
Kmanual <- matrix(c(196,131, 81,196, 131,196, 40,131,
81, 40,223, 81, 196,131, 81,196),ncol=4,nrow=4)
fs_manual <- matrix(c( 1, 2 ,-2, 5, 8, 6, 2, 1,-3 , 4 , 4 ,4,
1, 5 , 2, 4, 2, 8, 1, 4,-2 , 6 , -3 ,4,
0, 4 , 2, -1, 5,-1,-2, 1, 7 , 7 , 8 ,3, 1, 2 ,-2, 5, 8, 6,
2, 1,-3 , 4 , 4 ,4),ncol=12,nrow=4,byrow=TRUE)
rownames(fs_manual) <- rownames(Kmanual) <- colnames(Kmanual) <- c("X1","X2","X3","X4")
expect_equal(frob$K,Kmanual)
expect_equal(frob$feat_space,fs_manual)
Knorm <- Frobenius(DATA,cos.norm = TRUE)
expect_equal( Knorm[1,1] , 1)
expect_equal( Knorm[1,1] , Knorm[1,4] )
expect_equal(cosNorm(frob$K),Knorm)
})
# Kernels for count data/compositional data: ruzicka, bray-curtis, clinear, aitchison
Xcount <- matrix(c(3,2,1, 1, 1, 4, 7, 3, 2 , 5,
4,1,5, 3, 4, 2, 3, 6, 1 , 2,
2,5,2, 2, 2, 4, 1, 2, 6 , 1,
2,1,1, 4, 3, 2, 1, 4, 4 , 5,
3,4,6, 1, 2, 2, 4, 0, 2 , 1), nrow=5,byrow = TRUE)
Xcount2 <- Xcount
Xcount2[5,8] <- 0.01
test_that("Kernels for count data work", {
# Computed with: 1-vegan::vegdist(X,method="jaccard",diag=TRUE,upper=TRUE)
Ruzicka_vegan <- matrix(c(1.0000000,0.4285714,0.4358974,0.5135135,0.4594595,
0.4285714,1.0000000,0.3809524,0.5263158,0.5135135,
0.4358974,0.3809524,1.0000000,0.5000000,0.4857143,
0.5135135,0.5263158,0.5000000,1.0000000,0.3333333,
0.4594595,0.5135135,0.4857143,0.3333333,1.0000000),nrow=5)
# Computed with: 1-vegan::vegdist(X,method="bray",diag=TRUE,upper=TRUE)
BC_vegan <- matrix(c(1.0000000,0.6000000,0.6071429,0.6785714,0.6296296,
0.6000000,1.0000000,0.5517241,0.6896552,0.6785714,
0.6071429,0.5517241,1.0000000,0.6666667,0.6538462,
0.6785714,0.6896552,0.6666667,1.0000000,0.5000000,
0.6296296,0.6785714,0.6538462,0.5000000,1.0000000),nrow=5)
expect_equal(round(BrayCurtis(Xcount),digits=4),round(BC_vegan,digits=4),ignore_attr=TRUE)
expect_equal(round(Ruzicka(Xcount),digits=4),round(Ruzicka_vegan,digits=4),ignore_attr=TRUE)
# Computed with: coda.base::clr_c(Xcount2)
Xclr <- matrix(c( 0.2460962,-0.1593690,-0.8525161,-0.8525161,-0.8525161,0.5337782,1.0933940,0.2460962,-0.1593690,0.7569218,
0.4105639,-0.9757305,0.6337074,0.1228818,0.4105639,-0.2825833,0.1228818,0.8160290,-0.9757305,-0.2825833,
-0.1321756,0.7841151,-0.1321756,-0.1321756,-0.1321756,0.5609716,-0.8253228,-0.1321756,0.9664367,-0.8253228,
-0.1321756,-0.8253228,-0.8253228,0.5609716,0.2732895,-0.1321756,-0.8253228,0.5609716,0.5609716,0.7841151,
0.7848891 , 1.0725712 , 1.4780363 ,-0.3137232 ,0.3794240 , 0.3794240 , 1.0725712, -4.9188934, 0.3794240, -0.31372327),
nrow=5,byrow=TRUE)
expect_equal(Linear(Xclr), cLinear(Xcount2),tolerance = 1e-5)
Kclin <- cLinear(Xcount,zeros = "pseudo",feat_space=TRUE)
expect_equal(Kclin$K, cLinear(Xcount2),tolerance = 1e-5)
expect_equal(Kclin$feat_space, Xclr,tolerance = 1e-5)
# Computed with: as.matrix(coda.base::dist(Xcount2,method="aitchison"))
aitdist <- matrix(c(0.000000,3.021475,3.191577,2.931971,6.097981,
3.021475,0.000000,3.303660,2.672600,6.427056,
3.191577,3.303660,0.000000,2.726022,5.564678,
2.931971,2.672600,2.726022,0.000000,6.756900,
6.097981,6.427056,5.564678,6.756900,0.000000),nrow=5)
expect_equal(sqrt(Aitchison(Xcount2,g=NULL)) ,aitdist, tolerance = 1e-5)
expect_equal(Aitchison(Xcount2,g=0.1), exp(-0.1*aitdist^2), tolerance = 1e-5)
})
test_that("Kernels for count data errors", {
X <- matrix(sample(10),nrow=1)
expect_error(BrayCurtis(X),"X should be a matrix or data.frame with at least two rows")
expect_error(cLinear(Xcount,zeros = "none"),"Some instances are equal to zero")
expect_error(Aitchison(-Xcount2),"Data should be strictly nonnegative")
})
# Dirac
test_that("Dirac kernel works", {
K1 <- Dirac(showdata[1:10,5]) ## 1 variable
K1_ma <- matrix(c(1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1),nrow=10,ncol=10)
expect_equal(K1, K1_ma,ignore_attr=TRUE)
expect_equal(K1, Dirac(showdata[1:10,5,drop=FALSE],comp="sum"),ignore_attr=TRUE)
K1_sum <- Dirac(showdata,feat_space = TRUE,comp="sum")
K1_mean <- Dirac(showdata,feat_space = TRUE,comp="mean")
expect_equal(K1_sum$K, Linear(K1_sum$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, Linear(K1_mean$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, cosNorm(K1_sum$K),ignore_attr=TRUE)
absw <- c(1,0.5,0.5,1,1)
relw <- c(1,0.5,0.5,1,1)/sum(c(1,0.5,0.5,1,1))
sqrtw <- sqrt(relw)
K1_w <- Dirac(showdata,feat_space = TRUE,comp="weighted",coeff=absw)
halfvalue_idx <- grep("Favorite.act",colnames(K1_w$feat_space))
val1 <- unique(as.vector(K1_w$feat_space[,-halfvalue_idx]))
val2 <- unique(as.vector(K1_w$feat_space[,halfvalue_idx]))
expect_equal(val1,c(0,0.5))
expect_equal(val2,c(0,sqrt(0.125)))
expect_equal(K1_w$K, Linear(K1_w$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, Dirac(showdata,comp="weighted",coeff=rep(1,5)))
})
test_that("Dirac kernel throws errors", {
expect_error(Dirac(showdata[1,]),"X should be a matrix or data.frame with at least two rows")
expect_error(Dirac(showdata,comp="weighted"),"Please provide weights")
expect_error(Dirac(showdata,comp="weighted",coeff=1:3),
"Number of weights and number of variables do not coincide")
expect_error(Dirac(showdata,comp="asda"),
"Option not available")
})
# Intersect, jaccard
absw <- c(1,0.5,0.5,1,1)
setsdata <- matrix(c( "co" ,"mz" ,"ey" ,"nqw","su" ,
"ao" ,"kps","hky","hm" ,"eg" ,
"asz","ag" ,"mq" ,"hqr","di" ,
"be" ,"bnu","qsy","ilw","ch" ,
"bf" ,"klu","dkl","em" ,"fq" ,
"jt" ,"gy" ,"ery","ghj","fnt",
"hrw","ls" ,"es" ,"bjv","dkp",
"jm" ,"dv" ,"cg" ,"gv" ,"oq" ,
"em" ,"bnw","dmt","vx" ,"aco",
"abr","lr" ,"brv","bip","kw" ),nrow=10,byrow = TRUE)
Ksum_ma <- matrix(c( 11, 2, 1, 2, 0, 2, 1, 0, 0, 0,
2,12, 2, 1, 3, 2, 1, 0, 0, 1,
1, 2,12, 1, 0, 2, 1, 0, 1, 1,
2, 1, 1,13, 2, 1, 1, 0, 4, 2,
0, 3, 0, 2,12, 1, 1, 1, 1, 2,
2, 2, 2, 1, 1,13, 2, 2, 0, 1,
1, 1, 1, 1, 1, 2,13, 1, 1, 4,
0, 0, 0, 0, 1, 2, 1,10, 3, 0,
0, 0, 1, 4, 1, 0, 1, 3,13, 0,
0, 1, 1, 2, 2, 1, 4, 0, 0,13),nrow=10)
test_that("Intersect kernel works", {
Ksum <- Intersect(setsdata,elements=letters,comp="sum",feat_space = TRUE)
expect_equal(Ksum$K, Ksum_ma,ignore_attr=TRUE)
Ksum_fs <- cbind(Ksum$feat_space[,,1],Ksum$feat_space[,,2],Ksum$feat_space[,,3],
Ksum$feat_space[,,4],Ksum$feat_space[,,5])
expect_equal(Ksum$K,Linear(Ksum_fs),ignore_attr=TRUE)
Kmean <- Intersect(setsdata,elements=letters,comp="mean",feat_space = TRUE)
Kmean_fs <- array(0,dim=c(10,10))
for(i in 1:5) Kmean_fs <- Linear(Kmean$feat_space[,,i]) + Kmean_fs
expect_equal(Kmean$K, Kmean_fs,ignore_attr=TRUE)
expect_equal(Kmean$K, Intersect(setsdata,elements=letters,comp="weighted",coeff=rep(1,5)))
relw <- c(1,0.5,0.5,1,1)/sum(c(1,0.5,0.5,1,1))
sqrtw <- sqrt(relw)
Kw <- Intersect(setsdata,elements=letters,feat_space = TRUE,comp="weighted",coeff=absw)
Kw_fs <- array(0,dim=c(10,10))
for(i in 1:5) Kw_fs <- Linear(Kw$feat_space[,,i]) + Kw_fs
expect_equal(Kw$K, Kw_fs,ignore_attr=TRUE)
expect_equal(Kmean$feat_space[,,1]/sqrt(1/5), Kw$feat_space[,,1] /sqrtw[1])
expect_equal(Kmean$feat_space[,,2]/sqrt(1/5), Kw$feat_space[,,2] /sqrtw[2])
})
test_that("Jaccard kernel works", {
Ksum <- Jaccard(setsdata,elements=letters,comp="sum")
Kmean <- Jaccard(setsdata,elements=letters, comp = "mean")
Kw1 <- Jaccard(setsdata,elements=letters,comp="weighted",coeff=rep(1,5))
Kw <- Jaccard(setsdata,elements=letters,comp="weighted",coeff=absw)
expect_equal(rep(5,10), diag(Ksum),ignore_attr=TRUE)
expect_equal(rep(1,10), diag(Kmean),ignore_attr=TRUE)
expect_equal(Kw1, Kmean)
Kw_manual <- matrix(c(1.0000,0.1146,0.0500,0.0813,0.0000,0.0833,0.0417,0.0000, 0.0000,0.0000,
0.1146,1.0000,0.1250,0.0250,0.1333,0.0875,0.0312,0.0000, 0.0000,0.0625,
0.0500,0.1250,1.0000,0.0312,0.0000,0.0917,0.0625,0.0000, 0.0312,0.0500,
0.0813,0.0250,0.0312,1.0000,0.1083,0.0250,0.0312,0.0000, 0.2083,0.1125,
0.0000,0.1333,0.0000,0.1083,1.0000,0.0625,0.0312,0.0833, 0.0250,0.0938,
0.0833,0.0875,0.0917,0.0250,0.0625,1.0000,0.0813,0.1458, 0.0000,0.0250,
0.0417,0.0312,0.0625,0.0312,0.0312,0.0813,1.0000,0.0625, 0.0625,0.2042,
0.0000,0.0000,0.0000,0.0000,0.0833,0.1458,0.0625,1.0000, 0.2292,0.0000,
0.0000,0.0000,0.0312,0.2083,0.0250,0.0000,0.0625,0.2292, 1.0000,0.0000,
0.0000,0.0625,0.0500,0.1125,0.0938,0.0250,0.2042,0.0000, 0.0000,1.0000),nrow=10)
expect_equal(round(Kw,digits=4), Kw_manual,ignore_attr=TRUE)
})
# Spectrum kernel
letters_ <- c(letters,"_")
strings <- c("hello_world","hello_word","hola_mon","kaixo_mundua",
"bonjour_le_monde")
names(strings) <- c("english1","english_typo","catalan","basque","french")
test_that("Spectrum kernel works", {
K_1 <- Spectrum(strings,alphabet=letters_,l=1,feat_space = TRUE)
K_1$feat_space <- desparsify(K_1$feat_space)
fs_1ma <- matrix(c(0,0,1,1,1,0,0,0,3,0,0,2,1,0,1,0, 1,
0,0,1,1,1,0,0,0,2,0,0,2,1,0,1,0, 1,
1,0,0,0,1,0,0,0,1,1,1,2,0,0,0,0, 1,
2,0,1,0,0,1,0,1,0,1,1,1,0,2,0,1, 1,
0,1,1,2,0,0,1,0,1,1,2,3,1,1,0,0, 2),byrow=TRUE,
nrow=5,ncol=17)
colnames(fs_1ma) <- c("a","b","d","e","h","i","j","k","l","m","n","o","r","u",
"w","x","_")
rownames(fs_1ma) <- names(strings)
K_1ma <- matrix(c( 19,16 , 9 , 4, 15, 16,14 , 8 , 4, 14,
9, 8 , 10 , 7, 12, 4, 4 , 7 , 16, 11,
15,14 , 12 , 11, 28),nrow=5,ncol=5)
expect_equal(rowSums(K_1$feat_space),nchar(strings))
expect_equal(K_1$K,K_1ma,ignore_attr = TRUE)
expect_equal(K_1$feat_space, fs_1ma)
expect_equal(K_1$K,Linear(K_1$feat_space),ignore_attr = TRUE)
K_2cos <- Spectrum(strings,alphabet=letters_,l=2,cos.norm = TRUE,feat_space=TRUE)
expect_equal(Linear(K_2cos$feat_space),K_2cos$K)
K_2 <- Spectrum(strings,alphabet=letters_,l=2,feat_space=FALSE)
expect_equal(cosNorm(K_2),K_2cos$K)
expect_contains(class(K_2),"matrix")
expect_type(K_2cos, "list")
contains_pattern <- K_2cos$feat_space[,colSums(K_2cos$feat_space)>0]!=0
expect_identical(contains_pattern["french","mo"],contains_pattern["catalan","mo"])
expect_identical(contains_pattern["french","nd"],contains_pattern["basque","nd"])
expect_identical(contains_pattern["english1","o_"],contains_pattern["basque","o_"])
### weights / group.ids
K_1w <- Spectrum(strings,alphabet=letters_,l=1,group.ids = c(1,1,2,3,4),
weights = c(0.5,0.5,1,1,1),feat_space = TRUE)
K_1w$feat_space <- desparsify(K_1w$feat_space)
expect_equal( K_1w$feat_space[2:4,],K_1$feat_space[3:5,],ignore_attr = TRUE)
expect_equal( K_1w$feat_space[1,],colMeans(K_1$feat_space[1:2,]),ignore_attr = TRUE)
})
test_that("Spectrum kernel throws errors", {
expect_error(Spectrum(strings,alphabet=letters_,l=1,group.ids = c(1,1,2),
weights = c(0.5,0.5,1,1,1)),"Ids length should be the same than x")
expect_error(Spectrum(strings,alphabet=letters_,l=1,weights = c(0.5,0.5,2:5)),
"weights length should be the same than x")
})
# Kendall's tau
color_list <- c("black","blue","green","grey","lightblue","orange","purple",
"red","white","yellow")
survey1 <- 1:10
survey2 <- 10:1
survey3 <- c(10,3,4,7 , 8 , 1, 6, 2, 5 , 9)
color <- cbind(survey1,survey2,survey3) # samples is columns
rownames(color) <- color_list
food <- matrix(c(10, 1,18, 25,30, 7, 5,20, 5, 12, 7,20, 20, 3,22),ncol=5,nrow=3)
rownames(food) <- colnames(color)
colnames(food) <- c("spinach", "chicken", "beef" , "salad","lentils")
test_that("Kendall's tau kernel works", {
K1 <- Kendall(color)
expect_equal(nrow(K1),3)
expect_equal(K1[1,2],-1)
expect_equal(round(K1[1,3],digits = 1),0)
expect_equal( K1[1,3],-K1[2,3])
expect_equal( nrow(Kendall(food)),5)
K2 <- Kendall(food,samples.in.rows=TRUE)
Kmanual <- matrix(c(1.0, 0.2, 0.4, 0.2, 1.0 ,-0.4, 0.4,-0.4, 1.0), nrow=3,ncol=3)
expect_equal(K2,Kmanual,ignore_attr = TRUE)
X <- list(color=color,food=t(food)) #All samples in columns
K <- array(dim=c(3,3,2))
K[,,1] <- K1
K[,,2] <- K2
expect_equal(Kendall(X),MKC(K))
})
test_that("Kendall's tau kernel throws errors", {
expect_error(Kendall(list(color=color,food= food)),
"All list's elements should have the same number of columns")
expect_error(Kendall(list(color=color,food= food),samples.in.rows = TRUE),
"All list's elements should have the same number of rows")
expect_error(Kendall(list(color=color,food= t(food)),comp="hola"),
"Option not available")
})
test_that("Kendall's tau kernel works", {
K1 <- Kendall(color)
expect_equal(nrow(K1),3)
expect_equal(K1[1,2],-1)
expect_equal(round(K1[1,3],digits = 1),0)
expect_equal( K1[1,3],-K1[2,3])
expect_equal( nrow(Kendall(food)),5)
K2 <- Kendall(food,samples.in.rows=TRUE)
Kmanual <- matrix(c(1.0, 0.2, 0.4, 0.2, 1.0 ,-0.4, 0.4,-0.4, 1.0), nrow=3,ncol=3)
expect_equal(K2,Kmanual,ignore_attr = TRUE)
X <- list(color=color,food=t(food)) #All samples in columns
K <- array(dim=c(3,3,2))
K[,,1] <- K1
K[,,2] <- K2
expect_equal(Kendall(X),MKC(K))
})
test_that("Chi-squared kernel works", {
X <- matrix( c(0, 1, 1, 0, .2, .8, .7, .3), nrow=4,byrow=TRUE)
Kchi <- matrix(c(1 , 0.36787944, 0.89483932, 0.58364548,
0.36787944, 1, 0.51341712, 0.83822343,
0.89483932, 0.51341712, 1 , 0.7768366 ,
0.58364548, 0.83822343, 0.7768366 , 1),nrow=4,ncol=4)
LeCam <- matrix(c( 0.0000000,1.0000000,0.3333333,0.7337994,
1.0000000,0.0000000,0.8164966,0.4200840,
0.3333333,0.8164966,0.0000000,0.5025189,
0.7337994,0.4200840,0.5025189,0.0000000),nrow=4,ncol=4)
expect_equal(Chi2(X,g=0.5),Kchi,tolerance = 1e-6,ignore_attr=TRUE)
expect_equal(Chi2(X),LeCam,tolerance = 1e-6,ignore_attr=TRUE)
})
Try the kerntools package in your browser
Any scripts or data that you put into this service are public.
kerntools documentation built on April 3, 2025, 7:52 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
X <- matrix( c(1,5,2,4,2,8,1,4,-2,6,-3,4 ),ncol=4,nrow=3,byrow = TRUE)
# Linear kernel
test_that("Linear kernel works", {
K <- Linear(X)
Kmanual <- matrix( c(46,60,38,60,85,57,38,57,65),ncol=3,nrow=3) ## calculat a mà
expect_equal(K,Kmanual)
## amb cos-normalització
K <- Linear(X,cos.norm = TRUE)
Kmanual <- matrix( c(1.00, 0.96, 0.69, 0.96, 1.00, 0.77, 0.69, 0.77,1.00),
ncol=3,nrow=3)
expect_equal(round(K,digits=2),Kmanual)
## amb coeficients (a mà)
Xcoef <- matrix( c(0.6708204,2.738613, 0.7745967,1.264911,
1.3416408,4.381780, 0.3872983,1.264911,
-1.3416408, 3.286335, -1.1618950, 1.264911),ncol=4,nrow=3,byrow = TRUE)
K <- Linear(X,coeff = c(.45,.3,.15,.1))
Kmanual <- Linear(Xcoef)
expect_equal(round(K,digits=4),round(Kmanual,digits=4))
})
test_that("Linear kernel throws errors", {
expect_error( Linear(X,coeff = c(.45,.3,.15,.1,0.2)),"should be equal to")
})
# Gaussian RBF kernel
test_that("Gaussian RBF kernel works", {
D <- RBF(X)
D2 <- as.matrix(stats::dist(X,method="euclidean"))
dimnames(D2) <- NULL
expect_equal(sqrt(D),D2)
expect_equal(D,RBF(X,g=0))
K <- RBF(X,g=0.05)
expect_equal(K,exp(-0.05*D))
Kmanual <- matrix(c(1.0000000,0.5769498,0.1737739, 0.5769498,1.0000000,0.1652989,
0.1737739,0.1652989,1.0000000),nrow=3,ncol=3)
expect_equal(round(K,digits=4),round(Kmanual,digits=4))
})
# Laplacian kernel
test_that("Laplace kernel works", {
D <- Laplace(X)
D2 <- matrix(c(0,5,9, 5,0,10,9,10,0),nrow=3,ncol=3)
colnames(D2) <- rownames(D2) <- 1:3
expect_equal(D,D2)
expect_equal(D,Laplace(X,g=0))
K <- Laplace(X,g=0.1)
expect_equal(K,exp(-0.1*D))
Kmanual <- matrix(c( 1.0000000,0.6065307,0.4065697 ,
0.6065307,1.0000000,0.3678794 ,
0.4065697,0.3678794,1.0000000),nrow=3,ncol=3)
# colnames(Kmanual) <- rownames(Kmanual) <- 1:3
expect_equal(round(K,digits=4),round(Kmanual,digits=4),ignore_attr = TRUE)
})
# Frobenius kernel
test_that("Frobenius kernel throws errors", {
DATA <- list(X1=X,X2=matrix( c(1,5,2,4,2,8,1,4),ncol=4,nrow=2),
X3=matrix( c(0,4,2,-1,5,-1,-2,1,7,7,8,3 ),ncol=4,nrow=3))
expect_error(Frobenius(DATA),"should have the same dimensions")
})
test_that("Frobenius kernel works", {
DATA <- list(X1=X,X2=matrix( c(1,5,2,4,2,8,1,4,-2,6,-3,4 ),ncol=4,nrow=3),
X3=matrix( c(0,4,2,-1,5,-1,-2,1,7,7,8,3 ),ncol=4,nrow=3),X4=X)
frob <- Frobenius(DATA,feat_space=TRUE)
Kmanual <- matrix(c(196,131, 81,196, 131,196, 40,131,
81, 40,223, 81, 196,131, 81,196),ncol=4,nrow=4)
fs_manual <- matrix(c( 1, 2 ,-2, 5, 8, 6, 2, 1,-3 , 4 , 4 ,4,
1, 5 , 2, 4, 2, 8, 1, 4,-2 , 6 , -3 ,4,
0, 4 , 2, -1, 5,-1,-2, 1, 7 , 7 , 8 ,3, 1, 2 ,-2, 5, 8, 6,
2, 1,-3 , 4 , 4 ,4),ncol=12,nrow=4,byrow=TRUE)
rownames(fs_manual) <- rownames(Kmanual) <- colnames(Kmanual) <- c("X1","X2","X3","X4")
expect_equal(frob$K,Kmanual)
expect_equal(frob$feat_space,fs_manual)
Knorm <- Frobenius(DATA,cos.norm = TRUE)
expect_equal( Knorm[1,1] , 1)
expect_equal( Knorm[1,1] , Knorm[1,4] )
expect_equal(cosNorm(frob$K),Knorm)
})
# Kernels for count data/compositional data: ruzicka, bray-curtis, clinear, aitchison
Xcount <- matrix(c(3,2,1, 1, 1, 4, 7, 3, 2 , 5,
4,1,5, 3, 4, 2, 3, 6, 1 , 2,
2,5,2, 2, 2, 4, 1, 2, 6 , 1,
2,1,1, 4, 3, 2, 1, 4, 4 , 5,
3,4,6, 1, 2, 2, 4, 0, 2 , 1), nrow=5,byrow = TRUE)
Xcount2 <- Xcount
Xcount2[5,8] <- 0.01
test_that("Kernels for count data work", {
# Computed with: 1-vegan::vegdist(X,method="jaccard",diag=TRUE,upper=TRUE)
Ruzicka_vegan <- matrix(c(1.0000000,0.4285714,0.4358974,0.5135135,0.4594595,
0.4285714,1.0000000,0.3809524,0.5263158,0.5135135,
0.4358974,0.3809524,1.0000000,0.5000000,0.4857143,
0.5135135,0.5263158,0.5000000,1.0000000,0.3333333,
0.4594595,0.5135135,0.4857143,0.3333333,1.0000000),nrow=5)
# Computed with: 1-vegan::vegdist(X,method="bray",diag=TRUE,upper=TRUE)
BC_vegan <- matrix(c(1.0000000,0.6000000,0.6071429,0.6785714,0.6296296,
0.6000000,1.0000000,0.5517241,0.6896552,0.6785714,
0.6071429,0.5517241,1.0000000,0.6666667,0.6538462,
0.6785714,0.6896552,0.6666667,1.0000000,0.5000000,
0.6296296,0.6785714,0.6538462,0.5000000,1.0000000),nrow=5)
expect_equal(round(BrayCurtis(Xcount),digits=4),round(BC_vegan,digits=4),ignore_attr=TRUE)
expect_equal(round(Ruzicka(Xcount),digits=4),round(Ruzicka_vegan,digits=4),ignore_attr=TRUE)
# Computed with: coda.base::clr_c(Xcount2)
Xclr <- matrix(c( 0.2460962,-0.1593690,-0.8525161,-0.8525161,-0.8525161,0.5337782,1.0933940,0.2460962,-0.1593690,0.7569218,
0.4105639,-0.9757305,0.6337074,0.1228818,0.4105639,-0.2825833,0.1228818,0.8160290,-0.9757305,-0.2825833,
-0.1321756,0.7841151,-0.1321756,-0.1321756,-0.1321756,0.5609716,-0.8253228,-0.1321756,0.9664367,-0.8253228,
-0.1321756,-0.8253228,-0.8253228,0.5609716,0.2732895,-0.1321756,-0.8253228,0.5609716,0.5609716,0.7841151,
0.7848891 , 1.0725712 , 1.4780363 ,-0.3137232 ,0.3794240 , 0.3794240 , 1.0725712, -4.9188934, 0.3794240, -0.31372327),
nrow=5,byrow=TRUE)
expect_equal(Linear(Xclr), cLinear(Xcount2),tolerance = 1e-5)
Kclin <- cLinear(Xcount,zeros = "pseudo",feat_space=TRUE)
expect_equal(Kclin$K, cLinear(Xcount2),tolerance = 1e-5)
expect_equal(Kclin$feat_space, Xclr,tolerance = 1e-5)
# Computed with: as.matrix(coda.base::dist(Xcount2,method="aitchison"))
aitdist <- matrix(c(0.000000,3.021475,3.191577,2.931971,6.097981,
3.021475,0.000000,3.303660,2.672600,6.427056,
3.191577,3.303660,0.000000,2.726022,5.564678,
2.931971,2.672600,2.726022,0.000000,6.756900,
6.097981,6.427056,5.564678,6.756900,0.000000),nrow=5)
expect_equal(sqrt(Aitchison(Xcount2,g=NULL)) ,aitdist, tolerance = 1e-5)
expect_equal(Aitchison(Xcount2,g=0.1), exp(-0.1*aitdist^2), tolerance = 1e-5)
})
test_that("Kernels for count data errors", {
X <- matrix(sample(10),nrow=1)
expect_error(BrayCurtis(X),"X should be a matrix or data.frame with at least two rows")
expect_error(cLinear(Xcount,zeros = "none"),"Some instances are equal to zero")
expect_error(Aitchison(-Xcount2),"Data should be strictly nonnegative")
})
# Dirac
test_that("Dirac kernel works", {
K1 <- Dirac(showdata[1:10,5]) ## 1 variable
K1_ma <- matrix(c(1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1,
0,1,0,1,0,1,1,0,0,1,
1,0,1,0,1,0,0,1,1,0,
1,0,1,0,1,0,0,1,1,0,
0,1,0,1,0,1,1,0,0,1),nrow=10,ncol=10)
expect_equal(K1, K1_ma,ignore_attr=TRUE)
expect_equal(K1, Dirac(showdata[1:10,5,drop=FALSE],comp="sum"),ignore_attr=TRUE)
K1_sum <- Dirac(showdata,feat_space = TRUE,comp="sum")
K1_mean <- Dirac(showdata,feat_space = TRUE,comp="mean")
expect_equal(K1_sum$K, Linear(K1_sum$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, Linear(K1_mean$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, cosNorm(K1_sum$K),ignore_attr=TRUE)
absw <- c(1,0.5,0.5,1,1)
relw <- c(1,0.5,0.5,1,1)/sum(c(1,0.5,0.5,1,1))
sqrtw <- sqrt(relw)
K1_w <- Dirac(showdata,feat_space = TRUE,comp="weighted",coeff=absw)
halfvalue_idx <- grep("Favorite.act",colnames(K1_w$feat_space))
val1 <- unique(as.vector(K1_w$feat_space[,-halfvalue_idx]))
val2 <- unique(as.vector(K1_w$feat_space[,halfvalue_idx]))
expect_equal(val1,c(0,0.5))
expect_equal(val2,c(0,sqrt(0.125)))
expect_equal(K1_w$K, Linear(K1_w$feat_space),ignore_attr=TRUE)
expect_equal(K1_mean$K, Dirac(showdata,comp="weighted",coeff=rep(1,5)))
})
test_that("Dirac kernel throws errors", {
expect_error(Dirac(showdata[1,]),"X should be a matrix or data.frame with at least two rows")
expect_error(Dirac(showdata,comp="weighted"),"Please provide weights")
expect_error(Dirac(showdata,comp="weighted",coeff=1:3),
"Number of weights and number of variables do not coincide")
expect_error(Dirac(showdata,comp="asda"),
"Option not available")
})
# Intersect, jaccard
absw <- c(1,0.5,0.5,1,1)
setsdata <- matrix(c( "co" ,"mz" ,"ey" ,"nqw","su" ,
"ao" ,"kps","hky","hm" ,"eg" ,
"asz","ag" ,"mq" ,"hqr","di" ,
"be" ,"bnu","qsy","ilw","ch" ,
"bf" ,"klu","dkl","em" ,"fq" ,
"jt" ,"gy" ,"ery","ghj","fnt",
"hrw","ls" ,"es" ,"bjv","dkp",
"jm" ,"dv" ,"cg" ,"gv" ,"oq" ,
"em" ,"bnw","dmt","vx" ,"aco",
"abr","lr" ,"brv","bip","kw" ),nrow=10,byrow = TRUE)
Ksum_ma <- matrix(c( 11, 2, 1, 2, 0, 2, 1, 0, 0, 0,
2,12, 2, 1, 3, 2, 1, 0, 0, 1,
1, 2,12, 1, 0, 2, 1, 0, 1, 1,
2, 1, 1,13, 2, 1, 1, 0, 4, 2,
0, 3, 0, 2,12, 1, 1, 1, 1, 2,
2, 2, 2, 1, 1,13, 2, 2, 0, 1,
1, 1, 1, 1, 1, 2,13, 1, 1, 4,
0, 0, 0, 0, 1, 2, 1,10, 3, 0,
0, 0, 1, 4, 1, 0, 1, 3,13, 0,
0, 1, 1, 2, 2, 1, 4, 0, 0,13),nrow=10)
test_that("Intersect kernel works", {
Ksum <- Intersect(setsdata,elements=letters,comp="sum",feat_space = TRUE)
expect_equal(Ksum$K, Ksum_ma,ignore_attr=TRUE)
Ksum_fs <- cbind(Ksum$feat_space[,,1],Ksum$feat_space[,,2],Ksum$feat_space[,,3],
Ksum$feat_space[,,4],Ksum$feat_space[,,5])
expect_equal(Ksum$K,Linear(Ksum_fs),ignore_attr=TRUE)
Kmean <- Intersect(setsdata,elements=letters,comp="mean",feat_space = TRUE)
Kmean_fs <- array(0,dim=c(10,10))
for(i in 1:5) Kmean_fs <- Linear(Kmean$feat_space[,,i]) + Kmean_fs
expect_equal(Kmean$K, Kmean_fs,ignore_attr=TRUE)
expect_equal(Kmean$K, Intersect(setsdata,elements=letters,comp="weighted",coeff=rep(1,5)))
relw <- c(1,0.5,0.5,1,1)/sum(c(1,0.5,0.5,1,1))
sqrtw <- sqrt(relw)
Kw <- Intersect(setsdata,elements=letters,feat_space = TRUE,comp="weighted",coeff=absw)
Kw_fs <- array(0,dim=c(10,10))
for(i in 1:5) Kw_fs <- Linear(Kw$feat_space[,,i]) + Kw_fs
expect_equal(Kw$K, Kw_fs,ignore_attr=TRUE)
expect_equal(Kmean$feat_space[,,1]/sqrt(1/5), Kw$feat_space[,,1] /sqrtw[1])
expect_equal(Kmean$feat_space[,,2]/sqrt(1/5), Kw$feat_space[,,2] /sqrtw[2])
})
test_that("Jaccard kernel works", {
Ksum <- Jaccard(setsdata,elements=letters,comp="sum")
Kmean <- Jaccard(setsdata,elements=letters, comp = "mean")
Kw1 <- Jaccard(setsdata,elements=letters,comp="weighted",coeff=rep(1,5))
Kw <- Jaccard(setsdata,elements=letters,comp="weighted",coeff=absw)
expect_equal(rep(5,10), diag(Ksum),ignore_attr=TRUE)
expect_equal(rep(1,10), diag(Kmean),ignore_attr=TRUE)
expect_equal(Kw1, Kmean)
Kw_manual <- matrix(c(1.0000,0.1146,0.0500,0.0813,0.0000,0.0833,0.0417,0.0000, 0.0000,0.0000,
0.1146,1.0000,0.1250,0.0250,0.1333,0.0875,0.0312,0.0000, 0.0000,0.0625,
0.0500,0.1250,1.0000,0.0312,0.0000,0.0917,0.0625,0.0000, 0.0312,0.0500,
0.0813,0.0250,0.0312,1.0000,0.1083,0.0250,0.0312,0.0000, 0.2083,0.1125,
0.0000,0.1333,0.0000,0.1083,1.0000,0.0625,0.0312,0.0833, 0.0250,0.0938,
0.0833,0.0875,0.0917,0.0250,0.0625,1.0000,0.0813,0.1458, 0.0000,0.0250,
0.0417,0.0312,0.0625,0.0312,0.0312,0.0813,1.0000,0.0625, 0.0625,0.2042,
0.0000,0.0000,0.0000,0.0000,0.0833,0.1458,0.0625,1.0000, 0.2292,0.0000,
0.0000,0.0000,0.0312,0.2083,0.0250,0.0000,0.0625,0.2292, 1.0000,0.0000,
0.0000,0.0625,0.0500,0.1125,0.0938,0.0250,0.2042,0.0000, 0.0000,1.0000),nrow=10)
expect_equal(round(Kw,digits=4), Kw_manual,ignore_attr=TRUE)
})
# Spectrum kernel
letters_ <- c(letters,"_")
strings <- c("hello_world","hello_word","hola_mon","kaixo_mundua",
"bonjour_le_monde")
names(strings) <- c("english1","english_typo","catalan","basque","french")
test_that("Spectrum kernel works", {
K_1 <- Spectrum(strings,alphabet=letters_,l=1,feat_space = TRUE)
K_1$feat_space <- desparsify(K_1$feat_space)
fs_1ma <- matrix(c(0,0,1,1,1,0,0,0,3,0,0,2,1,0,1,0, 1,
0,0,1,1,1,0,0,0,2,0,0,2,1,0,1,0, 1,
1,0,0,0,1,0,0,0,1,1,1,2,0,0,0,0, 1,
2,0,1,0,0,1,0,1,0,1,1,1,0,2,0,1, 1,
0,1,1,2,0,0,1,0,1,1,2,3,1,1,0,0, 2),byrow=TRUE,
nrow=5,ncol=17)
colnames(fs_1ma) <- c("a","b","d","e","h","i","j","k","l","m","n","o","r","u",
"w","x","_")
rownames(fs_1ma) <- names(strings)
K_1ma <- matrix(c( 19,16 , 9 , 4, 15, 16,14 , 8 , 4, 14,
9, 8 , 10 , 7, 12, 4, 4 , 7 , 16, 11,
15,14 , 12 , 11, 28),nrow=5,ncol=5)
expect_equal(rowSums(K_1$feat_space),nchar(strings))
expect_equal(K_1$K,K_1ma,ignore_attr = TRUE)
expect_equal(K_1$feat_space, fs_1ma)
expect_equal(K_1$K,Linear(K_1$feat_space),ignore_attr = TRUE)
K_2cos <- Spectrum(strings,alphabet=letters_,l=2,cos.norm = TRUE,feat_space=TRUE)
expect_equal(Linear(K_2cos$feat_space),K_2cos$K)
K_2 <- Spectrum(strings,alphabet=letters_,l=2,feat_space=FALSE)
expect_equal(cosNorm(K_2),K_2cos$K)
expect_contains(class(K_2),"matrix")
expect_type(K_2cos, "list")
contains_pattern <- K_2cos$feat_space[,colSums(K_2cos$feat_space)>0]!=0
expect_identical(contains_pattern["french","mo"],contains_pattern["catalan","mo"])
expect_identical(contains_pattern["french","nd"],contains_pattern["basque","nd"])
expect_identical(contains_pattern["english1","o_"],contains_pattern["basque","o_"])
### weights / group.ids
K_1w <- Spectrum(strings,alphabet=letters_,l=1,group.ids = c(1,1,2,3,4),
weights = c(0.5,0.5,1,1,1),feat_space = TRUE)
K_1w$feat_space <- desparsify(K_1w$feat_space)
expect_equal( K_1w$feat_space[2:4,],K_1$feat_space[3:5,],ignore_attr = TRUE)
expect_equal( K_1w$feat_space[1,],colMeans(K_1$feat_space[1:2,]),ignore_attr = TRUE)
})
test_that("Spectrum kernel throws errors", {
expect_error(Spectrum(strings,alphabet=letters_,l=1,group.ids = c(1,1,2),
weights = c(0.5,0.5,1,1,1)),"Ids length should be the same than x")
expect_error(Spectrum(strings,alphabet=letters_,l=1,weights = c(0.5,0.5,2:5)),
"weights length should be the same than x")
})
# Kendall's tau
color_list <- c("black","blue","green","grey","lightblue","orange","purple",
"red","white","yellow")
survey1 <- 1:10
survey2 <- 10:1
survey3 <- c(10,3,4,7 , 8 , 1, 6, 2, 5 , 9)
color <- cbind(survey1,survey2,survey3) # samples is columns
rownames(color) <- color_list
food <- matrix(c(10, 1,18, 25,30, 7, 5,20, 5, 12, 7,20, 20, 3,22),ncol=5,nrow=3)
rownames(food) <- colnames(color)
colnames(food) <- c("spinach", "chicken", "beef" , "salad","lentils")
test_that("Kendall's tau kernel works", {
K1 <- Kendall(color)
expect_equal(nrow(K1),3)
expect_equal(K1[1,2],-1)
expect_equal(round(K1[1,3],digits = 1),0)
expect_equal( K1[1,3],-K1[2,3])
expect_equal( nrow(Kendall(food)),5)
K2 <- Kendall(food,samples.in.rows=TRUE)
Kmanual <- matrix(c(1.0, 0.2, 0.4, 0.2, 1.0 ,-0.4, 0.4,-0.4, 1.0), nrow=3,ncol=3)
expect_equal(K2,Kmanual,ignore_attr = TRUE)
X <- list(color=color,food=t(food)) #All samples in columns
K <- array(dim=c(3,3,2))
K[,,1] <- K1
K[,,2] <- K2
expect_equal(Kendall(X),MKC(K))
})
test_that("Kendall's tau kernel throws errors", {
expect_error(Kendall(list(color=color,food= food)),
"All list's elements should have the same number of columns")
expect_error(Kendall(list(color=color,food= food),samples.in.rows = TRUE),
"All list's elements should have the same number of rows")
expect_error(Kendall(list(color=color,food= t(food)),comp="hola"),
"Option not available")
})
test_that("Kendall's tau kernel works", {
K1 <- Kendall(color)
expect_equal(nrow(K1),3)
expect_equal(K1[1,2],-1)
expect_equal(round(K1[1,3],digits = 1),0)
expect_equal( K1[1,3],-K1[2,3])
expect_equal( nrow(Kendall(food)),5)
K2 <- Kendall(food,samples.in.rows=TRUE)
Kmanual <- matrix(c(1.0, 0.2, 0.4, 0.2, 1.0 ,-0.4, 0.4,-0.4, 1.0), nrow=3,ncol=3)
expect_equal(K2,Kmanual,ignore_attr = TRUE)
X <- list(color=color,food=t(food)) #All samples in columns
K <- array(dim=c(3,3,2))
K[,,1] <- K1
K[,,2] <- K2
expect_equal(Kendall(X),MKC(K))
})
test_that("Chi-squared kernel works", {
X <- matrix( c(0, 1, 1, 0, .2, .8, .7, .3), nrow=4,byrow=TRUE)
Kchi <- matrix(c(1 , 0.36787944, 0.89483932, 0.58364548,
0.36787944, 1, 0.51341712, 0.83822343,
0.89483932, 0.51341712, 1 , 0.7768366 ,
0.58364548, 0.83822343, 0.7768366 , 1),nrow=4,ncol=4)
LeCam <- matrix(c( 0.0000000,1.0000000,0.3333333,0.7337994,
1.0000000,0.0000000,0.8164966,0.4200840,
0.3333333,0.8164966,0.0000000,0.5025189,
0.7337994,0.4200840,0.5025189,0.0000000),nrow=4,ncol=4)
expect_equal(Chi2(X,g=0.5),Kchi,tolerance = 1e-6,ignore_attr=TRUE)
expect_equal(Chi2(X),LeCam,tolerance = 1e-6,ignore_attr=TRUE)
})
Try the kerntools package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.