/fingerprint/inst/unitTests/runit.fp.R

  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}