Выберите n наиболее равномерно распределенных точек по набору точечных данных в R

Учитывая набор точек, я пытаюсь выбрать подмножество из n точек, которые наиболее равномерно распределены по этому набору точек. Другими словами, я пытаюсь проредить набор данных, сохраняя при этом равномерную выборку по всему пространству.

Пока у меня есть следующее, но этот подход, вероятно, не подойдет для больших наборов данных. Возможно, есть более разумный способ выбрать подмножество точек в первую очередь... Следующий код случайным образом выбирает подмножество точек и стремится минимизировать расстояние между точками в этом подмножестве и точками вне этого подмножества. .

Предложения приветствуются!

evenSubset <- function(xy, n) {

    bestdist <- NA
    bestSet <- NA
    alldist <- as.matrix(dist(xy))
    diag(alldist) <- NA
    alldist[upper.tri(alldist)] <- NA
    for (i in 1:1000){
        subset <- sample(1:nrow(xy),n)
        subdists <- alldist[subset,-subset]
        distsum <- sum(subdists,na.rm=T)
        if (distsum < bestdist | is.na(bestdist)) {
            bestdist <- distsum
            bestSet <- subset
        }
    }
    return(xy[bestSet,])
}

xy2 <- evenSubset(xy=cbind(rnorm(1000),rnorm(1000)), n=20)
plot(xy)
points(xy2,col='blue',cex=1.5,pch=20)

r distance
person Pascal    schedule 06.03.2014    source источник
comment
Если вас интересует только равномерность распространения вашего подмножества S, вы можете сделать это независимо от оставшегося набора точек. Вы хотите минимизировать функцию ближайшего соседа пустого пространства (т. е. расстояние от произвольного местоположения до ближайшей точки в S). Вы можете получить это, построив мозаику Вороного и итеративно отбрасывая полигон наименьшей площади. Это будет очень похоже на алгоритм удаления ближайшей пары из другого вопроса...   -  person Spacedman    schedule 06.03.2014

Ответы (1)


arrow_upward
2
arrow_downward

Следуя предложению @Spacedman, я использовал тесселяцию Вороного, чтобы определить и удалить те точки, которые были ближе всего к другим точкам.

Здесь процент отбрасываемых очков задается функцией. Похоже, это работает довольно хорошо, за исключением того факта, что он работает медленно с большими наборами данных.

library(tripack)
voronoiFilter <- function(occ,drop) {
    n <- round(x=(nrow(occ) * drop),digits=0)
    subset <- occ
    dropped <- vector()
    for (i in 1:n) {
        v <- voronoi.mosaic(x=subset[,'Longitude'],y=subset[,'Latitude'],duplicate='error')
        info <- cells(v)
        areas <- unlist(lapply(info,function(x) x$area))
        smallest <- which(areas == min(areas,na.rm=TRUE))
        dropped <- c(dropped,which(paste(occ[,'Longitude'],occ[,'Latitude'],sep='_') == paste(subset[smallest,'Longitude'],subset[smallest,'Latitude'],sep='_')))
        subset <- subset[-smallest,]
    }
    return(occ[-dropped,])
}

xy <- cbind(rnorm(500),rnorm(500))
colnames(xy) <- c('Longitude','Latitude')
xy2 <- voronoiFilter(xy, drop=0.7)

plot(xy)
points(xy2,col='blue',cex=1.5,pch=20)

введите здесь описание изображения

person Pascal    schedule 09.03.2014