/fingerprint/R/matrix.R

 1fp.sim.matrix <- function(fplist, fplist2=NULL, method='tanimoto') {
 2
 3  sim <- NA
 4  
 5  if (!is.null(fplist2)) {
 6    sim <- do.call('rbind', lapply(fplist, function(fp) unlist(lapply(fplist2, function(x) distance(x,fp)))))
 7  }
 8
 9  if (method == 'dice') {
10    sim <- .dice.sim.mat(fplist)
11  } else if (method == 'tanimoto') {
12    sim <- .tanimoto.sim.mat(fplist)
13  } else {
14    sim <- matrix(0,nrow=length(fplist), ncol=length(fplist))
15    for (i in 1:(length(fplist)-1)) {
16      v <- unlist(lapply( fplist[(i+1):length(fplist)], distance, fp2=fplist[[i]], method=method))
17      sim[i,(i+1):length(fplist)] <- v
18      sim[(i+1):length(fplist),i] <- v
19    }
20  }
21  diag(sim) <- 1.0
22  return(sim)
23}
24
25## Takes the fingerprints, P bits,  for a set of N molecules supplied as
26## a list structure and creates an N x P matrix
27fp.to.matrix <- function( fplist ) {
28  size <- fplist[[1]]@nbit
29  m <- matrix(0, nrow=length(fplist), ncol=size)
30  cnt <- 1
31  for ( i in fplist ) {
32    m[cnt,i@bits] <- 1
33    cnt <- cnt + 1
34  }
35  m
36}
37
38fp.factor.matrix <- function( fplist ) {
39  size <- fplist[[1]]@nbit
40  m <- data.frame(fp.to.matrix(fplist))
41  m[] <- lapply(m, factor, levels=0:1)
42  m
43}
44
45.dice.sim.mat <- function(fplist) {
46  m <- fp.to.matrix(fplist)
47  mat<-m%*%t(m)
48  len<-length(m[,1])
49  s<-mat.or.vec(len,len)
50  rs<-rowSums(m) #since its is binary just add the row values.
51
52  for (i in 1:(len-1)) {
53    for (j in (i+1):len) {
54      s[i,j]=(2*(mat[i,j])/(rs[i]+rs[j]))
55      s[j,i]=s[i,j]
56    }
57  }
58  diag(s) <- 1.0  
59  return(s)
60}
61
62.tanimoto.sim.mat <- function(fplist){
63  m <- fp.to.matrix(fplist)
64  mat<-m%*%t(m)
65  len<-length(m[,1])
66  s<-mat.or.vec(len,len)
67  
68  ret <-  .C("m_tanimoto", as.double(mat), as.integer(len), as.double(s),
69             PACKAGE="fingerprint")
70  ret <- matrix(ret[[3]], nrow=len, ncol=len, byrow=TRUE)
71  return(ret)
72  
73  ## for (i in 1:len){
74  ##   for (j in 1:len){
75  ##     s[i,j]<- mat[i,j]/(mat[i,i]+mat[j,j]-mat[i,j]) # Formula for Tanimoto Calculation
76  ##   }
77  ## }
78  ## return(s)
79}