File: Vptree-class.R

package info (click to toggle)
r-bioc-biocneighbors 1.8.2%2Bds-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 852 kB
  • sloc: cpp: 2,573; ansic: 248; sh: 13; makefile: 2
file content (53 lines) | stat: -rw-r--r-- 1,407 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
##################################
###### VptreeParam methods #######
##################################

#' @export
#' @importFrom methods new
VptreeParam <- function(distance="Euclidean") {
    new("VptreeParam", distance=distance)
}

setMethod("spill_args", "VptreeParam", function(x) {
    list(distance=bndistance(x))
})

##################################
###### VptreeIndex methods #######
##################################

#' @export
#' @importFrom methods new
VptreeIndex <- function(data, nodes, order, NAMES=NULL, distance="Euclidean") {
    new("VptreeIndex", data=data, nodes=nodes, order=order, NAMES=NAMES, distance=distance)
}

#' @importFrom S4Vectors setValidity2
setValidity2("VptreeIndex", function(object) {
    msg <- character(0)

    data <- bndata(object)
    order <- bnorder(object)
    if (length(order)!=ncol(data)) {
        msg <- c(msg, "number of observations is not consistent between 'data' and 'order'")
    }

    node.len <- lengths(VptreeIndex_nodes(object))
    if (length(node.len)!=4) {
        msg <- c(msg, "node information should contain 4 vectors")
    }
    if (length(unique(node.len))!=1) {
        msg <- c(msg, "node information vectors should have same length")
    }

    if (length(msg)) return(msg)
    return(TRUE)
})

#' @export
VptreeIndex_nodes <- function(x) {
    x@nodes
}

#' @export
setMethod("bnorder", "VptreeIndex", function(x) x@order)