将点误差信息纳入距离函数-如何在R中做到这一点？

Question

I have been working with the proxy package in R to implement a distance measure that weights Euclidean distance by the propagated errors of each individual point. The formula to do this is

sqrt((x _i - x _j ) ² ) + (y _i - y _j ) ² ) + ...(n _i - n _j ) ² ) ÷ sqrt((σx _i ² + σx _j ² ) + (σy _i ² + σy _j ² ) + ...(σn _i ² + σn _j ² )).

I was able to get proxy to work for me in a basic sense (see proxy package in R, can't make it work ) and replicated plain Euclidean distance functionality, hooray for the amateur.

However, once I started writing the function for the error-weighted distance, I immediately ran into a difficulty: I need to read in the errors as distinct from the points and have them processed distinctly.

I know that R has very strong functionality and I'm sure it can do this, but for the life of me, I don't know how. It looks like proxy's dist can handle two matrix inputs, but how would I tell it that matrix X is the points and matrix Y is the errors, and then have each go to its appropriate part of the function before being ultimately combined into the distance measure?

Answer 1

I had been hoping to use proxy directly, but I also realized that it looks like I can't. I believe I was able to come up with a function that works. First, the distance function:

DistErrAdj <- function(x,y) {
sing.err <- sqrt((x^2) + (y^2))
sum(sing.err)
}

Followed, of course, by

library(proxy)
pr_DB$set_entry(FUN=DistErrAdj,names="DistErrAdj")

Then, I took code already kindly written from augix ( http://augix.com/wiki/Make%20trees%20in%20R,%20test%20its%20stability%20by%20bootstrapping.html ) and altered it to suit my needs, to wit:

boot.errtree <- function(x, q, B = 1001, tree = "errave") {
library(ape)
library(protoclust)
library(cluster)
library(proxy)
    func <- function(x,y) {
        tr = agnes((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss = TRUE, method = "average")
        tr = as.phylo(as.hclust(tr))
        return(tr)
    }
    if (tree == "errprot") {
        func <- function(x,y) {
            tr = protoclust((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")))
            tr = as.phylo(tr)
            return(tr)
        }
    }
    if (tree == "errdiv") {
        func <- function(x,y) {
            tr = diana((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss=TRUE)
            tr = as.phylo(as.hclust(tr))
            return(tr)
        }
    }
tr_real = func(x)
    plot(tr_real)
    bp <- boot.phylo(tr_real, x, FUN=func, B=B)
    nodelabels(bp)
    return(bp)
}

It seems to work.