/fingerprint/inst/unitTests/runit.fp.R
R | 240 lines | 211 code | 23 blank | 6 comment | 12 complexity | c7b11a520d31f1e0a0a38ccaee75b0f1 MD5 | raw file
1test.new.fp <- function() 2{ 3 fp <- new("fingerprint", bits=c(1,2,3,4), nbit=8, provider='rg',name='foo') 4 checkTrue(!is.null(fp)) 5} 6 7test.distance1 <- function() { 8 fp1 <- new("fingerprint", 9 bits=c(1,2,3,4), nbit=8) 10 fp2 <- new("fingerprint", 11 bits=c(5,6,7,8), nbit=8) 12 d <- distance(fp1,fp2) 13 checkEquals(d, 0) 14} 15 16test.distance2 <- function() { 17 fp1 <- new("fingerprint", 18 bits=c(1,2,3,4), nbit=8) 19 fp2 <- new("fingerprint", 20 bits=c(1,2,3,4), nbit=8) 21 d <- distance(fp1,fp2) 22 checkEquals(d, 1) 23} 24 25test.and1 <- function() { 26 fp1 <- new("fingerprint", 27 bits=c(1,2,3,4), nbit=8) 28 fp2 <- new("fingerprint", 29 bits=c(1,2,3,4), nbit=8) 30 fpnew <- fp1 & fp2 31 bits <- fpnew@bits 32 checkTrue( all(bits == c(1,2,3,4))) 33} 34test.and2 <- function() { 35 fp1 <- new("fingerprint", 36 bits=c(1,2,3,4), nbit=8) 37 fp2 <- new("fingerprint", 38 bits=c(5,6,7,8), nbit=8) 39 fpnew <- fp1 & fp2 40 bits <- fpnew@bits 41 checkEquals(length(bits),0) 42} 43 44test.or1 <- function() { 45 fp1 <- new("fingerprint", 46 bits=c(1,2,3,4), nbit=8) 47 fp2 <- new("fingerprint", 48 bits=c(5,6,7,8), nbit=8) 49 fpnew <- fp1 | fp2 50 bits <- fpnew@bits 51 checkTrue(all(bits == c(1,2,3,4,5,6,7,8))) 52} 53test.or2 <- function() { 54 fp1 <- new("fingerprint", 55 bits=c(1,2,3,4), nbit=8) 56 fp2 <- new("fingerprint", 57 bits=c(1,2,3,4), nbit=8) 58 fpnew <- fp1 | fp2 59 bits <- fpnew@bits 60 checkTrue(all(bits == c(1,2,3,4))) 61} 62 63test.not <- function() { 64 fp1 <- new("fingerprint", 65 bits=c(1,2,3,4), nbit=8) 66 nfp1 <- !fp1 67 checkTrue(all(nfp1@bits == c(5,6,7,8))) 68 checkTrue(all(fp1@bits == (!nfp1)@bits)) 69} 70 71test.xor1 <- function() { 72 fp1 <- new("fingerprint", 73 bits=c(1,2,3,4), nbit=8) 74 fp2 <- new("fingerprint", 75 bits=c(1,2,3,4), nbit=8) 76 fpnew <- xor(fp1,fp2) 77 bits <- fpnew@bits 78 checkEquals(length(bits),0) 79} 80test.xor2 <- function() { 81 fp1 <- new("fingerprint", 82 bits=c(1,2,3,4), nbit=8) 83 fp2 <- new("fingerprint", 84 bits=c(5,6,7,8), nbit=8) 85 fpnew <- xor(fp1,fp2) 86 bits <- fpnew@bits 87 checkEquals(length(bits),8) 88 checkTrue(all(bits == c(1,2,3,4,5,6,7,8))) 89} 90 91test.fold1 <- function() { 92 fp1 <- new("fingerprint", 93 bits=c(1,2,3,4), nbit=8) 94 nfp <- fold(fp1) 95 checkTrue(all(nfp@bits == c(1,2,3,4))) 96} 97 98test.fold2 <- function() { 99 fp1 <- new("fingerprint", 100 bits=c(1,2,3,4,8), nbit=8) 101 nfp <- fold(fp1) 102 checkTrue(all(nfp@bits == c(1,2,3,4))) 103} 104 105test.fp.to.matrix <- function() { 106 fp1 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 107 fp2 <- new("fingerprint", bits=c(5,6,7,8), nbit=8) 108 fp3 <- new("fingerprint", bits=c(1,2,3,5,6,7,8), nbit=8) 109 m1 <- fp.to.matrix(list(fp1,fp2,fp3)) 110 m2 <- rbind(c(1,1,1,1,0,0,0,0), 111 c(0,0,0,0,1,1,1,1), 112 c(1,1,1,0,1,1,1,1)) 113 checkTrue(all(m1 == m2)) 114} 115 116test.tversky.1 <- function() { 117 fp1 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 118 fp2 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 119 s <- distance(fp1, fp2, "tversky", a=1,b=1) 120 checkEquals(1.0, s) 121} 122test.tversky.2 <- function() { 123 fp1 <- new("fingerprint", bits=c(5,6,7,8), nbit=8) 124 fp2 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 125 s <- distance(fp1, fp2, "tversky", a=1,b=1) 126 checkEquals(0.0, s) 127} 128test.tversky.3 <- function() { 129 fp1 <- new("fingerprint", bits=c(4,6,7,8), nbit=8) 130 fp2 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 131 stv <- distance(fp1, fp2, "tversky", a=1,b=1) 132 sta <- distance(fp1, fp2) 133 checkEquals(stv, sta) 134} 135test.tversky.4 <- function() { 136 fp1 <- new("fingerprint", bits=c(4,6,7,8), nbit=8) 137 fp2 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 138 stv <- distance(fp1, fp2, "tversky", a=0.5,b=0.5) 139 std <- distance(fp1, fp2, "dice") 140 checkEquals(stv, std) 141} 142 143test.fp.sim.matrix <- function() { 144 fp1 <- new("fingerprint", bits=c(1,2,3,4), nbit=8) 145 fp2 <- new("fingerprint", bits=c(5,6,7,8), nbit=8) 146 fp3 <- new("fingerprint", bits=c(1,2,3,5,6,7,8), nbit=8) 147 fpl <- list(fp1,fp2,fp3) 148 sm <- round(fp.sim.matrix(fpl),2) 149 am <- rbind(c(1,0,0.38), 150 c(0,1,0.57), 151 c(0.38,0.57,1)) 152 checkTrue(all(sm == am)) 153} 154 155test.fp.balance <- function() { 156 fp1 <- new("fingerprint", bits=c(1,2,3), nbit=6) 157 fp2 <- balance(fp1) 158 checkTrue(12 == length(fp2)) 159 checkEquals(c(1,2,3,10,11,12), fp2@bits) 160} 161 162test.fps.reader <- function() { 163 data.file <- file.path(system.file("unitTests", "bits.fps", package="fingerprint")) 164 fps <- fp.read(data.file, lf=fps.lf) 165 checkEquals(323, length(fps)) 166 167 ## OK, we need to pull in the bit positions Andrew specified 168 for (i in seq_along(fps)) { 169 expected <- sort(as.numeric(strsplit(fps[[i]]@misc[[1]],",")[[1]])+1) 170 observed <- sort(fps[[i]]@bits) 171 checkEquals(expected, observed, msg = sprintf("%s had a mismatch in bit positions", fps[[i]]@name)) 172 } 173} 174 175####################################### 176## 177## Feature vector tests 178## 179####################################### 180test.feature <- function() { 181 f1 <- new('feature', feature='F1') 182 checkEquals(1, f1@count) 183 184 f2 <- new('feature', feature='F2', count=as.integer(12)) 185 checkEquals(12, f2@count) 186} 187 188test.feature.c <- function() { 189 f1 <- new('feature', feature='F1', count=as.integer(2)) 190 f2 <- new('feature', feature='F2', count=as.integer(3)) 191 fl <- c(f1, f2) 192 checkEquals(2, length(fl)) 193 checkEquals("list", class(fl)) 194 checkTrue(identical(f1, fl[[1]])) 195 checkTrue(identical(f2, fl[[2]])) 196} 197 198test.feature.fp <- function() { 199 feats <- sapply(letters[1:10], function(x) new('feature', feature=x, count=as.integer(1))) 200 fv <- new('featvec', features=feats) 201 checkEquals(10, length(fv)) 202} 203 204test.feature.dist1 <- function() { 205 f1 <- sapply(letters[1:10], function(x) new('feature', feature=x, count=as.integer(1))) 206 f2 <- sapply(letters[1:10], function(x) new('feature', feature=x, count=as.integer(1))) 207 fv1 <- new('featvec', features=f1) 208 fv2 <- new('featvec', features=f2) 209 d <- distance(fv1, fv2, method='tanimoto') 210 checkEquals(1, d) 211} 212test.feature.dist2 <- function() { 213 f1 <- sapply(letters[1:10], function(x) new('feature', feature=x, count=as.integer(1))) 214 f2 <- sapply(letters[11:20], function(x) new('feature', feature=x, count=as.integer(1))) 215 fv1 <- new('featvec', features=f1) 216 fv2 <- new('featvec', features=f2) 217 d <- distance(fv1, fv2, method='tanimoto') 218 checkEquals(0, d) 219} 220 221test.featvec.read <- function() { 222 data.file <- file.path(system.file("unitTests", "test.ecfp", package="fingerprint")) 223 fps <- fp.read(data.file, lf=ecfp.lf, binary=FALSE) 224 checkEquals(10, length(fps)) 225 226 lengths <- c(58L, 38L, 43L, 66L, 62L, 66L, 65L, 44L, 66L, 61L) 227 ol <- sapply(fps, length) 228 checkTrue(identical(lengths, ol)) 229} 230 231tester.getters.setters <- function() { 232 f <- new("feature", feature='ABCD', count=as.integer(1)) 233 checkEquals("ABCD", feature(f)) 234 checkEquals(1, count(f)) 235 236 feature(f) <- 'UXYZ' 237 count(f) <- 10 238 checkEquals("UXYZ", feature(f)) 239 checkEquals(10, count(f)) 240}