Một cách đơn giản là rasterize miền tích hợp và tính một xấp xỉ rời rạc cho tích phân.
Có một số điều cần chú ý:
Đảm bảo bao phủ nhiều hơn phạm vi của các điểm: bạn cần bao gồm tất cả các vị trí nơi ước tính mật độ hạt nhân sẽ có bất kỳ giá trị đáng kể nào. Điều này có nghĩa là bạn cần mở rộng phạm vi của các điểm bằng ba đến bốn lần băng thông nhân (đối với nhân Gaussian).
Kết quả sẽ thay đổi phần nào với độ phân giải của raster. Độ phân giải cần phải là một phần nhỏ của băng thông. Vì thời gian tính toán tỷ lệ thuận với số lượng ô trong raster, nên hầu như không mất thêm thời gian để thực hiện một loạt các phép tính sử dụng độ phân giải thô hơn so với dự định: kiểm tra xem kết quả cho các ô thô có hội tụ kết quả cho kết quả không độ phân giải tốt nhất. Nếu không, có thể cần một độ phân giải tốt hơn.
Dưới đây là một minh họa cho bộ dữ liệu gồm 256 điểm:
Các điểm được hiển thị dưới dạng các chấm đen chồng lên nhau trên hai ước tính mật độ hạt nhân. Sáu điểm lớn màu đỏ là "thăm dò" mà tại đó thuật toán được đánh giá. Điều này đã được thực hiện cho bốn băng thông (mặc định giữa 1,8 (theo chiều dọc) và 3 (theo chiều ngang), 1/2, 1 và 5 đơn vị) ở độ phân giải 1000 x 1000 ô. Ma trận phân tán sau đây cho thấy kết quả phụ thuộc mạnh mẽ như thế nào vào băng thông cho sáu điểm thăm dò này, bao gồm một phạm vi mật độ rộng:
Các biến thể xảy ra vì hai lý do. Rõ ràng các ước tính mật độ khác nhau, giới thiệu một dạng biến thể. Quan trọng hơn, sự khác biệt trong ước tính mật độ có thể tạo ra sự khác biệt lớn tại bất kỳ điểm nào ("thăm dò"). Biến thể thứ hai là lớn nhất xung quanh các "rìa" mật độ trung bình của các cụm điểm - chính xác là những vị trí mà phép tính này có thể được sử dụng nhiều nhất.
Điều này cho thấy sự cần thiết phải thận trọng trong việc sử dụng và diễn giải kết quả của các tính toán này, bởi vì chúng có thể rất nhạy cảm với một quyết định tương đối độc đoán (băng thông sử dụng).
Mã R
Thuật toán được chứa trong nửa tá dòng của hàm đầu tiên , f. Để minh họa việc sử dụng nó, phần còn lại của mã tạo ra các số liệu trước.
library(MASS) # kde2d
library(spatstat) # im class
f <- function(xy, n, x, y, ...) {
#
# Estimate the total where the density does not exceed that at (x,y).
#
# `xy` is a 2 by ... array of points.
# `n` specifies the numbers of rows and columns to use.
# `x` and `y` are coordinates of "probe" points.
# `...` is passed on to `kde2d`.
#
# Returns a list:
# image: a raster of the kernel density
# integral: the estimates at the probe points.
# density: the estimated densities at the probe points.
#
xy.kde <- kde2d(xy[1,], xy[2,], n=n, ...)
xy.im <- im(t(xy.kde$z), xcol=xy.kde$x, yrow=xy.kde$y) # Allows interpolation $
z <- interp.im(xy.im, x, y) # Densities at the probe points
c.0 <- sum(xy.kde$z) # Normalization factor $
i <- sapply(z, function(a) sum(xy.kde$z[xy.kde$z < a])) / c.0
return(list(image=xy.im, integral=i, density=z))
}
#
# Generate data.
#
n <- 256
set.seed(17)
xy <- matrix(c(rnorm(k <- ceiling(2*n * 0.8), mean=c(6,3), sd=c(3/2, 1)),
rnorm(2*n-k, mean=c(2,6), sd=1/2)), nrow=2)
#
# Example of using `f`.
#
y.probe <- 1:6
x.probe <- rep(6, length(y.probe))
lims <- c(min(xy[1,])-15, max(xy[1,])+15, min(xy[2,])-15, max(xy[2,]+15))
ex <- f(xy, 200, x.probe, y.probe, lim=lims)
ex$density; ex$integral
#
# Compare the effects of raster resolution and bandwidth.
#
res <- c(8, 40, 200, 1000)
system.time(
est.0 <- sapply(res,
function(i) f(xy, i, x.probe, y.probe, lims=lims)$integral))
est.0
system.time(
est.1 <- sapply(res,
function(i) f(xy, i, x.probe, y.probe, h=1, lims=lims)$integral))
est.1
system.time(
est.2 <- sapply(res,
function(i) f(xy, i, x.probe, y.probe, h=1/2, lims=lims)$integral))
est.2
system.time(
est.3 <- sapply(res,
function(i) f(xy, i, x.probe, y.probe, h=5, lims=lims)$integral))
est.3
results <- data.frame(Default=est.0[,4], Hp5=est.2[,4],
H1=est.1[,4], H5=est.3[,4])
#
# Compare the integrals at the highest resolution.
#
par(mfrow=c(1,1))
panel <- function(x, y, ...) {
points(x, y)
abline(c(0,1), col="Red")
}
pairs(results, lower.panel=panel)
#
# Display two of the density estimates, the data, and the probe points.
#
par(mfrow=c(1,2))
xy.im <- f(xy, 200, x.probe, y.probe, h=0.5)$image
plot(xy.im, main="Bandwidth=1/2", col=terrain.colors(256))
points(t(xy), pch=".", col="Black")
points(x.probe, y.probe, pch=19, col="Red", cex=.5)
xy.im <- f(xy, 200, x.probe, y.probe, h=5)$image
plot(xy.im, main="Bandwidth=5", col=terrain.colors(256))
points(t(xy), pch=".", col="Black")
points(x.probe, y.probe, pch=19, col="Red", cex=.5)
