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)
|