PageRenderTime 203ms CodeModel.GetById 80ms app.highlight 3ms RepoModel.GetById 118ms app.codeStats 0ms

/fingerprint/R/featurefp.R

http://github.com/rajarshi/cdkr
R | 50 lines | 31 code | 3 blank | 16 comment | 5 complexity | c4e0d4b459b8de6a1a982b6cc873d964 MD5 | raw file
 1## A feature fingerprint will be a vector of feature objects
 2setClass("featvec",
 3         representation(features="list",
 4                        provider="character",
 5                        name="character",
 6                        misc="list"),
 7         validity=function(object) {
 8           ## features must be a list of feature objects
 9           klasses <- unique(sapply(object@features, class))
10           if (length(klasses) != 1 || klasses != 'feature')
11             return("Must supply a list of 'feature' objects")
12           iss4s <- sapply(object@features, isS4)
13           if (!all(iss4s))
14             return("Must supply a list of 'feature' objects")
15           return(TRUE)
16         },
17         prototype(features=list(),
18                   provider="",
19                   name="",
20                   misc=list()))
21
22setMethod('show', 'featvec',
23          function(object) {
24            cat("Feature fingerprint\n")
25            cat(" name = ", object@name, "\n")
26            cat(" source = ", object@provider, "\n")
27            cat(" features = ", paste(sapply(object@features, as.character), collapse=' '), "\n")
28          })
29setMethod('as.character', 'featvec', function(x) {
30  return(paste(sapply(x@features, as.character), collapse=' '))
31})
32setMethod("length", "featvec", function(x) {
33  length(x@features)
34})
35
36## featvec.to.binaryfp <- function(fps, bit.length = 256) {
37##   if (!all(sapply(fps, class) == 'featvec'))
38##     stop("Must supply a list of feature vector fingerprints")
39##   ## get all the features
40##   features <- sort(unique(unlist(lapply(fps, as.numeric))))
41##   nbit <- length(features)
42##   if (nbit %% 2 == 1) nbit <- nbit + 1
43##   ## based on the entire feature set, convert original fps to binary fps
44##   fps <- lapply(fps, function(x) {
45##     bitpos <- match(as.numeric(x), features)
46##     new("fingerprint", nbit=nbit, folded=FALSE, provider=x@provider,name=x@name, bits=bitpos)
47##   })
48##   return(fps)
49## }
50