PageRenderTime 78ms CodeModel.GetById 2ms RepoModel.GetById 8ms app.codeStats 0ms

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

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